| Safe Haskell | Safe |
|---|---|
| Language | Haskell2010 |
Text.LambdaOptions.Core
Description
Contains the core functionality for LambdaOptions.
Synopsis
- runOptions :: Options r -> [String] -> Either OptionsError [r]
- type Options r = OptionsM r ()
- data OptionsM r a
- data OptionsError = ParseFailed {}
- prettyOptionsError :: OptionsError -> String
- type OptionCallback r f = (GetOpaqueParsers r f, Wrap r f)
- addOption :: forall r f. OptionCallback r f => Keyword -> f -> Options r
- getHelpDescription :: Options r -> String
- getKeywords :: Options r -> [Keyword]
Documentation
runOptions :: Options r -> [String] -> Either OptionsError [r] Source #
Tries to parse the supplied options against input arguments.
If successful, parsed option callback results are returned in Right.
Otherwise OptionsError is returned in Left.
Example program:
import qualified System.Environment as Env
import qualified Text.LambdaOptions as L
options :: L.Options (IO ())
options = do
L.addOption
(L.kw ["--help", "-h"]
`L.text` "Display this help text.")
$ do
putStrLn "Usage:"
putStrLn $ L.getHelpDescription options
L.addOption
(L.kw "--add"
`L.argText` "X Y"
`L.text` "Adds two Doubles and prints their sum.")
$ \x y -> do
print $ x + (y :: Double)
main :: IO ()
main = do
args <- Env.getArgs
case L.runOptions options args of
Left e -> do
putStrLn $ L.prettyOptionsError e
putStrLn $ L.getHelpDescription options
Right results -> do
sequence_ results>>>:main --add 3 0.143.14>>>:main -hUsage: --add X Y Adds two Doubles and prints their sum. -h, --help Display this help text.>>>:main --add 0 1 --add 2 fourBad input for `--add' at index 3: `four' --add X Y Adds two Doubles and prints their sum. -h, --help Display this help text.
A monad for parsing options.
data OptionsError Source #
Contains information about what went wrong during an unsuccessful options parse.
Constructors
| ParseFailed | |
Fields
| |
Instances
| Show OptionsError Source # | |
Defined in Text.LambdaOptions.Core Methods showsPrec :: Int -> OptionsError -> ShowS # show :: OptionsError -> String # showList :: [OptionsError] -> ShowS # | |
prettyOptionsError :: OptionsError -> String Source #
Pretty prints an OptionsError.
type OptionCallback r f = (GetOpaqueParsers r f, Wrap r f) Source #
Describes the callback f to be called for a successfully parsed option.
The function (or value) f can have any arity and ultimately returns
a value with type r
Each of the callback's arguments must have a type t which implements
Parseable and Typeable.
Think of this as the following constraint synonym:
type OptionCallback r f = (f ~ ((Parseable t*, Typeable t*) => t0 -> t1 -> ... -> tN -> r))
Example callbacks:
f0 = putStrLn "Option parsed!" :: IO () f1 = put :: String -> State String () f2 = liftIO . print :: (MonadIO m) => Int -> m () f3 name year ratio = lift (print (name, year, ratio)) :: (MonadTrans m) => String -> Int -> Float -> m IO () f4 = 7 :: Int f5 = (:) :: Double -> [Double] -> [Double]
addOption :: forall r f. OptionCallback r f => Keyword -> f -> Options r Source #
Adds the supplied option to the Options r context.
If the keyword is matched and the types of the callback's parameters can successfully be parsed, the callback is called with the parsed arguments.
getHelpDescription :: Options r -> String Source #
Produces the help description given by the input options.