module Options.Applicative.Extra (
helper,
execParser,
execParserPure,
usage,
ParserFailure(..),
) where
import Options.Applicative.Common
import Options.Applicative.Builder
import Options.Applicative.Help
import Options.Applicative.Utils
import Options.Applicative.Types
import System.Environment
import System.Exit
import System.IO
helper :: Parser (a -> a)
helper = nullOption
( long "help"
& short 'h'
& help "Show this help text"
& value id
& hidden )
execParser :: ParserInfo a -> IO a
execParser = customExecParser (prefs idm)
customExecParser :: ParserPrefs -> ParserInfo a -> IO a
customExecParser pprefs pinfo = do
args <- getArgs
case execParserPure pprefs pinfo args of
Right a -> return a
Left failure -> do
progn <- getProgName
hPutStr stderr (errMessage failure progn)
exitWith (errExitCode failure)
execParserPure :: ParserPrefs
-> ParserInfo a
-> [String]
-> Either ParserFailure a
execParserPure pprefs pinfo args =
case runP p of
(Right a, _) -> Right a
(Left msg, ctx) -> Left ParserFailure
{ errMessage = \progn
-> with_context ctx pinfo $ \name ->
parserHelpText pprefs
. add_error msg
. add_usage name progn
, errExitCode = ExitFailure (infoFailureCode pinfo) }
where
parser = infoParser pinfo
add_usage name progn i = i
{ infoHeader = vcat
[ infoHeader i
, usage pprefs (infoParser i) ename ] }
where
ename = maybe progn (\n -> progn ++ " " ++ n) name
add_error msg i = i
{ infoHeader = vcat [msg, infoHeader i] }
with_context :: Context
-> ParserInfo a
-> (forall b . Maybe String -> ParserInfo b -> c)
-> c
with_context NullContext i f = f Nothing i
with_context (Context n i) _ f = f n i
p = runParserFully parser args
usage :: ParserPrefs -> Parser a -> String -> String
usage pprefs p progn = foldr (<+>) ""
[ "Usage:"
, progn
, briefDesc pprefs p ]