{-# LANGUAGE NoImplicitPrelude #-}
module Options.Applicative.Complicated
( addCommand
, addSubCommands
, complicatedOptions
, complicatedParser
) where
import Control.Monad.Trans.Except
import Control.Monad.Trans.Writer
import Options.Applicative
import Options.Applicative.Types
import Options.Applicative.Builder.Extra
import Options.Applicative.Builder.Internal
import Stack.Prelude
import Stack.Types.Config
import System.Environment
complicatedOptions
:: Version
-> Maybe String
-> String
-> String
-> String
-> String
-> Parser GlobalOptsMonoid
-> Maybe (ParserFailure ParserHelp -> [String] -> IO (GlobalOptsMonoid,(RIO Runner (),GlobalOptsMonoid)))
-> AddCommand
-> IO (GlobalOptsMonoid, RIO Runner ())
complicatedOptions :: Version
-> Maybe String
-> String
-> String
-> String
-> String
-> Parser GlobalOptsMonoid
-> Maybe
(ParserFailure ParserHelp
-> [String]
-> IO (GlobalOptsMonoid, (RIO Runner (), GlobalOptsMonoid)))
-> AddCommand
-> IO (GlobalOptsMonoid, RIO Runner ())
complicatedOptions Version
numericVersion Maybe String
stringVersion String
numericHpackVersion String
h String
pd String
footerStr Parser GlobalOptsMonoid
commonParser Maybe
(ParserFailure ParserHelp
-> [String]
-> IO (GlobalOptsMonoid, (RIO Runner (), GlobalOptsMonoid)))
mOnFailure AddCommand
commandParser =
do [String]
args <- IO [String]
getArgs
(GlobalOptsMonoid
a,(RIO Runner ()
b,GlobalOptsMonoid
c)) <- let parserPrefs :: ParserPrefs
parserPrefs = PrefsMod -> ParserPrefs
prefs forall a b. (a -> b) -> a -> b
$ PrefsMod
noBacktrack forall a. Semigroup a => a -> a -> a
<> PrefsMod
showHelpOnEmpty
in case forall a. ParserPrefs -> ParserInfo a -> [String] -> ParserResult a
execParserPure ParserPrefs
parserPrefs ParserInfo (GlobalOptsMonoid, (RIO Runner (), GlobalOptsMonoid))
parser [String]
args of
Failure ParserFailure ParserHelp
f | Just ParserFailure ParserHelp
-> [String]
-> IO (GlobalOptsMonoid, (RIO Runner (), GlobalOptsMonoid))
onFailure <- Maybe
(ParserFailure ParserHelp
-> [String]
-> IO (GlobalOptsMonoid, (RIO Runner (), GlobalOptsMonoid)))
mOnFailure -> ParserFailure ParserHelp
-> [String]
-> IO (GlobalOptsMonoid, (RIO Runner (), GlobalOptsMonoid))
onFailure ParserFailure ParserHelp
f [String]
args
ParserResult (GlobalOptsMonoid, (RIO Runner (), GlobalOptsMonoid))
parseResult -> forall a. ParserResult a -> IO a
handleParseResult ParserResult (GlobalOptsMonoid, (RIO Runner (), GlobalOptsMonoid))
parseResult
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Monoid a => a -> a -> a
mappend GlobalOptsMonoid
c GlobalOptsMonoid
a,RIO Runner ()
b)
where parser :: ParserInfo (GlobalOptsMonoid, (RIO Runner (), GlobalOptsMonoid))
parser = forall a. Parser a -> InfoMod a -> ParserInfo a
info (forall a. Parser (a -> a)
helpOption forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parser (a -> a)
versionOptions forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> Parser GlobalOptsMonoid
-> AddCommand
-> Parser (GlobalOptsMonoid, (RIO Runner (), GlobalOptsMonoid))
complicatedParser String
"COMMAND|FILE" Parser GlobalOptsMonoid
commonParser AddCommand
commandParser) forall {a}. InfoMod a
desc
desc :: InfoMod a
desc = forall {a}. InfoMod a
fullDesc forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
header String
h forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
progDesc String
pd forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
footer String
footerStr
versionOptions :: Parser (a -> a)
versionOptions =
case Maybe String
stringVersion of
Maybe String
Nothing -> forall {a}. String -> Parser (a -> a)
versionOption (Version -> String
versionString Version
numericVersion)
Just String
s -> forall {a}. String -> Parser (a -> a)
versionOption String
s forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parser (a -> a)
numericVersionOption forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parser (a -> a)
numericHpackVersionOption
versionOption :: String -> Parser (a -> a)
versionOption String
s =
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption
String
s
(forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"version" forall a. Semigroup a => a -> a -> a
<>
forall (f :: * -> *) a. String -> Mod f a
help String
"Show version")
numericVersionOption :: Parser (a -> a)
numericVersionOption =
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption
(Version -> String
versionString Version
numericVersion)
(forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"numeric-version" forall a. Semigroup a => a -> a -> a
<>
forall (f :: * -> *) a. String -> Mod f a
help String
"Show only version number")
numericHpackVersionOption :: Parser (a -> a)
numericHpackVersionOption =
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption
String
numericHpackVersion
(forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"hpack-numeric-version" forall a. Semigroup a => a -> a -> a
<>
forall (f :: * -> *) a. String -> Mod f a
help String
"Show only hpack's version number")
addCommand :: String
-> String
-> String
-> (opts -> RIO Runner ())
-> (opts -> GlobalOptsMonoid -> GlobalOptsMonoid)
-> Parser GlobalOptsMonoid
-> Parser opts
-> AddCommand
addCommand :: forall opts.
String
-> String
-> String
-> (opts -> RIO Runner ())
-> (opts -> GlobalOptsMonoid -> GlobalOptsMonoid)
-> Parser GlobalOptsMonoid
-> Parser opts
-> AddCommand
addCommand String
cmd String
title String
footerStr opts -> RIO Runner ()
constr opts -> GlobalOptsMonoid -> GlobalOptsMonoid
extendCommon =
forall opts.
String
-> String
-> String
-> (opts -> GlobalOptsMonoid -> (RIO Runner (), GlobalOptsMonoid))
-> Parser GlobalOptsMonoid
-> Parser opts
-> AddCommand
addCommand' String
cmd String
title String
footerStr (\opts
a GlobalOptsMonoid
c -> (opts -> RIO Runner ()
constr opts
a,opts -> GlobalOptsMonoid -> GlobalOptsMonoid
extendCommon opts
a GlobalOptsMonoid
c))
addSubCommands
:: String
-> String
-> String
-> Parser GlobalOptsMonoid
-> AddCommand
-> AddCommand
addSubCommands :: String
-> String
-> String
-> Parser GlobalOptsMonoid
-> AddCommand
-> AddCommand
addSubCommands String
cmd String
title String
footerStr Parser GlobalOptsMonoid
commonParser AddCommand
commandParser =
forall opts.
String
-> String
-> String
-> (opts -> GlobalOptsMonoid -> (RIO Runner (), GlobalOptsMonoid))
-> Parser GlobalOptsMonoid
-> Parser opts
-> AddCommand
addCommand' String
cmd
String
title
String
footerStr
(\(GlobalOptsMonoid
c1,(RIO Runner ()
a,GlobalOptsMonoid
c2)) GlobalOptsMonoid
c3 -> (RIO Runner ()
a,forall a. Monoid a => [a] -> a
mconcat [GlobalOptsMonoid
c3, GlobalOptsMonoid
c2, GlobalOptsMonoid
c1]))
Parser GlobalOptsMonoid
commonParser
(String
-> Parser GlobalOptsMonoid
-> AddCommand
-> Parser (GlobalOptsMonoid, (RIO Runner (), GlobalOptsMonoid))
complicatedParser String
"COMMAND" Parser GlobalOptsMonoid
commonParser AddCommand
commandParser)
addCommand' :: String
-> String
-> String
-> (opts -> GlobalOptsMonoid -> (RIO Runner (),GlobalOptsMonoid))
-> Parser GlobalOptsMonoid
-> Parser opts
-> AddCommand
addCommand' :: forall opts.
String
-> String
-> String
-> (opts -> GlobalOptsMonoid -> (RIO Runner (), GlobalOptsMonoid))
-> Parser GlobalOptsMonoid
-> Parser opts
-> AddCommand
addCommand' String
cmd String
title String
footerStr opts -> GlobalOptsMonoid -> (RIO Runner (), GlobalOptsMonoid)
constr Parser GlobalOptsMonoid
commonParser Parser opts
inner =
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (forall a. String -> ParserInfo a -> Mod CommandFields a
command String
cmd
(forall a. Parser a -> InfoMod a -> ParserInfo a
info (opts -> GlobalOptsMonoid -> (RIO Runner (), GlobalOptsMonoid)
constr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser opts
inner forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser GlobalOptsMonoid
commonParser)
(forall a. String -> InfoMod a
progDesc String
title forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
footer String
footerStr))))
complicatedParser
:: String
-> Parser GlobalOptsMonoid
-> AddCommand
-> Parser (GlobalOptsMonoid,(RIO Runner (),GlobalOptsMonoid))
complicatedParser :: String
-> Parser GlobalOptsMonoid
-> AddCommand
-> Parser (GlobalOptsMonoid, (RIO Runner (), GlobalOptsMonoid))
complicatedParser String
commandMetavar Parser GlobalOptsMonoid
commonParser AddCommand
commandParser =
(,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Parser GlobalOptsMonoid
commonParser forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
case forall w a. Writer w a -> (a, w)
runWriter (forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT AddCommand
commandParser) of
(Right (),Mod CommandFields (RIO Runner (), GlobalOptsMonoid)
d) -> forall a. String -> Mod CommandFields a -> Parser a
hsubparser' String
commandMetavar Mod CommandFields (RIO Runner (), GlobalOptsMonoid)
d
(Left RIO Runner ()
b,Mod CommandFields (RIO Runner (), GlobalOptsMonoid)
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (RIO Runner ()
b,forall a. Monoid a => a
mempty)
hsubparser' :: String -> Mod CommandFields a -> Parser a
hsubparser' :: forall a. String -> Mod CommandFields a -> Parser a
hsubparser' String
commandMetavar Mod CommandFields a
m = forall a.
DefaultProp a
-> (OptProperties -> OptProperties) -> OptReader a -> Parser a
mkParser DefaultProp a
d OptProperties -> OptProperties
g OptReader a
rdr
where
Mod CommandFields a -> CommandFields a
_ DefaultProp a
d OptProperties -> OptProperties
g = forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
commandMetavar forall a. Monoid a => a -> a -> a
`mappend` Mod CommandFields a
m
(Maybe String
groupName, [String]
cmds, String -> Maybe (ParserInfo a)
subs) = forall a.
Mod CommandFields a
-> (Maybe String, [String], String -> Maybe (ParserInfo a))
mkCommand Mod CommandFields a
m
rdr :: OptReader a
rdr = forall a.
Maybe String
-> [String] -> (String -> Maybe (ParserInfo a)) -> OptReader a
CmdReader Maybe String
groupName [String]
cmds (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. ParserInfo a -> ParserInfo a
add_helper forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe (ParserInfo a)
subs)
add_helper :: ParserInfo a -> ParserInfo a
add_helper ParserInfo a
pinfo = ParserInfo a
pinfo
{ infoParser :: Parser a
infoParser = forall a. ParserInfo a -> Parser a
infoParser ParserInfo a
pinfo forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> forall a. Parser (a -> a)
helpOption }
helpOption :: Parser (a -> a)
helpOption :: forall a. Parser (a -> a)
helpOption =
forall a.
ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
abortOption ParseError
showHelpText forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"help" forall a. Semigroup a => a -> a -> a
<>
forall (f :: * -> *) a. String -> Mod f a
help String
"Show this help text"