Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Synopsis
- setting :: HasCallStack => [Builder a] -> Parser a
- filePathSetting :: HasCallStack => [Builder FilePath] -> Parser (Path Abs File)
- directoryPathSetting :: HasCallStack => [Builder FilePath] -> Parser (Path Abs Dir)
- strOption :: HasCallStack => IsString string => [Builder string] -> Parser string
- strArgument :: HasCallStack => IsString string => [Builder string] -> Parser string
- choice :: HasCallStack => [Parser a] -> Parser a
- mapIO :: HasCallStack => (a -> IO b) -> Parser a -> Parser b
- runIO :: HasCallStack => IO a -> Parser a
- checkEither :: HasCallStack => (a -> Either String b) -> Parser a -> Parser b
- checkMaybe :: HasCallStack => (a -> Maybe a) -> Parser a -> Parser a
- checkMapEither :: HasCallStack => (a -> Either String b) -> Parser a -> Parser b
- checkMapIO :: HasCallStack => (a -> IO (Either String b)) -> Parser a -> Parser b
- checkMapMaybe :: HasCallStack => (a -> Maybe b) -> Parser a -> Parser b
- checkMapEitherForgivable :: HasCallStack => (a -> Either String b) -> Parser a -> Parser b
- checkMapIOForgivable :: HasCallStack => (a -> IO (Either String b)) -> Parser a -> Parser b
- checkMapMaybeForgivable :: HasCallStack => (a -> Maybe b) -> Parser a -> Parser b
- allOrNothing :: HasCallStack => Parser a -> Parser a
- commands :: HasCallStack => [Command a] -> Parser a
- command :: HasCallStack => String -> String -> Parser a -> Command a
- subArgs :: String -> Parser a -> Parser a
- subArgs_ :: String -> Parser a -> Parser a
- subEnv :: String -> Parser a -> Parser a
- subEnv_ :: String -> Parser a -> Parser a
- subConfig :: String -> Parser a -> Parser a
- subConfig_ :: String -> Parser a -> Parser a
- subAll :: String -> Parser a -> Parser a
- subSettings :: HasCallStack => HasParser a => String -> Parser a
- someNonEmpty :: Parser a -> Parser (NonEmpty a)
- withConfig :: HasCallStack => Parser (Maybe Object) -> Parser a -> Parser a
- withYamlConfig :: HasCallStack => Parser (Maybe (Path Abs File)) -> Parser a -> Parser a
- withFirstYamlConfig :: HasCallStack => Parser [Path Abs File] -> Parser a -> Parser a
- withCombinedYamlConfigs :: Parser [Path Abs File] -> Parser a -> Parser a
- withCombinedYamlConfigs' :: HasCallStack => (Object -> Object -> Object) -> Parser [Path Abs File] -> Parser a -> Parser a
- combineConfigObjects :: Object -> Object -> Object
- xdgYamlConfigFile :: HasCallStack => FilePath -> Parser (Path Abs File)
- withLocalYamlConfig :: HasCallStack => Parser a -> Parser a
- withConfigurableYamlConfig :: HasCallStack => Parser (Path Abs File) -> Parser a -> Parser a
- withoutConfig :: HasCallStack => Parser a -> Parser a
- configuredConfigFile :: HasCallStack => Parser (Path Abs File)
- enableDisableSwitch :: HasCallStack => [Builder Bool] -> Parser Bool
- yesNoSwitch :: HasCallStack => [Builder Bool] -> Parser Bool
- makeDoubleSwitch :: HasCallStack => String -> String -> String -> [Builder Bool] -> Parser Bool
- readSecretTextFile :: Path Abs File -> IO Text
- data Parser a where
- ParserPure :: !a -> Parser a
- ParserAp :: !(Parser (a -> b)) -> !(Parser a) -> Parser b
- ParserSelect :: !(Parser (Either a b)) -> !(Parser (a -> b)) -> Parser b
- ParserEmpty :: !(Maybe SrcLoc) -> Parser a
- ParserAlt :: !(Parser a) -> !(Parser a) -> Parser a
- ParserMany :: !(Parser a) -> Parser [a]
- ParserSome :: !(Parser a) -> Parser (NonEmpty a)
- ParserAllOrNothing :: !(Maybe SrcLoc) -> !(Parser a) -> Parser a
- ParserCheck :: !(Maybe SrcLoc) -> !Bool -> !(a -> IO (Either String b)) -> !(Parser a) -> Parser b
- ParserCommands :: !(Maybe SrcLoc) -> ![Command a] -> Parser a
- ParserWithConfig :: !(Maybe SrcLoc) -> !(Parser (Maybe Object)) -> !(Parser a) -> Parser a
- ParserSetting :: !(Maybe SrcLoc) -> !(Setting a) -> Parser a
- class HasParser a where
- settingsParser :: Parser a
- data Command a = Command {
- commandSrcLoc :: !(Maybe SrcLoc)
- commandArg :: !String
- commandHelp :: !Help
- commandParser :: !(Parser a)
- type Metavar = String
- type Help = String
- showParserABit :: Parser a -> String
- parserEraseSrcLocs :: Parser a -> Parser a
- parserMapSetting :: (forall a. Setting a -> Setting a) -> Parser s -> Parser s
- parserTraverseSetting :: forall f s. Applicative f => (forall a. Setting a -> f (Setting a)) -> Parser s -> f (Parser s)
- commandTraverseSetting :: forall f s. Applicative f => (forall a. Setting a -> f (Setting a)) -> Command s -> f (Command s)
- parserSettingsSet :: Parser a -> Set SrcLocHash
- newtype SrcLocHash = SrcLocHash Int
- hashSrcLoc :: SrcLoc -> SrcLocHash
- class Functor (f :: Type -> Type) where
- class Functor f => Applicative (f :: Type -> Type) where
- class Applicative f => Alternative (f :: Type -> Type) where
- class Applicative f => Selective (f :: Type -> Type) where
Parser API
setting :: HasCallStack => [Builder a] -> Parser a Source #
setting
s are the building blocks of Parser
s.
setting
lets you put together different builders to define what to parse.
Here are some common examples:
Argument
setting [ help "Document your argument" , reader str -- The argument is a string , argument ] :: Parser String
Switch
setting [ help "Document your switch" , switch True -- The value of the switch when activated , long
foo
-- "--foo" , shortf
-- "-f" , value False -- The default value of the switch ] :: Parser BoolOption
setting [ help "Document your option" , reader str -- The argument is a string , long
foo
-- "--foo" , shortf
-- "-f" , option ] :: Parser StringEnvironment Variable
setting [ help "Document your environment variable" , reader str -- The argument is a string , env FOO_BAR ] :: Parser String
Configuration Value
setting [ help "Document your configuration value" , conf "foo-bar" ] :: Parser String
Some combination
setting [ help "Document your configuration value" , conf "foo-bar" ] :: Parser String
Note that parsing is always tried in this order when using a combined setting:
- Argument
- Switch
- Option
- Environment variable
- Configuration value
(Hence the name of the package.)
filePathSetting :: HasCallStack => [Builder FilePath] -> Parser (Path Abs File) Source #
directoryPathSetting :: HasCallStack => [Builder FilePath] -> Parser (Path Abs Dir) Source #
strArgument :: HasCallStack => IsString string => [Builder string] -> Parser string Source #
mapIO :: HasCallStack => (a -> IO b) -> Parser a -> Parser b Source #
Apply a computation to the result of a parser
This is intended for use-cases like resolving a file to an absolute path. It is morally ok for read-only IO actions but you will have a bad time if the action is not read-only.
runIO :: HasCallStack => IO a -> Parser a Source #
Run an IO action without parsing anything
This action may be run more than once, so prefer to do IO outside of the parser.
checkEither :: HasCallStack => (a -> Either String b) -> Parser a -> Parser b Source #
Like checkMapEither
but without changing the type
checkMaybe :: HasCallStack => (a -> Maybe a) -> Parser a -> Parser a Source #
Like checkMapMaybe
but without changing the type
checkMapEither :: HasCallStack => (a -> Either String b) -> Parser a -> Parser b Source #
Check a Parser
after the fact, purely.
checkMapIO :: HasCallStack => (a -> IO (Either String b)) -> Parser a -> Parser b Source #
Check a Parser
after the fact, allowing IO.
checkMapMaybe :: HasCallStack => (a -> Maybe b) -> Parser a -> Parser b Source #
Like checkMapEither
but without a helpful error message.
Prefer checkMapEither
.
checkMapEitherForgivable :: HasCallStack => (a -> Either String b) -> Parser a -> Parser b Source #
Like checkMapEither
, but allow trying the other side of any alternative if the result is Nothing.
checkMapIOForgivable :: HasCallStack => (a -> IO (Either String b)) -> Parser a -> Parser b Source #
Like checkMapIO
, but allow trying the other side of any alternative if the result is Nothing.
TODO add a SRCLoc here
checkMapMaybeForgivable :: HasCallStack => (a -> Maybe b) -> Parser a -> Parser b Source #
Like checkMapMaybe
, but allow trying the other side of any alternative if the result is Nothing.
allOrNothing :: HasCallStack => Parser a -> Parser a Source #
Parse either all or none of the parser below.
If you don't use this function, and only some of the settings below are defined, this parser will fail and the next alternative will be tried. If you do use this function, this parser will error unforgivably if at least one, but not all, of the settings below are defined.
If each setting has a corresponding forgivable error, consider this forgivable. Consider all other forgivable errors unforgivable
For example, the following will parser will fail intsead of succeed when given the arguments below:
( choice [ allOrNothing $ (,) <$> setting [option, long "foo", reader auto, help "This one will exist", metavar "CHAR"] <*> setting [option, long "bar", reader auto, help "This one will not exist", metavar "CHAR"], pure ('a', 'b') ] )
["--foo", "'a'"]
:: HasCallStack | |
=> String | Name |
-> String | Documentation |
-> Parser a | Parser |
-> Command a |
Declare a single command with a name, documentation and parser
subConfig_ :: String -> Parser a -> Parser a Source #
Helper function for calling subConfig
with toConfigCase
.
subConfig_ s = subConfig (toConfigCase s)
subAll :: String -> Parser a -> Parser a Source #
Helper function for calling subArgs_
, subEnv_
and subConfig_
with
the same prefix.
subAll = subArgs_ prefix . subEnv_ prefix . subConfig_ prefix
subSettings :: HasCallStack => HasParser a => String -> Parser a Source #
Use the settingsParser
of a given type, but prefixed with a subAll
and allOrNothing
.
subSettings prefix = allOrNothing $ subAll prefix settingsParser
withConfig :: HasCallStack => Parser (Maybe Object) -> Parser a -> Parser a Source #
Load a configuration value and use it for the given parser
withYamlConfig :: HasCallStack => Parser (Maybe (Path Abs File)) -> Parser a -> Parser a Source #
Load a YAML config file and use it for the given parser
withFirstYamlConfig :: HasCallStack => Parser [Path Abs File] -> Parser a -> Parser a Source #
Load the Yaml config in the first of the filepaths that points to something that exists.
withCombinedYamlConfigs :: Parser [Path Abs File] -> Parser a -> Parser a Source #
Combine all Yaml config files that exist into a single combined config object.
withCombinedYamlConfigs' :: HasCallStack => (Object -> Object -> Object) -> Parser [Path Abs File] -> Parser a -> Parser a Source #
xdgYamlConfigFile :: HasCallStack => FilePath -> Parser (Path Abs File) Source #
Load config.yaml
from the given XDG configuration subdirectory
withLocalYamlConfig :: HasCallStack => Parser a -> Parser a Source #
Load a config file that is reconfigurable with an option and environment
variable but config.yaml
in the local working directory by default.
withConfigurableYamlConfig :: HasCallStack => Parser (Path Abs File) -> Parser a -> Parser a Source #
Use the given Parser
for deciding which configuration file to load, but
only if configuredConfigFile
fails to define it first.
withoutConfig :: HasCallStack => Parser a -> Parser a Source #
configuredConfigFile :: HasCallStack => Parser (Path Abs File) Source #
A standard parser for defining which configuration file to load.
This has no default value so you will have to combine it somehow.
:: HasCallStack | |
=> [Builder Bool] | Builders |
-> Parser Bool |
Define a setting for a Value
with a given default value.
If you pass in long
values, it will have --enable-foobar
and --disable-foobar
switches.
If you pass in env
values, it will read those environment variables too.
If you pass in conf
values, it will read those configuration values too.
If you pass in a value
value, it will use that as the default value.
:: HasCallStack | |
=> [Builder Bool] | Builders |
-> Parser Bool |
Define a setting for a Value
with a given default value.
If you pass in long
values, it will have --foobar
and --no-foobar
switches.
If you pass in env
values, it will read those environment variables too.
If you pass in conf
values, it will read those configuration values too.
If you pass in a value
value, it will use that as the default value.
readSecretTextFile :: Path Abs File -> IO Text Source #
Read a text file but strip whitespace so it can be edited with an editor that messes with line endings.
Parser implementation
A Parser
structure
A Parser a
value represents each of these all at once:
- A way to run it to parse an
a
- A way to document it in various ways
- A way to run it to perform shell completion
The basic building block of a Parser
is a setting
.
setting
s represent individual settings that you can then compose into larger parsers.
Much of the way you compose parsers happens via its type class instances. In particular:
<$>
fromFunctor
to map overParser
s<*>
fromApplicative
to "and"Parser
s<|>
fromAlternative
to "or"Parser
soptional
fromAlternative
to optionally run a parsermany
andsome
fromAlternative
to run the same parser multiple times.
You can run a parser with runParser
, or give your type an instance of
HasParser
and run the parser with runSettingsParser
.
ParserPure :: !a -> Parser a | |
ParserAp :: !(Parser (a -> b)) -> !(Parser a) -> Parser b | |
ParserSelect :: !(Parser (Either a b)) -> !(Parser (a -> b)) -> Parser b | |
ParserEmpty :: !(Maybe SrcLoc) -> Parser a | |
ParserAlt :: !(Parser a) -> !(Parser a) -> Parser a | |
ParserMany :: !(Parser a) -> Parser [a] | |
ParserSome :: !(Parser a) -> Parser (NonEmpty a) | |
ParserAllOrNothing :: !(Maybe SrcLoc) -> !(Parser a) -> Parser a | |
ParserCheck | |
ParserCommands :: !(Maybe SrcLoc) -> ![Command a] -> Parser a | |
ParserWithConfig :: !(Maybe SrcLoc) -> !(Parser (Maybe Object)) -> !(Parser a) -> Parser a | Load a configuration value and use it for the continuing parser |
ParserSetting :: !(Maybe SrcLoc) -> !(Setting a) -> Parser a | General settings |
class HasParser a where Source #
A class of types that have a canonical settings parser.
There are no laws. The closest rule to a law is that a user of an instance should not be surprised by its behaviour.
settingsParser :: Parser a Source #
Command | |
|
showParserABit :: Parser a -> String Source #
parserEraseSrcLocs :: Parser a -> Parser a Source #
Erase all source locations in a parser.
This may be useful when golden-testing the shown parser.
parserTraverseSetting :: forall f s. Applicative f => (forall a. Setting a -> f (Setting a)) -> Parser s -> f (Parser s) Source #
commandTraverseSetting :: forall f s. Applicative f => (forall a. Setting a -> f (Setting a)) -> Command s -> f (Command s) Source #
All or nothing implementation
parserSettingsSet :: Parser a -> Set SrcLocHash Source #
newtype SrcLocHash Source #
Instances
Eq SrcLocHash Source # | |
Defined in OptEnvConf.Parser (==) :: SrcLocHash -> SrcLocHash -> Bool # (/=) :: SrcLocHash -> SrcLocHash -> Bool # | |
Ord SrcLocHash Source # | |
Defined in OptEnvConf.Parser compare :: SrcLocHash -> SrcLocHash -> Ordering # (<) :: SrcLocHash -> SrcLocHash -> Bool # (<=) :: SrcLocHash -> SrcLocHash -> Bool # (>) :: SrcLocHash -> SrcLocHash -> Bool # (>=) :: SrcLocHash -> SrcLocHash -> Bool # max :: SrcLocHash -> SrcLocHash -> SrcLocHash # min :: SrcLocHash -> SrcLocHash -> SrcLocHash # |
hashSrcLoc :: SrcLoc -> SrcLocHash Source #
Re-exports
class Functor (f :: Type -> Type) where #
A type f
is a Functor if it provides a function fmap
which, given any types a
and b
lets you apply any function from (a -> b)
to turn an f a
into an f b
, preserving the
structure of f
. Furthermore f
needs to adhere to the following:
Note, that the second law follows from the free theorem of the type fmap
and
the first law, so you need only check that the former condition holds.
See https://www.schoolofhaskell.com/user/edwardk/snippets/fmap or
https://github.com/quchen/articles/blob/master/second_functor_law.md
for an explanation.
fmap :: (a -> b) -> f a -> f b #
fmap
is used to apply a function of type (a -> b)
to a value of type f a
,
where f is a functor, to produce a value of type f b
.
Note that for any type constructor with more than one parameter (e.g., Either
),
only the last type parameter can be modified with fmap
(e.g., b
in `Either a b`).
Some type constructors with two parameters or more have a
instance that allows
both the last and the penultimate parameters to be mapped over.Bifunctor
Examples
Convert from a
to a Maybe
IntMaybe String
using show
:
>>>
fmap show Nothing
Nothing>>>
fmap show (Just 3)
Just "3"
Convert from an
to an
Either
Int IntEither Int String
using show
:
>>>
fmap show (Left 17)
Left 17>>>
fmap show (Right 17)
Right "17"
Double each element of a list:
>>>
fmap (*2) [1,2,3]
[2,4,6]
Apply even
to the second element of a pair:
>>>
fmap even (2,2)
(2,True)
It may seem surprising that the function is only applied to the last element of the tuple
compared to the list example above which applies it to every element in the list.
To understand, remember that tuples are type constructors with multiple type parameters:
a tuple of 3 elements (a,b,c)
can also be written (,,) a b c
and its Functor
instance
is defined for Functor ((,,) a b)
(i.e., only the third parameter is free to be mapped over
with fmap
).
It explains why fmap
can be used with tuples containing values of different types as in the
following example:
>>>
fmap even ("hello", 1.0, 4)
("hello",1.0,True)
Instances
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.
Example
Used in combination with (
, <$>
)(
can be used to build a record.<*>
)
>>>
data MyState = MyState {arg1 :: Foo, arg2 :: Bar, arg3 :: Baz}
>>>
produceFoo :: Applicative f => f Foo
>>>
produceBar :: Applicative f => f Bar
>>>
produceBaz :: Applicative f => f Baz
>>>
mkState :: Applicative f => f MyState
>>>
mkState = MyState <$> produceFoo <*> produceBar <*> produceBaz
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
.
Example
>>>
liftA2 (,) (Just 3) (Just 5)
Just (3,5)
(*>) :: f a -> f b -> f b infixl 4 #
Sequence actions, discarding the value of the first argument.
Examples
If used in conjunction with the Applicative instance for Maybe
,
you can chain Maybe computations, with a possible "early return"
in case of Nothing
.
>>>
Just 2 *> Just 3
Just 3
>>>
Nothing *> Just 3
Nothing
Of course a more interesting use case would be to have effectful computations instead of just returning pure values.
>>>
import Data.Char
>>>
import Text.ParserCombinators.ReadP
>>>
let p = string "my name is " *> munch1 isAlpha <* eof
>>>
readP_to_S p "my name is Simon"
[("Simon","")]
(<*) :: f a -> f b -> f a infixl 4 #
Sequence actions, discarding the value of the second argument.
Instances
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
class Applicative f => Selective (f :: Type -> Type) where #
Selective applicative functors. You can think of select
as a selective
function application: when given a value of type Left
a
, you must apply
the given function, but when given a Right
b
, you may skip the
function and associated effects, and simply return the b
.
Note that it is not a requirement for selective functors to skip unnecessary effects. It may be counterintuitive, but this makes them more useful. Why? Typically, when executing a selective computation, you would want to skip the effects (saving work); but on the other hand, if your goal is to statically analyse a given selective computation and extract the set of all possible effects (without actually executing them), then you do not want to skip any effects, because that defeats the purpose of static analysis.
The type signature of select
is reminiscent of both <*>
and >>=
, and
indeed a selective functor is in some sense a composition of an applicative
functor and the Either
monad.
Laws:
- Identity:
x <*? pure id = either id id <$> x
- Distributivity; note that
y
andz
have the same typef (a -> b)
:
pure x <*? (y *> z) = (pure x <*? y) *> (pure x <*? z)
- Associativity:
x <*? (y <*? z) = (f <$> x) <*? (g <$> y) <*? (h <$> z) where f x = Right <$> x g y = a -> bimap (,a) ($a) y h z = uncurry z
- Monadic
select
(for selective functors that are also monads):
select = selectM
There are also a few useful theorems:
- Apply a pure function to the result:
f <$> select x y = select (fmap f <$> x) (fmap f <$> y)
- Apply a pure function to the
Left
case of the first argument:
select (first f <$> x) y = select x ((. f) <$> y)
- Apply a pure function to the second argument:
select x (f <$> y) = select (first (flip f) <$> x) ((&) <$> y)
- Generalised identity:
x <*? pure y = either y id <$> x
- A selective functor is rigid if it satisfies
<*>
=
apS
. The following interchange law holds for rigid selective functors:
x *> (y <*? z) = (x *> y) <*? z
If f is also a Monad
, we require that select
= selectM
, from which one
can prove <*>
=
apS
.