{-# LANGUAGE CPP #-}
module Options.Applicative.Builder (
  -- * Parser builders
  --
  -- | This module contains utility functions and combinators to create parsers
  -- for individual options.
  --
  -- Each parser builder takes an option modifier. A modifier can be created by
  -- composing the basic modifiers provided by this module using the 'Monoid'
  -- operations 'mempty' and 'mappend', or their aliases 'idm' and '<>'.
  --
  -- For example:
  --
  -- > out = strOption
  -- >     ( long "output"
  -- >    <> short 'o'
  -- >    <> metavar "FILENAME" )
  --
  -- creates a parser for an option called \"output\".
  subparser,
  strArgument,
  argument,
  flag,
  flag',
  switch,
  abortOption,
  infoOption,
  strOption,
  option,

  -- * Modifiers
  short,
  long,
  help,
  helpDoc,
  value,
  showDefaultWith,
  showDefault,
  metavar,
  noArgError,
  ParseError(..),
  hidden,
  internal,
  style,
  command,
  commandGroup,
  completeWith,
  action,
  completer,
  idm,
  mappend,

  -- * Readers
  --
  -- | A collection of basic 'Option' readers.
  auto,
  str,
  maybeReader,
  eitherReader,
  disabled,
  readerAbort,
  readerError,

  -- * Builder for 'ParserInfo'
  InfoMod,
  fullDesc,
  briefDesc,
  header,
  headerDoc,
  footer,
  footerDoc,
  progDesc,
  progDescDoc,
  failureCode,
  noIntersperse,
  forwardOptions,
  allPositional,
  info,

  -- * Builder for 'ParserPrefs'
  PrefsMod,
  multiSuffix,
  disambiguate,
  showHelpOnError,
  showHelpOnEmpty,
  noBacktrack,
  subparserInline,
  columns,
  helpLongEquals,
  helpShowGlobals,
  helpIndent,
  prefs,
  defaultPrefs,

  -- * Types
  Mod,
  ReadM,
  OptionFields,
  FlagFields,
  ArgumentFields,
  CommandFields,

  HasName,
  HasCompleter,
  HasValue,
  HasMetavar
  ) where

import Control.Applicative
#if __GLASGOW_HASKELL__ <= 802
import Data.Semigroup hiding (option)
#endif
import Data.String (fromString, IsString)

import Options.Applicative.Builder.Completer
import Options.Applicative.Builder.Internal
import Options.Applicative.Common
import Options.Applicative.Types
import Options.Applicative.Help.Pretty
import Options.Applicative.Help.Chunk

-- Readers --

-- | 'Option' reader based on the 'Read' type class.
auto :: Read a => ReadM a
auto :: forall a. Read a => ReadM a
auto = forall a. (String -> Either String a) -> ReadM a
eitherReader forall a b. (a -> b) -> a -> b
$ \String
arg -> case forall a. Read a => ReadS a
reads String
arg of
  [(a
r, String
"")] -> forall (m :: * -> *) a. Monad m => a -> m a
return a
r
  [(a, String)]
_         -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"cannot parse value `" forall a. [a] -> [a] -> [a]
++ String
arg forall a. [a] -> [a] -> [a]
++ String
"'"

-- | String 'Option' reader.
--
--   Polymorphic over the `IsString` type class since 0.14.
str :: IsString s => ReadM s
str :: forall s. IsString s => ReadM s
str = forall a. IsString a => String -> a
fromString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM String
readerAsk

-- | Convert a function producing an 'Either' into a reader.
--
-- As an example, one can create a ReadM from an attoparsec Parser
-- easily with
--
-- > import qualified Data.Attoparsec.Text as A
-- > import qualified Data.Text as T
-- > attoparsecReader :: A.Parser a -> ReadM a
-- > attoparsecReader p = eitherReader (A.parseOnly p . T.pack)
eitherReader :: (String -> Either String a) -> ReadM a
eitherReader :: forall a. (String -> Either String a) -> ReadM a
eitherReader String -> Either String a
f = ReadM String
readerAsk forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. String -> ReadM a
readerError forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String a
f

-- | Convert a function producing a 'Maybe' into a reader.
maybeReader :: (String -> Maybe a) -> ReadM a
maybeReader :: forall a. (String -> Maybe a) -> ReadM a
maybeReader String -> Maybe a
f = do
  String
arg  <- ReadM String
readerAsk
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. String -> ReadM a
readerError forall a b. (a -> b) -> a -> b
$ String
"cannot parse value `" forall a. [a] -> [a] -> [a]
++ String
arg forall a. [a] -> [a] -> [a]
++ String
"'") forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe a
f forall a b. (a -> b) -> a -> b
$ String
arg

-- | Null 'Option' reader. All arguments will fail validation.
disabled :: ReadM a
disabled :: forall a. ReadM a
disabled = forall a. String -> ReadM a
readerError String
"disabled option"

-- modifiers --

-- | Specify a short name for an option.
short :: HasName f => Char -> Mod f a
short :: forall (f :: * -> *) a. HasName f => Char -> Mod f a
short = forall (f :: * -> *) a. (f a -> f a) -> Mod f a
fieldMod forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. HasName f => OptName -> f a -> f a
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> OptName
OptShort

-- | Specify a long name for an option.
long :: HasName f => String -> Mod f a
long :: forall (f :: * -> *) a. HasName f => String -> Mod f a
long = forall (f :: * -> *) a. (f a -> f a) -> Mod f a
fieldMod forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. HasName f => OptName -> f a -> f a
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> OptName
OptLong

-- | Specify a default value for an option.
--
-- /Note/: Because this modifier means the parser will never fail,
-- do not use it with combinators such as 'some' or 'many', as
-- these combinators continue until a failure occurs.
-- Careless use will thus result in a hang.
--
-- To display the default value, combine with showDefault or
-- showDefaultWith.
value :: HasValue f => a -> Mod f a
value :: forall (f :: * -> *) a. HasValue f => a -> Mod f a
value a
x = forall (f :: * -> *) a.
(f a -> f a)
-> DefaultProp a -> (OptProperties -> OptProperties) -> Mod f a
Mod forall a. a -> a
id (forall a. Maybe a -> Maybe (a -> String) -> DefaultProp a
DefaultProp (forall a. a -> Maybe a
Just a
x) forall a. Maybe a
Nothing) forall a. a -> a
id

-- | Specify a function to show the default value for an option.
showDefaultWith :: (a -> String) -> Mod f a
showDefaultWith :: forall a (f :: * -> *). (a -> String) -> Mod f a
showDefaultWith a -> String
s = forall (f :: * -> *) a.
(f a -> f a)
-> DefaultProp a -> (OptProperties -> OptProperties) -> Mod f a
Mod forall a. a -> a
id (forall a. Maybe a -> Maybe (a -> String) -> DefaultProp a
DefaultProp forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just a -> String
s)) forall a. a -> a
id

-- | Show the default value for this option using its 'Show' instance.
showDefault :: Show a => Mod f a
showDefault :: forall a (f :: * -> *). Show a => Mod f a
showDefault = forall a (f :: * -> *). (a -> String) -> Mod f a
showDefaultWith forall a. Show a => a -> String
show

-- | Specify the help text for an option.
help :: String -> Mod f a
help :: forall (f :: * -> *) a. String -> Mod f a
help String
s = forall (f :: * -> *) a. (OptProperties -> OptProperties) -> Mod f a
optionMod forall a b. (a -> b) -> a -> b
$ \OptProperties
p -> OptProperties
p { propHelp :: Chunk Doc
propHelp = String -> Chunk Doc
paragraph String
s }

-- | Specify the help text for an option as a 'Text.PrettyPrint.ANSI.Leijen.Doc'
-- value.
helpDoc :: Maybe Doc -> Mod f a
helpDoc :: forall (f :: * -> *) a. Maybe Doc -> Mod f a
helpDoc Maybe Doc
doc = forall (f :: * -> *) a. (OptProperties -> OptProperties) -> Mod f a
optionMod forall a b. (a -> b) -> a -> b
$ \OptProperties
p -> OptProperties
p { propHelp :: Chunk Doc
propHelp = forall a. Maybe a -> Chunk a
Chunk Maybe Doc
doc }

-- | Specify the error to display when no argument is provided to this option.
noArgError :: ParseError -> Mod OptionFields a
noArgError :: forall a. ParseError -> Mod OptionFields a
noArgError ParseError
e = forall (f :: * -> *) a. (f a -> f a) -> Mod f a
fieldMod forall a b. (a -> b) -> a -> b
$ \OptionFields a
p -> OptionFields a
p { optNoArgError :: String -> ParseError
optNoArgError = forall a b. a -> b -> a
const ParseError
e }

-- | Specify a metavariable for the argument.
--
-- Metavariables have no effect on the actual parser, and only serve to specify
-- the symbolic name for an argument to be displayed in the help text.
metavar :: HasMetavar f => String -> Mod f a
metavar :: forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
var = forall (f :: * -> *) a. (OptProperties -> OptProperties) -> Mod f a
optionMod forall a b. (a -> b) -> a -> b
$ \OptProperties
p -> OptProperties
p { propMetaVar :: String
propMetaVar = String
var }

-- | Hide this option from the brief description.
--
-- Use 'internal' to hide the option from the help text too.
hidden :: Mod f a
hidden :: forall (f :: * -> *) a. Mod f a
hidden = forall (f :: * -> *) a. (OptProperties -> OptProperties) -> Mod f a
optionMod forall a b. (a -> b) -> a -> b
$ \OptProperties
p ->
  OptProperties
p { propVisibility :: OptVisibility
propVisibility = forall a. Ord a => a -> a -> a
min OptVisibility
Hidden (OptProperties -> OptVisibility
propVisibility OptProperties
p) }

-- | Apply a function to the option description in the usage text.
--
-- > import Options.Applicative.Help
-- > flag' () (short 't' <> style bold)
--
-- /NOTE/: This builder is more flexible than its name and example
-- allude. One of the motivating examples for its addition was to
-- use `const` to completely replace the usage text of an option.
style :: ( Doc -> Doc ) -> Mod f a
style :: forall (f :: * -> *) a. (Doc -> Doc) -> Mod f a
style Doc -> Doc
x = forall (f :: * -> *) a. (OptProperties -> OptProperties) -> Mod f a
optionMod forall a b. (a -> b) -> a -> b
$ \OptProperties
p ->
  OptProperties
p { propDescMod :: Maybe (Doc -> Doc)
propDescMod = forall a. a -> Maybe a
Just Doc -> Doc
x }

-- | Add a command to a subparser option.
--
-- Suggested usage for multiple commands is to add them to a single subparser. e.g.
--
-- @
-- sample :: Parser Sample
-- sample = subparser
--        ( command "hello"
--          (info hello (progDesc "Print greeting"))
--       <> command "goodbye"
--          (info goodbye (progDesc "Say goodbye"))
--        )
-- @
command :: String -> ParserInfo a -> Mod CommandFields a
command :: forall a. String -> ParserInfo a -> Mod CommandFields a
command String
cmd ParserInfo a
pinfo = forall (f :: * -> *) a. (f a -> f a) -> Mod f a
fieldMod forall a b. (a -> b) -> a -> b
$ \CommandFields a
p ->
  CommandFields a
p { cmdCommands :: [(String, ParserInfo a)]
cmdCommands = (String
cmd, ParserInfo a
pinfo) forall a. a -> [a] -> [a]
: forall a. CommandFields a -> [(String, ParserInfo a)]
cmdCommands CommandFields a
p }

-- | Add a description to a group of commands.
--
-- Advanced feature for separating logical groups of commands on the parse line.
--
-- If using the same `metavar` for each group of commands, it may yield a more
-- attractive usage text combined with `hidden` for some groups.
commandGroup :: String -> Mod CommandFields a
commandGroup :: forall a. String -> Mod CommandFields a
commandGroup String
g = forall (f :: * -> *) a. (f a -> f a) -> Mod f a
fieldMod forall a b. (a -> b) -> a -> b
$ \CommandFields a
p ->
  CommandFields a
p { cmdGroup :: Maybe String
cmdGroup = forall a. a -> Maybe a
Just String
g }

-- | Add a list of possible completion values.
completeWith :: HasCompleter f => [String] -> Mod f a
completeWith :: forall (f :: * -> *) a. HasCompleter f => [String] -> Mod f a
completeWith = forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Completer
listCompleter

-- | Add a bash completion action. Common actions include @file@ and
-- @directory@. See
-- <http://www.gnu.org/software/bash/manual/html_node/Programmable-Completion-Builtins.html#Programmable-Completion-Builtins>
-- for a complete list.
action :: HasCompleter f => String -> Mod f a
action :: forall (f :: * -> *) a. HasCompleter f => String -> Mod f a
action = forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Completer
bashCompleter

-- | Add a completer to an argument.
--
-- A completer is a function String -> IO String which, given a partial
-- argument, returns all possible completions for that argument.
completer :: HasCompleter f => Completer -> Mod f a
completer :: forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer Completer
f = forall (f :: * -> *) a. (f a -> f a) -> Mod f a
fieldMod forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a.
HasCompleter f =>
(Completer -> Completer) -> f a -> f a
modCompleter (forall a. Monoid a => a -> a -> a
`mappend` Completer
f)

-- parsers --

-- | Builder for a command parser. The 'command' modifier can be used to
-- specify individual commands.
--
-- By default, sub-parsers allow backtracking to their parent's options when
-- they are completed. To allow full mixing of parent and sub-parser options,
-- turn on 'subparserInline'; otherwise, to disable backtracking completely,
-- use 'noBacktrack'.
subparser :: Mod CommandFields a -> Parser a
subparser :: forall a. Mod CommandFields a -> Parser a
subparser 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
"COMMAND" 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 String -> Maybe (ParserInfo a)
subs

-- | Builder for an argument parser.
argument :: ReadM a -> Mod ArgumentFields a -> Parser a
argument :: forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM a
p Mod ArgumentFields a
m = forall a.
DefaultProp a
-> (OptProperties -> OptProperties) -> OptReader a -> Parser a
mkParser DefaultProp a
d OptProperties -> OptProperties
g (forall a. CReader a -> OptReader a
ArgReader CReader a
rdr)
  where
    (Mod ArgumentFields a -> ArgumentFields a
f DefaultProp a
d OptProperties -> OptProperties
g) = forall (f :: * -> *) a. Mod f a
noGlobal forall a. Monoid a => a -> a -> a
`mappend` Mod ArgumentFields a
m
    ArgumentFields Completer
compl = ArgumentFields a -> ArgumentFields a
f (forall a. Completer -> ArgumentFields a
ArgumentFields forall a. Monoid a => a
mempty)
    rdr :: CReader a
rdr = forall a. Completer -> ReadM a -> CReader a
CReader Completer
compl ReadM a
p

-- | Builder for a 'String' argument.
strArgument :: IsString s => Mod ArgumentFields s -> Parser s
strArgument :: forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument = forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument forall s. IsString s => ReadM s
str

-- | Builder for a flag parser.
--
-- A flag that switches from a \"default value\" to an \"active value\" when
-- encountered. For a simple boolean value, use `switch` instead.
--
-- /Note/: Because this parser will never fail, it can not be used with
-- combinators such as 'some' or 'many', as these combinators continue until
-- a failure occurs. See @flag'@.
flag :: a                         -- ^ default value
     -> a                         -- ^ active value
     -> Mod FlagFields a          -- ^ option modifier
     -> Parser a
flag :: forall a. a -> a -> Mod FlagFields a -> Parser a
flag a
defv a
actv Mod FlagFields a
m = forall a. a -> Mod FlagFields a -> Parser a
flag' a
actv Mod FlagFields a
m forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
defv

-- | Builder for a flag parser without a default value.
--
-- Same as 'flag', but with no default value. In particular, this flag will
-- never parse successfully by itself.
--
-- It still makes sense to use it as part of a composite parser. For example
--
-- > length <$> many (flag' () (short 't'))
--
-- is a parser that counts the number of "-t" arguments on the command line,
-- alternatively
--
-- > flag' True (long "on") <|> flag' False (long "off")
--
-- will require the user to enter '--on' or '--off' on the command line.
flag' :: a                         -- ^ active value
      -> Mod FlagFields a          -- ^ option modifier
      -> Parser a
flag' :: forall a. a -> Mod FlagFields a -> Parser a
flag' a
actv (Mod FlagFields a -> FlagFields a
f DefaultProp a
d OptProperties -> OptProperties
g) = forall a.
DefaultProp a
-> (OptProperties -> OptProperties) -> OptReader a -> Parser a
mkParser DefaultProp a
d OptProperties -> OptProperties
g OptReader a
rdr
  where
    rdr :: OptReader a
rdr = let fields :: FlagFields a
fields = FlagFields a -> FlagFields a
f (forall a. [OptName] -> a -> FlagFields a
FlagFields [] a
actv)
          in forall a. [OptName] -> a -> OptReader a
FlagReader (forall a. FlagFields a -> [OptName]
flagNames FlagFields a
fields)
                        (forall a. FlagFields a -> a
flagActive FlagFields a
fields)

-- | Builder for a boolean flag.
--
-- /Note/: Because this parser will never fail, it can not be used with
-- combinators such as 'some' or 'many', as these combinators continue until
-- a failure occurs. See @flag'@.
--
-- > switch = flag False True
switch :: Mod FlagFields Bool -> Parser Bool
switch :: Mod FlagFields Bool -> Parser Bool
switch = forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
False Bool
True

-- | An option that always fails.
--
-- When this option is encountered, the option parser immediately aborts with
-- the given parse error.  If you simply want to output a message, use
-- 'infoOption' instead.
abortOption :: ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
abortOption :: forall a.
ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
abortOption ParseError
err Mod OptionFields (a -> a)
m = forall a. ReadM a -> Mod OptionFields a -> Parser a
option (forall a. ParseError -> ReadM a
readerAbort ParseError
err) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Monoid a => a -> a -> a
`mappend` Mod OptionFields (a -> a)
m) forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
  [ forall a. ParseError -> Mod OptionFields a
noArgError ParseError
err
  , forall (f :: * -> *) a. HasValue f => a -> Mod f a
value forall a. a -> a
id
  , forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"" ]

-- | An option that always fails and displays a message.
infoOption :: String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption :: forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption = forall a.
ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
abortOption forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParseError
InfoMsg

-- | Builder for an option taking a 'String' argument.
strOption :: IsString s => Mod OptionFields s -> Parser s
strOption :: forall s. IsString s => Mod OptionFields s -> Parser s
strOption = forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall s. IsString s => ReadM s
str

-- | Builder for an option using the given reader.
--
-- This is a regular option, and should always have either a @long@ or
-- @short@ name specified in the modifiers (or both).
--
-- > nameParser = option str ( long "name" <> short 'n' )
--
option :: ReadM a -> Mod OptionFields a -> Parser a
option :: forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM a
r Mod OptionFields a
m = forall a.
DefaultProp a
-> (OptProperties -> OptProperties) -> OptReader a -> Parser a
mkParser DefaultProp a
d OptProperties -> OptProperties
g OptReader a
rdr
  where
    Mod OptionFields a -> OptionFields a
f DefaultProp a
d OptProperties -> OptProperties
g = forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"ARG" forall a. Monoid a => a -> a -> a
`mappend` Mod OptionFields a
m
    fields :: OptionFields a
fields = OptionFields a -> OptionFields a
f (forall a.
[OptName] -> Completer -> (String -> ParseError) -> OptionFields a
OptionFields [] forall a. Monoid a => a
mempty String -> ParseError
ExpectsArgError)
    crdr :: CReader a
crdr = forall a. Completer -> ReadM a -> CReader a
CReader (forall a. OptionFields a -> Completer
optCompleter OptionFields a
fields) ReadM a
r
    rdr :: OptReader a
rdr = forall a.
[OptName] -> CReader a -> (String -> ParseError) -> OptReader a
OptReader (forall a. OptionFields a -> [OptName]
optNames OptionFields a
fields) CReader a
crdr (forall a. OptionFields a -> String -> ParseError
optNoArgError OptionFields a
fields)

-- | Modifier for 'ParserInfo'.
newtype InfoMod a = InfoMod
  { forall a. InfoMod a -> ParserInfo a -> ParserInfo a
applyInfoMod :: ParserInfo a -> ParserInfo a }

instance Monoid (InfoMod a) where
  mempty :: InfoMod a
mempty = forall a. (ParserInfo a -> ParserInfo a) -> InfoMod a
InfoMod forall a. a -> a
id
  mappend :: InfoMod a -> InfoMod a -> InfoMod a
mappend = forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup (InfoMod a) where
  InfoMod a
m1 <> :: InfoMod a -> InfoMod a -> InfoMod a
<> InfoMod a
m2 = forall a. (ParserInfo a -> ParserInfo a) -> InfoMod a
InfoMod forall a b. (a -> b) -> a -> b
$ forall a. InfoMod a -> ParserInfo a -> ParserInfo a
applyInfoMod InfoMod a
m2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. InfoMod a -> ParserInfo a -> ParserInfo a
applyInfoMod InfoMod a
m1

-- | Show a full description in the help text of this parser (default).
fullDesc :: InfoMod a
fullDesc :: forall a. InfoMod a
fullDesc = forall a. (ParserInfo a -> ParserInfo a) -> InfoMod a
InfoMod forall a b. (a -> b) -> a -> b
$ \ParserInfo a
i -> ParserInfo a
i { infoFullDesc :: Bool
infoFullDesc = Bool
True }

-- | Only show a brief description in the help text of this parser.
briefDesc :: InfoMod a
briefDesc :: forall a. InfoMod a
briefDesc = forall a. (ParserInfo a -> ParserInfo a) -> InfoMod a
InfoMod forall a b. (a -> b) -> a -> b
$ \ParserInfo a
i -> ParserInfo a
i { infoFullDesc :: Bool
infoFullDesc = Bool
False }

-- | Specify a header for this parser.
header :: String -> InfoMod a
header :: forall a. String -> InfoMod a
header String
s = forall a. (ParserInfo a -> ParserInfo a) -> InfoMod a
InfoMod forall a b. (a -> b) -> a -> b
$ \ParserInfo a
i -> ParserInfo a
i { infoHeader :: Chunk Doc
infoHeader = String -> Chunk Doc
paragraph String
s }

-- | Specify a header for this parser as a 'Text.PrettyPrint.ANSI.Leijen.Doc'
-- value.
headerDoc :: Maybe Doc -> InfoMod a
headerDoc :: forall a. Maybe Doc -> InfoMod a
headerDoc Maybe Doc
doc = forall a. (ParserInfo a -> ParserInfo a) -> InfoMod a
InfoMod forall a b. (a -> b) -> a -> b
$ \ParserInfo a
i -> ParserInfo a
i { infoHeader :: Chunk Doc
infoHeader = forall a. Maybe a -> Chunk a
Chunk Maybe Doc
doc }

-- | Specify a footer for this parser.
footer :: String -> InfoMod a
footer :: forall a. String -> InfoMod a
footer String
s = forall a. (ParserInfo a -> ParserInfo a) -> InfoMod a
InfoMod forall a b. (a -> b) -> a -> b
$ \ParserInfo a
i -> ParserInfo a
i { infoFooter :: Chunk Doc
infoFooter = String -> Chunk Doc
paragraph String
s }

-- | Specify a footer for this parser as a 'Text.PrettyPrint.ANSI.Leijen.Doc'
-- value.
footerDoc :: Maybe Doc -> InfoMod a
footerDoc :: forall a. Maybe Doc -> InfoMod a
footerDoc Maybe Doc
doc = forall a. (ParserInfo a -> ParserInfo a) -> InfoMod a
InfoMod forall a b. (a -> b) -> a -> b
$ \ParserInfo a
i -> ParserInfo a
i { infoFooter :: Chunk Doc
infoFooter = forall a. Maybe a -> Chunk a
Chunk Maybe Doc
doc }

-- | Specify a short program description.
progDesc :: String -> InfoMod a
progDesc :: forall a. String -> InfoMod a
progDesc String
s = forall a. (ParserInfo a -> ParserInfo a) -> InfoMod a
InfoMod forall a b. (a -> b) -> a -> b
$ \ParserInfo a
i -> ParserInfo a
i { infoProgDesc :: Chunk Doc
infoProgDesc = String -> Chunk Doc
paragraph String
s }

-- | Specify a short program description as a 'Text.PrettyPrint.ANSI.Leijen.Doc'
-- value.
progDescDoc :: Maybe Doc -> InfoMod a
progDescDoc :: forall a. Maybe Doc -> InfoMod a
progDescDoc Maybe Doc
doc = forall a. (ParserInfo a -> ParserInfo a) -> InfoMod a
InfoMod forall a b. (a -> b) -> a -> b
$ \ParserInfo a
i -> ParserInfo a
i { infoProgDesc :: Chunk Doc
infoProgDesc = forall a. Maybe a -> Chunk a
Chunk Maybe Doc
doc }

-- | Specify an exit code if a parse error occurs.
failureCode :: Int -> InfoMod a
failureCode :: forall a. Int -> InfoMod a
failureCode Int
n = forall a. (ParserInfo a -> ParserInfo a) -> InfoMod a
InfoMod forall a b. (a -> b) -> a -> b
$ \ParserInfo a
i -> ParserInfo a
i { infoFailureCode :: Int
infoFailureCode = Int
n }

-- | Disable parsing of regular options after arguments. After a positional
--   argument is parsed, all remaining options and arguments will be treated
--   as a positional arguments. Not recommended in general as users often
--   expect to be able to freely intersperse regular options and flags within
--   command line options.
noIntersperse :: InfoMod a
noIntersperse :: forall a. InfoMod a
noIntersperse = forall a. (ParserInfo a -> ParserInfo a) -> InfoMod a
InfoMod forall a b. (a -> b) -> a -> b
$ \ParserInfo a
p -> ParserInfo a
p { infoPolicy :: ArgPolicy
infoPolicy = ArgPolicy
NoIntersperse }

-- | Intersperse matched options and arguments normally, but allow unmatched
--   options to be treated as positional arguments.
--   This is sometimes useful if one is wrapping a third party cli tool and
--   needs to pass options through, while also providing a handful of their
--   own options. Not recommended in general as typos by the user may not
--   yield a parse error and cause confusion.
forwardOptions :: InfoMod a
forwardOptions :: forall a. InfoMod a
forwardOptions = forall a. (ParserInfo a -> ParserInfo a) -> InfoMod a
InfoMod forall a b. (a -> b) -> a -> b
$ \ParserInfo a
p -> ParserInfo a
p { infoPolicy :: ArgPolicy
infoPolicy = ArgPolicy
ForwardOptions }

-- | Disable parsing of regular options completely. All options and arguments
--   will be treated as a positional arguments. Obviously not recommended in
--   general as options will be unreachable.
--   This is the same behaviour one sees after the "--" pseudo-argument.
allPositional :: InfoMod a
allPositional :: forall a. InfoMod a
allPositional = forall a. (ParserInfo a -> ParserInfo a) -> InfoMod a
InfoMod forall a b. (a -> b) -> a -> b
$ \ParserInfo a
p -> ParserInfo a
p { infoPolicy :: ArgPolicy
infoPolicy = ArgPolicy
AllPositionals }


-- | Create a 'ParserInfo' given a 'Parser' and a modifier.
info :: Parser a -> InfoMod a -> ParserInfo a
info :: forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser a
parser InfoMod a
m = forall a. InfoMod a -> ParserInfo a -> ParserInfo a
applyInfoMod InfoMod a
m ParserInfo a
base
  where
    base :: ParserInfo a
base = ParserInfo
      { infoParser :: Parser a
infoParser = Parser a
parser
      , infoFullDesc :: Bool
infoFullDesc = Bool
True
      , infoProgDesc :: Chunk Doc
infoProgDesc = forall a. Monoid a => a
mempty
      , infoHeader :: Chunk Doc
infoHeader = forall a. Monoid a => a
mempty
      , infoFooter :: Chunk Doc
infoFooter = forall a. Monoid a => a
mempty
      , infoFailureCode :: Int
infoFailureCode = Int
1
      , infoPolicy :: ArgPolicy
infoPolicy = ArgPolicy
Intersperse }

newtype PrefsMod = PrefsMod
  { PrefsMod -> ParserPrefs -> ParserPrefs
applyPrefsMod :: ParserPrefs -> ParserPrefs }

instance Monoid PrefsMod where
  mempty :: PrefsMod
mempty = (ParserPrefs -> ParserPrefs) -> PrefsMod
PrefsMod forall a. a -> a
id
  mappend :: PrefsMod -> PrefsMod -> PrefsMod
mappend = forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup PrefsMod where
  PrefsMod
m1 <> :: PrefsMod -> PrefsMod -> PrefsMod
<> PrefsMod
m2 = (ParserPrefs -> ParserPrefs) -> PrefsMod
PrefsMod forall a b. (a -> b) -> a -> b
$ PrefsMod -> ParserPrefs -> ParserPrefs
applyPrefsMod PrefsMod
m2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrefsMod -> ParserPrefs -> ParserPrefs
applyPrefsMod PrefsMod
m1

-- | Include a suffix to attach to the metavar when multiple values
--   can be entered.
multiSuffix :: String -> PrefsMod
multiSuffix :: String -> PrefsMod
multiSuffix String
s = (ParserPrefs -> ParserPrefs) -> PrefsMod
PrefsMod forall a b. (a -> b) -> a -> b
$ \ParserPrefs
p -> ParserPrefs
p { prefMultiSuffix :: String
prefMultiSuffix = String
s }

-- | Turn on disambiguation.
--
--   See
--   https://github.com/pcapriotti/optparse-applicative#disambiguation
disambiguate :: PrefsMod
disambiguate :: PrefsMod
disambiguate = (ParserPrefs -> ParserPrefs) -> PrefsMod
PrefsMod forall a b. (a -> b) -> a -> b
$ \ParserPrefs
p -> ParserPrefs
p { prefDisambiguate :: Bool
prefDisambiguate = Bool
True }

-- | Show full help text on any error.
showHelpOnError :: PrefsMod
showHelpOnError :: PrefsMod
showHelpOnError = (ParserPrefs -> ParserPrefs) -> PrefsMod
PrefsMod forall a b. (a -> b) -> a -> b
$ \ParserPrefs
p -> ParserPrefs
p { prefShowHelpOnError :: Bool
prefShowHelpOnError = Bool
True }

-- | Show the help text if the user enters only the program name or
--   subcommand.
--
--   This will suppress a "Missing:" error and show the full usage
--   instead if a user just types the name of the program.
showHelpOnEmpty :: PrefsMod
showHelpOnEmpty :: PrefsMod
showHelpOnEmpty = (ParserPrefs -> ParserPrefs) -> PrefsMod
PrefsMod forall a b. (a -> b) -> a -> b
$ \ParserPrefs
p -> ParserPrefs
p { prefShowHelpOnEmpty :: Bool
prefShowHelpOnEmpty = Bool
True }

-- | Turn off backtracking after subcommand is parsed.
noBacktrack :: PrefsMod
noBacktrack :: PrefsMod
noBacktrack = (ParserPrefs -> ParserPrefs) -> PrefsMod
PrefsMod forall a b. (a -> b) -> a -> b
$ \ParserPrefs
p -> ParserPrefs
p { prefBacktrack :: Backtracking
prefBacktrack = Backtracking
NoBacktrack }

-- | Allow full mixing of subcommand and parent arguments by inlining
-- selected subparsers into the parent parser.
--
-- /NOTE:/ When this option is used, preferences for the subparser which
-- effect the parser behaviour (such as noIntersperse) are ignored.
subparserInline :: PrefsMod
subparserInline :: PrefsMod
subparserInline = (ParserPrefs -> ParserPrefs) -> PrefsMod
PrefsMod forall a b. (a -> b) -> a -> b
$ \ParserPrefs
p -> ParserPrefs
p { prefBacktrack :: Backtracking
prefBacktrack = Backtracking
SubparserInline }

-- | Set the maximum width of the generated help text.
columns :: Int -> PrefsMod
columns :: Int -> PrefsMod
columns Int
cols = (ParserPrefs -> ParserPrefs) -> PrefsMod
PrefsMod forall a b. (a -> b) -> a -> b
$ \ParserPrefs
p -> ParserPrefs
p { prefColumns :: Int
prefColumns = Int
cols }

-- | Show equals sign, rather than space, in usage and help text for options with
-- long names.
helpLongEquals :: PrefsMod
helpLongEquals :: PrefsMod
helpLongEquals = (ParserPrefs -> ParserPrefs) -> PrefsMod
PrefsMod forall a b. (a -> b) -> a -> b
$ \ParserPrefs
p -> ParserPrefs
p { prefHelpLongEquals :: Bool
prefHelpLongEquals = Bool
True }

-- | Show global help information in subparser usage.
helpShowGlobals :: PrefsMod
helpShowGlobals :: PrefsMod
helpShowGlobals = (ParserPrefs -> ParserPrefs) -> PrefsMod
PrefsMod forall a b. (a -> b) -> a -> b
$ \ParserPrefs
p -> ParserPrefs
p { prefHelpShowGlobal :: Bool
prefHelpShowGlobal = Bool
True }

-- | Set fill width in help text presentation.
helpIndent :: Int -> PrefsMod
helpIndent :: Int -> PrefsMod
helpIndent Int
w = (ParserPrefs -> ParserPrefs) -> PrefsMod
PrefsMod forall a b. (a -> b) -> a -> b
$ \ParserPrefs
p -> ParserPrefs
p { prefTabulateFill :: Int
prefTabulateFill = Int
w }



-- | Create a `ParserPrefs` given a modifier
prefs :: PrefsMod -> ParserPrefs
prefs :: PrefsMod -> ParserPrefs
prefs PrefsMod
m = PrefsMod -> ParserPrefs -> ParserPrefs
applyPrefsMod PrefsMod
m ParserPrefs
base
  where
    base :: ParserPrefs
base = ParserPrefs
      { prefMultiSuffix :: String
prefMultiSuffix = String
""
      , prefDisambiguate :: Bool
prefDisambiguate = Bool
False
      , prefShowHelpOnError :: Bool
prefShowHelpOnError = Bool
False
      , prefShowHelpOnEmpty :: Bool
prefShowHelpOnEmpty = Bool
False
      , prefBacktrack :: Backtracking
prefBacktrack = Backtracking
Backtrack
      , prefColumns :: Int
prefColumns = Int
80
      , prefHelpLongEquals :: Bool
prefHelpLongEquals = Bool
False
      , prefHelpShowGlobal :: Bool
prefHelpShowGlobal = Bool
False
      , prefTabulateFill :: Int
prefTabulateFill = Int
24 }

-- Convenience shortcuts

-- | Trivial option modifier.
idm :: Monoid m => m
idm :: forall a. Monoid a => a
idm = forall a. Monoid a => a
mempty

-- | Default preferences.
defaultPrefs :: ParserPrefs
defaultPrefs :: ParserPrefs
defaultPrefs = PrefsMod -> ParserPrefs
prefs forall a. Monoid a => a
idm