------------------------------------------------------------------------------
-- |
-- Module : LibOA
-- Description : supplementary functions for optparse-applicative
-- Copyright : Copyright (c) 2019-2022 Travis Cardwell
-- License : MIT
--
-- This is a collection of functions that I often use with
-- @optparse-applicative@. I do not feel that it is worth maintaining yet
-- another helper package on Hackage, so I just copy the code to different
-- projects as required. If the library grows to a substantial size or others
-- with to use it, I will reconsider.
--
-- Revision: 2022-01-02
------------------------------------------------------------------------------
{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}
module LibOA
( -- * Options
-- $Options
helper
, versioner
-- * Utilities
, commands
-- * Help
, (<||>)
, section
, table
, table_
, vspace
) where
-- https://hackage.haskell.org/package/ansi-wl-pprint
import qualified Text.PrettyPrint.ANSI.Leijen as Doc
import Text.PrettyPrint.ANSI.Leijen (Doc)
-- https://hackage.haskell.org/package/base
import Data.List (intersperse, transpose)
import Data.Maybe (fromMaybe)
#if !MIN_VERSION_base (4,11,0)
import Data.Monoid ((<>))
#endif
-- https://hackage.haskell.org/package/optparse-applicative
import qualified Options.Applicative as OA
#if MIN_VERSION_optparse_applicative (0,16,0)
import qualified Options.Applicative.Builder.Internal as OABI
#endif
import qualified Options.Applicative.Common as OAC
import qualified Options.Applicative.Types as OAT
------------------------------------------------------------------------------
-- $Options
--
-- Option descriptions are not capitalized.
-- | A hidden @-h@ / @--help@ option that always fails, showing the help
--
-- This is the same as 'OA.helper' except that it has a different help
-- message.
helper :: OA.Parser (a -> a)
#if MIN_VERSION_optparse_applicative (0,16,0)
helper = OA.option helpReader $ mconcat
[ OA.short 'h'
, OA.long "help"
, OA.value id
, OA.metavar ""
, OABI.noGlobal
, OA.noArgError (OA.ShowHelpText Nothing)
, OA.help "show this help text"
, OA.hidden
]
where
helpReader = do
potentialCommand <- OAT.readerAsk
OA.readerAbort $ OA.ShowHelpText (Just potentialCommand)
#else
helper = OA.abortOption OA.ShowHelpText $ mconcat
[ OA.short 'h'
, OA.long "help"
, OA.help "show help and exit"
, OA.hidden
]
#endif
-- | A hidden @--version@ option that always fails, showing the version
versioner
:: String -- ^ version string
-> OA.Parser (a -> a)
versioner verStr = OA.infoOption verStr $ mconcat
[ OA.long "version"
, OA.help "show version and exit"
, OA.hidden
]
------------------------------------------------------------------------------
-- $Utilities
-- | Get a list of commands for a parser
commands :: OA.Parser a -> [String]
commands =
let go _ opt = case OAT.optMain opt of
OAT.CmdReader _ cmds _ -> reverse cmds
_otherReader -> []
in concat . OAC.mapParser go
------------------------------------------------------------------------------
-- $Help
-- | Insert a blank line between two documents
(<||>) :: Doc -> Doc -> Doc
d1 <||> d2 = d1 <> Doc.line <> Doc.line <> d2
infixr 5 <||>
-- | Create a section with a title and indented body
section :: String -> Doc -> Doc
section title = (Doc.text title Doc.<$$>) . Doc.indent 2
-- | Create a table, with formatting
table :: Int -> [[(String, Doc -> Doc)]] -> Doc
table sep rows = Doc.vcat $
map (fromMaybe Doc.empty . foldr go Nothing . zip lengths) rows
where
lengths :: [Int]
lengths = map ((+) sep . maximum . map (length . fst)) $ transpose rows
go :: (Int, (String, Doc -> Doc)) -> Maybe Doc -> Maybe Doc
go (len, (s, f)) = Just . \case
Just doc -> Doc.fill len (f $ Doc.string s) <> doc
Nothing -> f $ Doc.string s
-- | Create a table, without formatting
table_ :: Int -> [[String]] -> Doc
table_ sep = table sep . (map . map) (, id)
-- | Vertically space documents with blank lines between them
vspace :: [Doc] -> Doc
vspace = mconcat . intersperse (Doc.line <> Doc.line)