this one helps. As far as I know, this (in particular, the categorized help text) isn't really easy to do with optparse-applicative, since it isn't quite the pattern that they were planning for with global arguments. If you are okay with using program --global-options command --local-options (which is a fairly standard pattern) instead of program command --global-and-local-options, then you can use the approach shown in the linked example:
$ ./optparse-sub-example
optparse-sub-example - a small example program for optparse-applicative with
subcommands
Usage: optparse [--version] [--global-flag] COMMAND
optparse subcommands example
Available options:
-h,--help Show this help text
--version Show version
--global-flag Set a global flag
Available commands:
create Create a thing
delete Delete the thing
$ ./optparse-sub-example --version create
0.0
$ ./optparse-sub-example --version delete
0.0
$ ./optparse-sub-example --global-flag create HI
Created the thing named HI
global flag: True
$ ./optparse-sub-example --global-flag delete
Deleted the thing!
global flag: True
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ApplicativeDo #-}
import Data.Monoid
import Data.Semigroup ((<>))
import Options.Applicative
import Options.Applicative.Types
data Opts = Opts
{ optGlobals :: !GlobalOpts
, optCommand :: !Command
}
data GlobalOpts = GlobalOpts { optGlobalFlag :: Bool }
instance Semigroup GlobalOpts where
-- Code for merging option parser results from the multiple parsers run
-- at various different places. Note that this may be run with the default
-- values returned by one parser (from a location with no options present)
-- and the true option values from another, so it may be important
-- to distinguish between "the default value" and "no option" (since "no
-- option" shouldn't override another value provided earlier, while
-- "user-supplied value that happens to match the default" probably should).
--
-- In this case this doesn't matter, since the flag being provided anywhere
-- should be enough for it to be considered true.
(GlobalOpts f1) <> (GlobalOpts f2) = GlobalOpts (f1 || f2)
instance Monoid GlobalOpts where
-- Default values for the various options. These should probably match the
-- defaults used in the option declarations.
mempty = GlobalOpts False
data Command
= Create String
| Delete
mysubparser :: forall a b. Monoid a
=> Parser a
-> Mod CommandFields b
-> Parser (a, b)
mysubparser globals cmds = do
g1 <- globals
(g2, r) <- addGlobals $ hsubparser cmds
pure (g1 <> g2, r)
where
addGlobals :: forall c. Parser c -> Parser (a, c)
addGlobals (NilP x) = NilP $ (mempty,) <$> x
addGlobals (OptP (Option (CmdReader n cs g) ps)) =
OptP (Option (CmdReader n cs $ fmap go . g) ps)
where go pi = pi { infoParser = (,) <$> globals <*> infoParser pi }
addGlobals (OptP o) = OptP ((mempty,) <$> o)
addGlobals (AltP p1 p2) = AltP (addGlobals p1) (addGlobals p2)
addGlobals (MultP p1 p2) =
MultP ((\(g2, f) -> \(g1, x) -> (g1 <> g2, f x)) <$> addGlobals p1)
(addGlobals p2)
addGlobals (BindP p k) = BindP (addGlobals p) $ \(g1, x) ->
BindP (addGlobals $ k x) $ \(g2, x') ->
pure (g1 <> g2, x')
main :: IO ()
main = do
(opts :: Opts) <- execParser optsParser
case optCommand opts of
Create name -> putStrLn ("Created the thing named " ++ name)
Delete -> putStrLn "Deleted the thing!"
putStrLn ("global flag: " ++ show (optGlobalFlag (optGlobals opts)))
where
optsParser :: ParserInfo Opts
optsParser =
info
(helper <*> programOptions)
(fullDesc <> progDesc "optparse subcommands example" <>
header
"optparse-sub-example - a small example program for optparse-applicative with subcommands")
versionOption :: Parser (a -> a)
versionOption = infoOption "0.0" (long "version" <> help "Show version")
globalOpts :: Parser GlobalOpts
globalOpts = versionOption <*>
(GlobalOpts <$> switch (long "global-flag" <> help "Set a global flag"))
programOptions :: Parser Opts
programOptions =
uncurry Opts <$> mysubparser globalOpts (createCommand <> deleteCommand)
createCommand :: Mod CommandFields Command
createCommand =
command
"create"
(info createOptions (progDesc "Create a thing"))
createOptions :: Parser Command
createOptions =
Create <$>
strArgument (metavar "NAME" <> help "Name of the thing to create")
deleteCommand :: Mod CommandFields Command
deleteCommand =
command
"delete"
(info (pure Delete) (progDesc "Delete the thing"))
$ ./optparse-sub-example create --global-flag HI
Created the thing named HI
global flag: True
$ ./optparse-sub-example --global-flag create HI
Created the thing named HI
global flag: True
$ ./optparse-sub-example --global-flag delete
Deleted the thing!
global flag: True
$ ./optparse-sub-example delete --global-flag
Deleted the thing!
global flag: True
$ ./optparse-sub-example delete
Deleted the thing!
global flag: False
$ ./optparse-sub-example delete --version
0.0
$ ./optparse-sub-example create --version
0.0