Copyright | Copyright © 2015 PivotCloud Inc. |
---|---|
License | MIT |
Maintainer | Lars Kuhtz <lkuhtz@pivotmail.com> |
Stability | experimental |
Safe Haskell | None |
Language | Haskell2010 |
This module provides tools for defining command line parsers for configuration types.
Unlike normal command line parsers the parsers for configuration types are expected to yield an update function that takes a value and updates the value with the settings from the command line.
Assuming that
- all configuration types are nested Haskell records or simple types and
- that there are lenses for all record fields
usually the operators .::
and %::
are all that is needed from this module.
The module Configuration.Utils.Monoid provides tools for the case that
a simple type is a container with a monoid instance, such as List
or
HashMap
.
The module Configuration.Utils.Maybe explains the usage of optional
Maybe
values in configuration types.
Synopsis
- type MParser a = Parser (a -> a)
- (.::) :: (Alternative f, Applicative f) => Lens' a b -> f b -> f (a -> a)
- (%::) :: (Alternative f, Applicative f) => Lens' a b -> f (b -> b) -> f (a -> a)
- boolReader :: (Eq a, Show a, FoldCase a, IsString a, IsString e, Monoid e) => a -> Either e Bool
- boolOption :: Mod OptionFields Bool -> Parser Bool
- boolOption_ :: Mod FlagFields Bool -> Parser Bool
- enableDisableFlag :: Mod FlagFields Bool -> Parser Bool
- fileOption :: Mod OptionFields String -> Parser FilePath
- eitherReadP :: Text -> ReadP a -> Text -> Either Text a
- jsonOption :: FromJSON a => Mod OptionFields a -> Parser a
- jsonReader :: FromJSON a => ReadM a
- (<$) :: Functor f => a -> f b -> f a
- class Functor f => Applicative (f :: Type -> Type) where
- mappend :: Monoid a => a -> a -> a
- class Applicative f => Alternative (f :: Type -> Type) where
- (<$>) :: Functor f => (a -> b) -> f a -> f b
- optional :: Alternative f => f a -> f (Maybe a)
- newtype WrappedMonad (m :: Type -> Type) a = WrapMonad {
- unwrapMonad :: m a
- newtype WrappedArrow (a :: Type -> Type -> Type) b c = WrapArrow {
- unwrapArrow :: a b c
- newtype ZipList a = ZipList {
- getZipList :: [a]
- newtype Const a (b :: k) = Const {
- getConst :: a
- liftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
- liftA :: Applicative f => (a -> b) -> f a -> f b
- (<**>) :: Applicative f => f a -> f (a -> b) -> f b
- renderFailure :: ParserFailure ParserHelp -> String -> (String, ExitCode)
- parserFailure :: ParserPrefs -> ParserInfo a -> ParseError -> [Context] -> ParserFailure ParserHelp
- execParserPure :: ParserPrefs -> ParserInfo a -> [String] -> ParserResult a
- getParseResult :: ParserResult a -> Maybe a
- handleParseResult :: ParserResult a -> IO a
- customExecParser :: ParserPrefs -> ParserInfo a -> IO a
- execParser :: ParserInfo a -> IO a
- hsubparser :: Mod CommandFields a -> Parser a
- helper :: Parser (a -> a)
- defaultPrefs :: ParserPrefs
- idm :: Monoid m => m
- prefs :: PrefsMod -> ParserPrefs
- helpShowGlobals :: PrefsMod
- helpLongEquals :: PrefsMod
- columns :: Int -> PrefsMod
- subparserInline :: PrefsMod
- noBacktrack :: PrefsMod
- showHelpOnEmpty :: PrefsMod
- showHelpOnError :: PrefsMod
- disambiguate :: PrefsMod
- multiSuffix :: String -> PrefsMod
- info :: Parser a -> InfoMod a -> ParserInfo a
- forwardOptions :: InfoMod a
- noIntersperse :: InfoMod a
- failureCode :: Int -> InfoMod a
- progDescDoc :: Maybe Doc -> InfoMod a
- progDesc :: String -> InfoMod a
- footerDoc :: Maybe Doc -> InfoMod a
- footer :: String -> InfoMod a
- headerDoc :: Maybe Doc -> InfoMod a
- header :: String -> InfoMod a
- briefDesc :: InfoMod a
- fullDesc :: InfoMod a
- option :: ReadM a -> Mod OptionFields a -> Parser a
- strOption :: IsString s => Mod OptionFields s -> Parser s
- infoOption :: String -> Mod OptionFields (a -> a) -> Parser (a -> a)
- abortOption :: ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
- switch :: Mod FlagFields Bool -> Parser Bool
- flag' :: a -> Mod FlagFields a -> Parser a
- flag :: a -> a -> Mod FlagFields a -> Parser a
- strArgument :: IsString s => Mod ArgumentFields s -> Parser s
- argument :: ReadM a -> Mod ArgumentFields a -> Parser a
- subparser :: Mod CommandFields a -> Parser a
- completer :: forall (f :: Type -> Type) a. HasCompleter f => Completer -> Mod f a
- action :: forall (f :: Type -> Type) a. HasCompleter f => String -> Mod f a
- completeWith :: forall (f :: Type -> Type) a. HasCompleter f => [String] -> Mod f a
- commandGroup :: String -> Mod CommandFields a
- command :: String -> ParserInfo a -> Mod CommandFields a
- style :: forall (f :: Type -> Type) a. (Doc -> Doc) -> Mod f a
- hidden :: forall (f :: Type -> Type) a. Mod f a
- metavar :: forall (f :: Type -> Type) a. HasMetavar f => String -> Mod f a
- noArgError :: ParseError -> Mod OptionFields a
- helpDoc :: forall (f :: Type -> Type) a. Maybe Doc -> Mod f a
- help :: forall (f :: Type -> Type) a. String -> Mod f a
- showDefault :: forall a (f :: Type -> Type). Show a => Mod f a
- showDefaultWith :: forall a (f :: Type -> Type). (a -> String) -> Mod f a
- value :: forall (f :: Type -> Type) a. HasValue f => a -> Mod f a
- long :: forall (f :: Type -> Type) a. HasName f => String -> Mod f a
- short :: forall (f :: Type -> Type) a. HasName f => Char -> Mod f a
- disabled :: ReadM a
- maybeReader :: (String -> Maybe a) -> ReadM a
- eitherReader :: (String -> Either String a) -> ReadM a
- str :: IsString s => ReadM s
- auto :: Read a => ReadM a
- data InfoMod a
- data PrefsMod
- bashCompleter :: String -> Completer
- listCompleter :: [String] -> Completer
- listIOCompleter :: IO [String] -> Completer
- internal :: forall (f :: Type -> Type) a. Mod f a
- data OptionFields a
- data FlagFields a
- data CommandFields a
- data ArgumentFields a
- class HasName (f :: Type -> Type)
- class HasCompleter (f :: Type -> Type)
- class HasValue (f :: Type -> Type)
- class HasMetavar (f :: Type -> Type)
- data Mod (f :: Type -> Type) a
- overFailure :: (ParserHelp -> ParserHelp) -> ParserResult a -> ParserResult a
- mkCompleter :: (String -> IO [String]) -> Completer
- readerError :: String -> ReadM a
- readerAbort :: ParseError -> ReadM a
- data ParseError
- data ParserInfo a = ParserInfo {
- infoParser :: Parser a
- infoFullDesc :: Bool
- infoProgDesc :: Chunk Doc
- infoHeader :: Chunk Doc
- infoFooter :: Chunk Doc
- infoFailureCode :: Int
- infoPolicy :: ArgPolicy
- data ParserPrefs = ParserPrefs {}
- data ReadM a
- data Completer
- newtype CompletionResult = CompletionResult {
- execCompletion :: String -> IO String
- newtype ParserFailure h = ParserFailure {
- execFailure :: String -> (h, ExitCode, Int)
- data ParserResult a
- data ParserHelp = ParserHelp {}
Documentation
(.::) :: (Alternative f, Applicative f) => Lens' a b -> f b -> f (a -> a) infixr 5 Source #
An operator for applying a setter to an option parser that yields a value.
Example usage:
data Auth = Auth { _user ∷ !String , _pwd ∷ !String } user ∷ Functor f ⇒ (String → f String) → Auth → f Auth user f s = (\u → s { _user = u }) <$> f (_user s) pwd ∷ Functor f ⇒ (String → f String) → Auth → f Auth pwd f s = (\p → s { _pwd = p }) <$> f (_pwd s) -- or with lenses and TemplateHaskell just: -- $(makeLenses ''Auth) pAuth ∷ MParser Auth pAuth = id <$< user .:: strOption % long "user" ⊕ short 'u' ⊕ help "user name" <*< pwd .:: strOption % long "pwd" ⊕ help "password for user"
(%::) :: (Alternative f, Applicative f) => Lens' a b -> f (b -> b) -> f (a -> a) infixr 5 Source #
An operator for applying a setter to an option parser that yields a modification function.
Example usage:
data HttpURL = HttpURL { _auth ∷ !Auth , _domain ∷ !String } auth ∷ Functor f ⇒ (Auth → f Auth) → HttpURL → f HttpURL auth f s = (\u → s { _auth = u }) <$> f (_auth s) domain ∷ Functor f ⇒ (String → f String) → HttpURL → f HttpURL domain f s = (\u → s { _domain = u }) <$> f (_domain s) path ∷ Functor f ⇒ (String → f String) → HttpURL → f HttpURL path f s = (\u → s { _path = u }) <$> f (_path s) -- or with lenses and TemplateHaskell just: -- $(makeLenses ''HttpURL) pHttpURL ∷ MParser HttpURL pHttpURL = id <$< auth %:: pAuth <*< domain .:: strOption % long "domain" ⊕ short 'd' ⊕ help "HTTP domain"
Misc Utils
boolReader :: (Eq a, Show a, FoldCase a, IsString a, IsString e, Monoid e) => a -> Either e Bool Source #
boolOption :: Mod OptionFields Bool -> Parser Bool Source #
The boolOption
is an alternative to switch
.
Using switch
with command line parsers that overwrite settings
from a configuration file is problematic: the absence of the switch
is interpreted as setting the respective configuration value to False
.
So there is no way to specify on the command line that the value from
the configuration file shall be used. Some command line UIs use two
different options for those values, for instance --enable-feature
and
--disable-feature
. This option instead expects a Boolean value. Beside
that it behaves like any other option.
boolOption_ :: Mod FlagFields Bool -> Parser Bool Source #
An alternative syntax for boolOption
for options with long names.
Instead of taking a boolean argument the presence of the option acts as a
switch to set the respective configuration setting to True
. If the option
is not present the setting is left unchanged.
In addition for long option names a respective unset flag is provided. For
instance for a flag --verbose
there will also be a flag --no-verbose
.
This can still be used with short option names only, but no unset flag would be provided.
enableDisableFlag :: Mod FlagFields Bool -> Parser Bool Source #
An option parser for flags that are enabled via the flag name prefixed
with --enable-
and disabled via the flag name prefix --disable-
. The
prefixes are applied to all long option names. Short option names are parsed
unchanged and cause the flag to be enabled.
This resembles the style of flags that is used for instances with Cabal.
fileOption :: Mod OptionFields String -> Parser FilePath Source #
An option that expects a file name.
eitherReadP :: Text -> ReadP a -> Text -> Either Text a Source #
Create an either-reader from a ReadP
parser.
jsonOption :: FromJSON a => Mod OptionFields a -> Parser a Source #
An option that expects a JSON value as argument.
jsonReader :: FromJSON a => ReadM a Source #
An option reader for a JSON value.
class Functor f => Applicative (f :: Type -> Type) where #
A functor with application, providing operations to
A minimal complete definition must include implementations of pure
and of either <*>
or liftA2
. If it defines both, then they must behave
the same as their default definitions:
(<*>
) =liftA2
id
liftA2
f x y = f<$>
x<*>
y
Further, any definition must satisfy the following:
- Identity
pure
id
<*>
v = v- Composition
pure
(.)<*>
u<*>
v<*>
w = u<*>
(v<*>
w)- Homomorphism
pure
f<*>
pure
x =pure
(f x)- Interchange
u
<*>
pure
y =pure
($
y)<*>
u
The other methods have the following default definitions, which may be overridden with equivalent specialized implementations:
As a consequence of these laws, the Functor
instance for f
will satisfy
It may be useful to note that supposing
forall x y. p (q x y) = f x . g y
it follows from the above that
liftA2
p (liftA2
q u v) =liftA2
f u .liftA2
g v
If f
is also a Monad
, it should satisfy
(which implies that pure
and <*>
satisfy the applicative functor laws).
Lift a value.
(<*>) :: f (a -> b) -> f a -> f b infixl 4 #
Sequential application.
A few functors support an implementation of <*>
that is more
efficient than the default one.
Using ApplicativeDo
: 'fs
' can be understood as
the <*>
asdo
expression
do f <- fs a <- as pure (f a)
liftA2 :: (a -> b -> c) -> f a -> f b -> f c #
Lift a binary function to actions.
Some functors support an implementation of liftA2
that is more
efficient than the default one. In particular, if fmap
is an
expensive operation, it is likely better to use liftA2
than to
fmap
over the structure and then use <*>
.
This became a typeclass method in 4.10.0.0. Prior to that, it was
a function defined in terms of <*>
and fmap
.
Using ApplicativeDo
: '
' can be understood
as the liftA2
f as bsdo
expression
do a <- as b <- bs pure (f a b)
(*>) :: f a -> f b -> f b infixl 4 #
Sequence actions, discarding the value of the first argument.
'as
' can be understood as the *>
bsdo
expression
do as bs
This is a tad complicated for our ApplicativeDo
extension
which will give it a Monad
constraint. For an Applicative
constraint we write it of the form
do _ <- as b <- bs pure b
(<*) :: f a -> f b -> f a infixl 4 #
Sequence actions, discarding the value of the second argument.
Using ApplicativeDo
: 'as
' can be understood as
the <*
bsdo
expression
do a <- as bs pure a
Instances
mappend :: Monoid a => a -> a -> a #
An associative operation
NOTE: This method is redundant and has the default
implementation
since base-4.11.0.0.
Should it be implemented manually, since mappend
= (<>
)mappend
is a synonym for
(<>
), it is expected that the two functions are defined the same
way. In a future GHC release mappend
will be removed from Monoid
.
class Applicative f => Alternative (f :: Type -> Type) where #
A monoid on applicative functors.
If defined, some
and many
should be the least solutions
of the equations:
The identity of <|>
(<|>) :: f a -> f a -> f a infixl 3 #
An associative binary operation
One or more.
Zero or more.
Instances
(<$>) :: Functor f => (a -> b) -> f a -> f b infixl 4 #
An infix synonym for fmap
.
The name of this operator is an allusion to $
.
Note the similarities between their types:
($) :: (a -> b) -> a -> b (<$>) :: Functor f => (a -> b) -> f a -> f b
Whereas $
is function application, <$>
is function
application lifted over a Functor
.
Examples
Convert from a
to a Maybe
Int
using Maybe
String
show
:
>>>
show <$> Nothing
Nothing>>>
show <$> Just 3
Just "3"
Convert from an
to an
Either
Int
Int
Either
Int
String
using show
:
>>>
show <$> Left 17
Left 17>>>
show <$> Right 17
Right "17"
Double each element of a list:
>>>
(*2) <$> [1,2,3]
[2,4,6]
Apply even
to the second element of a pair:
>>>
even <$> (2,2)
(2,True)
optional :: Alternative f => f a -> f (Maybe a) #
One or none.
newtype WrappedMonad (m :: Type -> Type) a #
WrapMonad | |
|
Instances
newtype WrappedArrow (a :: Type -> Type -> Type) b c #
WrapArrow | |
|
Instances
Lists, but with an Applicative
functor based on zipping.
ZipList | |
|
Instances
Functor ZipList | Since: base-2.1 |
Applicative ZipList | f <$> ZipList xs1 <*> ... <*> ZipList xsN = ZipList (zipWithN f xs1 ... xsN) where (\a b c -> stimes c [a, b]) <$> ZipList "abcd" <*> ZipList "567" <*> ZipList [1..] = ZipList (zipWith3 (\a b c -> stimes c [a, b]) "abcd" "567" [1..]) = ZipList {getZipList = ["a5","b6b6","c7c7c7"]} Since: base-2.1 |
Foldable ZipList | Since: base-4.9.0.0 |
Defined in Control.Applicative fold :: Monoid m => ZipList m -> m # foldMap :: Monoid m => (a -> m) -> ZipList a -> m # foldMap' :: Monoid m => (a -> m) -> ZipList a -> m # foldr :: (a -> b -> b) -> b -> ZipList a -> b # foldr' :: (a -> b -> b) -> b -> ZipList a -> b # foldl :: (b -> a -> b) -> b -> ZipList a -> b # foldl' :: (b -> a -> b) -> b -> ZipList a -> b # foldr1 :: (a -> a -> a) -> ZipList a -> a # foldl1 :: (a -> a -> a) -> ZipList a -> a # elem :: Eq a => a -> ZipList a -> Bool # maximum :: Ord a => ZipList a -> a # minimum :: Ord a => ZipList a -> a # | |
Traversable ZipList | Since: base-4.9.0.0 |
Alternative ZipList | Since: base-4.11.0.0 |
NFData1 ZipList | Since: deepseq-1.4.3.0 |
Defined in Control.DeepSeq | |
Apply ZipList | |
IsList (ZipList a) | Since: base-4.15.0.0 |
Eq a => Eq (ZipList a) | Since: base-4.7.0.0 |
Ord a => Ord (ZipList a) | Since: base-4.7.0.0 |
Defined in Control.Applicative | |
Read a => Read (ZipList a) | Since: base-4.7.0.0 |
Show a => Show (ZipList a) | Since: base-4.7.0.0 |
Generic (ZipList a) | Since: base-4.7.0.0 |
NFData a => NFData (ZipList a) | Since: deepseq-1.4.0.0 |
Defined in Control.DeepSeq | |
Generic1 ZipList | Since: base-4.7.0.0 |
type Rep (ZipList a) | |
Defined in Control.Applicative | |
type Item (ZipList a) | |
type Rep1 ZipList | |
Defined in Control.Applicative |
The Const
functor.
Instances
liftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d #
Lift a ternary function to actions.
Using ApplicativeDo
: '
' can be understood
as the liftA3
f as bs csdo
expression
do a <- as b <- bs c <- cs pure (f a b c)
liftA :: Applicative f => (a -> b) -> f a -> f b #
(<**>) :: Applicative f => f a -> f (a -> b) -> f b infixl 4 #
renderFailure :: ParserFailure ParserHelp -> String -> (String, ExitCode) #
parserFailure :: ParserPrefs -> ParserInfo a -> ParseError -> [Context] -> ParserFailure ParserHelp #
Generate a ParserFailure
from a ParseError
in a given Context
.
This function can be used, for example, to show the help text for a parser:
handleParseResult . Failure $ parserFailure pprefs pinfo ShowHelpText mempty
:: ParserPrefs | Global preferences for this parser |
-> ParserInfo a | Description of the program to run |
-> [String] | Program arguments |
-> ParserResult a |
The most general way to run a program description in pure code.
getParseResult :: ParserResult a -> Maybe a #
Extract the actual result from a ParserResult
value.
This function returns Nothing
in case of errors. Possible error messages
or completion actions are simply discarded.
If you want to display error messages and invoke completion actions
appropriately, use handleParseResult
instead.
handleParseResult :: ParserResult a -> IO a #
Handle ParserResult
.
customExecParser :: ParserPrefs -> ParserInfo a -> IO a #
Run a program description with custom preferences.
execParser :: ParserInfo a -> IO a #
Run a program description.
Parse command line arguments. Display help text and exit if any parse error occurs.
hsubparser :: Mod CommandFields a -> Parser a #
Builder for a command parser with a "helper" option attached.
Used in the same way as subparser
, but includes a "--help|-h" inside
the subcommand.
A hidden "helper" option which always fails.
A common usage pattern is to apply this applicatively when
creating a ParserInfo
opts :: ParserInfo Sample opts = info (sample <**> helper) mempty
Default preferences.
prefs :: PrefsMod -> ParserPrefs #
Create a ParserPrefs
given a modifier
Show global help information in subparser usage
Show equals sign, rather than space, in usage and help text for options with long names.
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.
noBacktrack :: PrefsMod #
Turn off backtracking after subcommand is parsed.
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.
Show full help text on any error.
Turn on disambiguation.
See https://github.com/pcapriotti/optparse-applicative#disambiguation
multiSuffix :: String -> PrefsMod #
Include a suffix to attach to the metavar when multiple values can be entered.
info :: Parser a -> InfoMod a -> ParserInfo a #
Create a ParserInfo
given a Parser
and a modifier.
forwardOptions :: InfoMod a #
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.
noIntersperse :: InfoMod a #
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.
failureCode :: Int -> InfoMod a #
Specify an exit code if a parse error occurs.
option :: ReadM a -> Mod OptionFields a -> Parser a #
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' )
strOption :: IsString s => Mod OptionFields s -> Parser s #
Builder for an option taking a String
argument.
infoOption :: String -> Mod OptionFields (a -> a) -> Parser (a -> a) #
An option that always fails and displays a message.
abortOption :: ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a) #
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.
:: a | active value |
-> Mod FlagFields a | option modifier |
-> Parser a |
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.
:: a | default value |
-> a | active value |
-> Mod FlagFields a | option modifier |
-> Parser a |
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'
.
strArgument :: IsString s => Mod ArgumentFields s -> Parser s #
Builder for a String
argument.
subparser :: Mod CommandFields a -> Parser a #
Builder for a command parser. The command
modifier can be used to
specify individual commands.
completer :: forall (f :: Type -> Type) a. HasCompleter f => Completer -> Mod f a #
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.
action :: forall (f :: Type -> Type) a. HasCompleter f => String -> Mod f a #
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.
completeWith :: forall (f :: Type -> Type) a. HasCompleter f => [String] -> Mod f a #
Add a list of possible completion values.
commandGroup :: String -> Mod CommandFields a #
command :: String -> ParserInfo a -> Mod CommandFields a #
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")) )
style :: forall (f :: Type -> Type) a. (Doc -> Doc) -> Mod f a #
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
used const
to completely replace the usage text of an option.
forall (f :: Type -> Type) a. Mod f a #
::Hide this option from the brief description.
Use internal
to hide the option from the help text too.
metavar :: forall (f :: Type -> Type) a. HasMetavar f => String -> Mod f a #
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.
noArgError :: ParseError -> Mod OptionFields a #
Specify the error to display when no argument is provided to this option.
helpDoc :: forall (f :: Type -> Type) a. Maybe Doc -> Mod f a #
Specify the help text for an option as a Doc
value.
showDefault :: forall a (f :: Type -> Type). Show a => Mod f a #
Show the default value for this option using its Show
instance.
showDefaultWith :: forall a (f :: Type -> Type). (a -> String) -> Mod f a #
Specify a function to show the default value for an option.
value :: forall (f :: Type -> Type) a. HasValue f => a -> Mod f a #
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.
long :: forall (f :: Type -> Type) a. HasName f => String -> Mod f a #
Specify a long name for an option.
short :: forall (f :: Type -> Type) a. HasName f => Char -> Mod f a #
Specify a short name for an option.
eitherReader :: (String -> Either String a) -> ReadM a #
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)
Modifier for ParserInfo
.
bashCompleter :: String -> Completer #
Run a compgen 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.
listCompleter :: [String] -> Completer #
Create a Completer
from a constant
list of strings.
internal :: forall (f :: Type -> Type) a. Mod f a #
Hide this option completely from the help text
Use hidden
if the option should remain visible in the full description.
data OptionFields a #
Instances
HasName OptionFields | |
Defined in Options.Applicative.Builder.Internal name :: OptName -> OptionFields a -> OptionFields a # | |
HasCompleter OptionFields | |
Defined in Options.Applicative.Builder.Internal modCompleter :: (Completer -> Completer) -> OptionFields a -> OptionFields a # | |
HasValue OptionFields | |
Defined in Options.Applicative.Builder.Internal hasValueDummy :: OptionFields a -> () # | |
HasMetavar OptionFields | |
Defined in Options.Applicative.Builder.Internal hasMetavarDummy :: OptionFields a -> () # |
data FlagFields a #
Instances
HasName FlagFields | |
Defined in Options.Applicative.Builder.Internal name :: OptName -> FlagFields a -> FlagFields a # |
data CommandFields a #
Instances
HasMetavar CommandFields | |
Defined in Options.Applicative.Builder.Internal hasMetavarDummy :: CommandFields a -> () # |
data ArgumentFields a #
Instances
HasCompleter ArgumentFields | |
Defined in Options.Applicative.Builder.Internal modCompleter :: (Completer -> Completer) -> ArgumentFields a -> ArgumentFields a # | |
HasValue ArgumentFields | |
Defined in Options.Applicative.Builder.Internal hasValueDummy :: ArgumentFields a -> () # | |
HasMetavar ArgumentFields | |
Defined in Options.Applicative.Builder.Internal hasMetavarDummy :: ArgumentFields a -> () # |
class HasName (f :: Type -> Type) #
Instances
HasName OptionFields | |
Defined in Options.Applicative.Builder.Internal name :: OptName -> OptionFields a -> OptionFields a # | |
HasName FlagFields | |
Defined in Options.Applicative.Builder.Internal name :: OptName -> FlagFields a -> FlagFields a # |
class HasCompleter (f :: Type -> Type) #
Instances
HasCompleter OptionFields | |
Defined in Options.Applicative.Builder.Internal modCompleter :: (Completer -> Completer) -> OptionFields a -> OptionFields a # | |
HasCompleter ArgumentFields | |
Defined in Options.Applicative.Builder.Internal modCompleter :: (Completer -> Completer) -> ArgumentFields a -> ArgumentFields a # |
class HasValue (f :: Type -> Type) #
Instances
HasValue OptionFields | |
Defined in Options.Applicative.Builder.Internal hasValueDummy :: OptionFields a -> () # | |
HasValue ArgumentFields | |
Defined in Options.Applicative.Builder.Internal hasValueDummy :: ArgumentFields a -> () # |
class HasMetavar (f :: Type -> Type) #
Instances
HasMetavar OptionFields | |
Defined in Options.Applicative.Builder.Internal hasMetavarDummy :: OptionFields a -> () # | |
HasMetavar CommandFields | |
Defined in Options.Applicative.Builder.Internal hasMetavarDummy :: CommandFields a -> () # | |
HasMetavar ArgumentFields | |
Defined in Options.Applicative.Builder.Internal hasMetavarDummy :: ArgumentFields a -> () # |
data Mod (f :: Type -> Type) a #
An option modifier.
Option modifiers are values that represent a modification of the properties of an option.
The type parameter a
is the return type of the option, while f
is a
record containing its properties (e.g. OptionFields
for regular options,
FlagFields
for flags, etc...).
An option modifier consists of 3 elements:
- A field modifier, of the form
f a -> f a
. These are essentially (compositions of) setters for some of the properties supported byf
. - An optional default value and function to display it.
- A property modifier, of the form
OptProperties -> OptProperties
. This is just like the field modifier, but for properties applicable to any option.
Modifiers are instances of Monoid
, and can be composed as such.
One rarely needs to deal with modifiers directly, as most of the times it is
sufficient to pass them to builders (such as strOption
or flag
) to
create options (see Builder
).
overFailure :: (ParserHelp -> ParserHelp) -> ParserResult a -> ParserResult a #
readerError :: String -> ReadM a #
Abort option reader by exiting with an error message.
readerAbort :: ParseError -> ReadM a #
Abort option reader by exiting with a ParseError
.
data ParseError #
ErrorMsg String | |
InfoMsg String | |
ShowHelpText (Maybe String) | |
UnknownError | |
MissingError IsCmdStart SomeParser | |
ExpectsArgError String | |
UnexpectedError String SomeParser |
Instances
Semigroup ParseError | |
Defined in Options.Applicative.Types (<>) :: ParseError -> ParseError -> ParseError # sconcat :: NonEmpty ParseError -> ParseError # stimes :: Integral b => b -> ParseError -> ParseError # | |
Monoid ParseError | |
Defined in Options.Applicative.Types mempty :: ParseError # mappend :: ParseError -> ParseError -> ParseError # mconcat :: [ParseError] -> ParseError # |
data ParserInfo a #
A full description for a runnable Parser
for a program.
ParserInfo | |
|
Instances
Functor ParserInfo | |
Defined in Options.Applicative.Types fmap :: (a -> b) -> ParserInfo a -> ParserInfo b # (<$) :: a -> ParserInfo b -> ParserInfo a # |
data ParserPrefs #
Global preferences for a top-level Parser
.
ParserPrefs | |
|
Instances
Eq ParserPrefs | |
Defined in Options.Applicative.Types (==) :: ParserPrefs -> ParserPrefs -> Bool # (/=) :: ParserPrefs -> ParserPrefs -> Bool # | |
Show ParserPrefs | |
Defined in Options.Applicative.Types showsPrec :: Int -> ParserPrefs -> ShowS # show :: ParserPrefs -> String # showList :: [ParserPrefs] -> ShowS # |
A newtype over 'ReaderT String Except', used by option readers.
Instances
newtype CompletionResult #
Instances
Show CompletionResult | |
Defined in Options.Applicative.Types showsPrec :: Int -> CompletionResult -> ShowS # show :: CompletionResult -> String # showList :: [CompletionResult] -> ShowS # |
newtype ParserFailure h #
ParserFailure | |
|
Instances
Functor ParserFailure | |
Defined in Options.Applicative.Types fmap :: (a -> b) -> ParserFailure a -> ParserFailure b # (<$) :: a -> ParserFailure b -> ParserFailure a # | |
Show h => Show (ParserFailure h) | |
Defined in Options.Applicative.Types showsPrec :: Int -> ParserFailure h -> ShowS # show :: ParserFailure h -> String # showList :: [ParserFailure h] -> ShowS # |
data ParserResult a #
Result of execParserPure
.
Instances
Monad ParserResult | |
Defined in Options.Applicative.Types (>>=) :: ParserResult a -> (a -> ParserResult b) -> ParserResult b # (>>) :: ParserResult a -> ParserResult b -> ParserResult b # return :: a -> ParserResult a # | |
Functor ParserResult | |
Defined in Options.Applicative.Types fmap :: (a -> b) -> ParserResult a -> ParserResult b # (<$) :: a -> ParserResult b -> ParserResult a # | |
Applicative ParserResult | |
Defined in Options.Applicative.Types pure :: a -> ParserResult a # (<*>) :: ParserResult (a -> b) -> ParserResult a -> ParserResult b # liftA2 :: (a -> b -> c) -> ParserResult a -> ParserResult b -> ParserResult c # (*>) :: ParserResult a -> ParserResult b -> ParserResult b # (<*) :: ParserResult a -> ParserResult b -> ParserResult a # | |
Show a => Show (ParserResult a) | |
Defined in Options.Applicative.Types showsPrec :: Int -> ParserResult a -> ShowS # show :: ParserResult a -> String # showList :: [ParserResult a] -> ShowS # |
data ParserHelp #
Instances
Show ParserHelp | |
Defined in Options.Applicative.Help.Types showsPrec :: Int -> ParserHelp -> ShowS # show :: ParserHelp -> String # showList :: [ParserHelp] -> ShowS # | |
Semigroup ParserHelp | |
Defined in Options.Applicative.Help.Types (<>) :: ParserHelp -> ParserHelp -> ParserHelp # sconcat :: NonEmpty ParserHelp -> ParserHelp # stimes :: Integral b => b -> ParserHelp -> ParserHelp # | |
Monoid ParserHelp | |
Defined in Options.Applicative.Help.Types mempty :: ParserHelp # mappend :: ParserHelp -> ParserHelp -> ParserHelp # mconcat :: [ParserHelp] -> ParserHelp # |