optparse-applicative-0.7.0.2/0000755000000000000000000000000012230300574014174 5ustar0000000000000000optparse-applicative-0.7.0.2/Setup.hs0000644000000000000000000000005612230300574015631 0ustar0000000000000000import Distribution.Simple main = defaultMain optparse-applicative-0.7.0.2/README.md0000644000000000000000000002536212230300574015463 0ustar0000000000000000# Applicative option parser This package contains utilities and combinators to define command line option parsers. [![Continuous Integration status][status-png]][status] ## Getting started Here is a simple example of an applicative option parser: ```haskell data Sample = Sample { hello :: String , quiet :: Bool } sample :: Parser Sample sample = Sample <$> strOption ( long "hello" <> metavar "TARGET" <> help "Target for the greeting" ) <*> switch ( long "quiet" <> help "Whether to be quiet" ) ``` The parser is built using [applicative style][applicative] starting from a set of basic combinators. In this example, `hello` is defined as an option with a `String` argument, while `quiet` is a boolean flag (called `switch`). A parser can be used like this: ```haskell greet :: Sample -> IO () greet (Sample h False) = putStrLn $ "Hello, " ++ h greet _ = return () main :: IO () main = execParser opts >>= greet where opts = info (helper <*> sample) ( fullDesc <> progDesc "Print a greeting for TARGET" <> header "hello - a test for optparse-applicative" ) ``` The `greet` function is the entry point of the program, while `opts` is a complete description of the program, used when generating a help text. The `helper` combinator takes any parser, and adds a `help` option to it. The `hello` option in this example is mandatory (since it doesn't have a default value), so running the program without any argument will display a short option summary: Usage: hello --hello TARGET [--quiet] Running the program with the `--help` option will display the full help text: hello - a test for optparse-applicative Usage: hello --hello TARGET [--quiet] Print a greeting for TARGET Available options: -h,--help Show this help text --hello TARGET Target for the greeting --quiet Whether to be quiet containing a detailed list of options with descriptions. Parsers are instances of both `Applicative` and `Alternative`, and work with any generic combinator, like `many` and `some`. For example, to make a option return `Nothing` instead of failing when it's not supplied, you can use the `optional` combinator in `Control.Applicative`: ```haskell optional $ strOption ( long "output" & metavar "DIRECTORY" ) ``` [applicative]: http://www.soi.city.ac.uk/~ross/papers/Applicative.html ## Supported options `optparse-applicative` supports four kinds of options: regular options, flags, arguments and commands. ### Regular options A **regular option** is an option which takes a single argument, parses it, and returns a value. A regular option can have a default value, which is used as the result if the option is not found in the command line. An option without a default value is considered mandatory, and produces an error when not found. Regular options can have **long** names, or **short** (one-character) names, which determine when the option matches and how the argument is extracted. An option with a long name (say "output") is specified on the command line as --output filename.txt or --output=filename.txt while a short name option (say "o") can be specified with -o filename.txt or -ofilename.txt Options can have more than one name, usually one long and one short, although you are free to create options with an arbitrary combination of long and short names. Regular options returning strings are the most common, and they can be created using the `strOption` builder. For example, ```haskell strOption ( long "output" <> short 'o' <> metavar "FILE" <> help "Write output to FILE" ) ``` creates a regular option with a string argument (which can be referred to as `FILE` in the help text and documentation), a long name "output" and a short name "o". See below for more information on the builder syntax and modifiers. A regular option can return an object of any type, provided you specify a **reader** for it. A common reader is `auto`, used by the `option` builder, which assumes a `Read` instance for the return type and uses it to parse its argument. For example: ```haskell lineCount :: Parser Int lineCount = option ( long "lines" <> short 'n' <> metavar "K" <> help "Output the last K lines" ) ``` specifies a regular option with an `Int` argument. We added an explicit type annotation here, since without it the parser would have been polymorphic in the output type. There's usually no need to add type annotations, however, because the type will be normally inferred from the context in which the parser is used. You can also create a custom reader without using the `Read` typeclass, and set it as the reader for an option using the `reader` modifier and the `nullOption` builder: ```haskell data FluxCapacitor = ... parseFluxCapacitor :: Monad m => String -> m FluxCapacitor nullOption ( long "flux-capacitor" <> reader parseFluxCapacitor ) ``` ### Flags A **flag** is just like a regular option, but it doesn't take any arguments: it is either present in the command line or not. A flag has a default value and an **active value**. If the flag is found on the command line, the active value is returned, otherwise the default value is used. For example: ```haskell data Verbosity = Normal | Verbose flag Normal Verbose ( long "verbose" <> short 'v' <> help "Enable verbose mode" ``` is a flag parser returning a `Verbosity` value. Simple boolean flags can be specified using the `switch` builder, like so: ```haskell switch ( long "keep-tmp-files" <> help "Retain all intermediate temporary files" ) ``` There is also a `flag'` builder, which has no default value. For example, to add a `--version` switch to a program, you could write: ```haskell flag' Nothing (long "version" <> hidden) <|> (Just <$> normal_options) ``` ### Arguments An **argument** parser specifies a positional command line argument. The `argument` builder takes a reader parameter, and creates a parser which will return the parsed value every time it is passed a command line argument for which the reader succeeds. For example ```haskell argument str ( metavar "FILE" ) ``` creates an argument accepting any string. Arguments are only displayed in the brief help text, so there's no need to attach a description to them. They should be manually documented in the program description. Note that arguments starting with `-` are considered options by default, and will not be considered by an `argument` parser. However, parsers always accept a special argument: `--`. When a `--` is found on the command line, all the following words are considered by `argument` parsers, regardless of whether they start with `-` or not. ### Commands A **command** can be used to specify a sub-parser to be used when a certain string is encountered in the command line. Commands are useful to implement command line programs with multiple functions, each with its own set of options, and possibly some global options that apply to all of them. Typical examples are version control systems like `git`, or build tools like `cabal`. A command can be created using the `subparser` builder, and commands can be added with the `command` modifier. For example ```haskell subparser ( command "add" (info addOptions ( progDesc "Add a file to the repository" )) <> command "commit" (info commitOptions ( progDesc "Record changes to the repository" )) ) ``` Each command takes a full `ParserInfo` structure, which will be used to extract a description for this command when generating a help text. Note that all the parsers appearing in a command need to have the same type. For this reason, it is often best to use a sum type which has the same structure as the command itself. For example, for the parser above, you would define a type like: ```haskell data Options = Options { optGlobalOpt :: String , optGlobalFlag :: Bool ... , optCommand :: Command } data Command = Add AddOptions | Commit CommitOptions ... ``` Alternatively, you can directly return an `IO` action from a parser, and execute it using `join` from `Control.Monad`. ```haskell start :: String -> IO () stop :: IO () opts :: Parser (IO ()) opts = subparser ( command "start" (info (start <$> argument str idm) idm) <> command "stop" (info (pure stop) idm) ) main :: IO () main = join $ execParser (info opts idm) ``` ## Option builders Builders allow you to define parsers using a convenient combinator-based syntax. Each builder takes a **modifier** as parameter, and returns a parser. A modifier is a composition of functions which act on the option, setting values for properties or adding features, and is used to build the option from scratch and finally lift it to a single-option parser, which can then be combined with other parsers using normal `Applicative` combinators. Modifiers are instances of the `Monoid` typeclass, so they can be combined using the composition function `mappend` (or simply `(<>)`). See the haddock documentation for `Options.Applicative.Builder` for a full list of builders and modifiers. ## Arrow interface It is also possible to use the [Arrow syntax][arrows] to combine basic parsers. This can be particularly useful when the structure holding parse results is deeply nested, or when the order of fields differs from the order in which the parsers should be applied. Using functions from the `Options.Applicative.Arrows` module, one can write, for example: ```haskell data Options = Options { optArgs :: [String] , optVerbose :: Bool } opts :: Parser Options opts = runA $ proc () -> do verbosity <- asA (option (short 'v' <> value 0)) -< () let verbose = verbosity > 0 args <- asA (arguments str idm) -< () returnA -< Options args verbose ``` where parsers are converted to arrows using `asA`, and the resulting composed arrow is converted back to a `Parser` with `runA`. See `tests/Examples/Cabal.hs` for a slightly more elaborate example using the arrow syntax for defining parsers. Note that the `Arrow` interface is provided only for convenience. The API based on `Applicative` is just as expressive, although it might be cumbersome to use in certain cases. ## How it works A `Parser a` is essentially a heterogeneous list of `Option`s, implemented with existential types. All options are therefore known statically (i.e. before parsing, not necessarily before runtime), and can, for example, be traversed to generate a help text. See [this blog post][blog] for a more detailed explanation based on a simplified implementation. [status-png]: https://secure.travis-ci.org/pcapriotti/optparse-applicative.png?branch=master [status]: http://travis-ci.org/pcapriotti/optparse-applicative?branch=master [blog]: http://paolocapriotti.com/blog/2012/04/27/applicative-option-parser/ [arrows]: http://www.haskell.org/arrows/syntax.html optparse-applicative-0.7.0.2/optparse-applicative.cabal0000644000000000000000000001045112230300574021315 0ustar0000000000000000name: optparse-applicative version: 0.7.0.2 synopsis: Utilities and combinators for parsing command line options description: Here is a simple example of an applicative option parser: . @ data Sample = Sample { hello :: String , quiet :: Bool } . sample :: Parser Sample sample = Sample \<$\> strOption ( long \"hello\" \<\> metavar \"TARGET\" \<\> help \"Target for the greeting\" ) \<*\> switch ( long \"quiet\" \<\> help \"Whether to be quiet\" ) @ . The parser is built using applicative style starting from a set of basic combinators. In this example, @hello@ is defined as an 'option' with a @String@ argument, while @quiet@ is a boolean 'flag' (called 'switch'). . A parser can be used like this: . @ greet :: Sample -> IO () greet (Sample h False) = putStrLn $ \"Hello, \" ++ h greet _ = return () . main :: IO () main = execParser opts \>\>= greet where opts = info (helper \<*\> sample) ( fullDesc \<\> progDesc \"Print a greeting for TARGET\" \<\> header \"hello - a test for optparse-applicative\" ) @ . The @greet@ function is the entry point of the program, while @opts@ is a complete description of the program, used when generating a help text. The 'helper' combinator takes any parser, and adds a @help@ option to it (which always fails). . The @hello@ option in this example is mandatory (since it doesn't have a default value), so running the program without any argument will display a help text: . >hello - a test for optparse-applicative > >Usage: hello --hello TARGET [--quiet] > Print a greeting for TARGET > >Available options: > -h,--help Show this help text > --hello TARGET Target for the greeting > --quiet Whether to be quiet . containing a short usage summary, and a detailed list of options with descriptions. license: BSD3 license-file: LICENSE author: Paolo Capriotti maintainer: p.capriotti@gmail.com copyright: (c) 2012 Paolo Capriotti category: System build-type: Simple cabal-version: >= 1.8 extra-source-files: README.md tests/Examples/Alternatives.hs tests/Examples/Cabal.hs tests/Examples/Commands.hs tests/Examples/Hello.hs tests/alt.err.txt tests/cabal.err.txt tests/commands.err.txt tests/hello.err.txt tests/nested.err.txt homepage: https://github.com/pcapriotti/optparse-applicative bug-reports: https://github.com/pcapriotti/optparse-applicative/issues source-repository head type: git location: https://github.com/pcapriotti/optparse-applicative.git library exposed-modules: Options.Applicative, Options.Applicative.Arrows, Options.Applicative.BashCompletion, Options.Applicative.Builder, Options.Applicative.Builder.Completer, Options.Applicative.Builder.Internal, Options.Applicative.Common, Options.Applicative.Extra, Options.Applicative.Help, Options.Applicative.Types, Options.Applicative.Utils other-modules: Options.Applicative.Internal ghc-options: -Wall build-depends: base == 4.*, transformers >= 0.2 && < 0.4, process >= 1.0 && < 1.3 test-suite tests type: exitcode-stdio-1.0 hs-source-dirs: tests main-is: Tests.hs ghc-options: -Wall build-depends: base == 4.*, HUnit == 1.2.*, optparse-applicative, test-framework >= 0.6 && < 0.9, test-framework-hunit >= 0.2 && < 0.4, test-framework-th-prime == 0.0.* optparse-applicative-0.7.0.2/LICENSE0000644000000000000000000000277012230300574015207 0ustar0000000000000000Copyright (c) 2012, Paolo Capriotti All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Paolo Capriotti nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. optparse-applicative-0.7.0.2/tests/0000755000000000000000000000000012230300574015336 5ustar0000000000000000optparse-applicative-0.7.0.2/tests/hello.err.txt0000644000000000000000000000042212230300574017767 0ustar0000000000000000hello - a test for optparse-applicative Usage: hello --hello TARGET [--quiet] Print a greeting for TARGET Available options: --hello TARGET Target for the greeting --quiet Whether to be quiet -h,--help Show this help text optparse-applicative-0.7.0.2/tests/alt.err.txt0000644000000000000000000000034412230300574017447 0ustar0000000000000000Usage: alt (--virtual-machine VM | --cloud-service CS | --dry-run) Available options: --virtual-machine VM Virtual machine name --cloud-service CS Cloud service name -h,--help Show this help text optparse-applicative-0.7.0.2/tests/Tests.hs0000644000000000000000000002512412230300574017000 0ustar0000000000000000{-# LANGUAGE TemplateHaskell, CPP #-} module Main where import qualified Examples.Hello as Hello import qualified Examples.Commands as Commands import qualified Examples.Cabal as Cabal import qualified Examples.Alternatives as Alternatives import Control.Monad import Data.List import Options.Applicative import System.Exit import Test.HUnit import Test.Framework.Providers.HUnit import Test.Framework.TH.Prime #if __GLASGOW_HASKELL__ <= 702 import Data.Monoid (<>) :: Monoid a => a -> a -> a (<>) = mappend #endif run :: ParserInfo a -> [String] -> Either ParserFailure a run = execParserPure (prefs idm) assertLeft :: Show b => Either a b -> (a -> Assertion) -> Assertion assertLeft x f = either f err x where err b = assertFailure $ "expected Left, got " ++ show b assertRight :: Either ParserFailure b -> (b -> Assertion) -> Assertion assertRight x f = either err f x where err (ParserFailure e _) = do msg <- e "test" assertFailure $ "unexpected parse error\n" ++ msg assertHasLine :: String -> String -> Assertion assertHasLine l s | l `elem` lines s = return () | otherwise = assertFailure $ "expected line:\n\t" ++ l ++ "\nnot found" checkHelpText :: Show a => String -> ParserInfo a -> [String] -> Assertion checkHelpText name p args = do let result = run p args assertLeft result $ \(ParserFailure err code) -> do expected <- readFile $ "tests/" ++ name ++ ".err.txt" msg <- err name expected @=? msg ExitFailure 1 @=? code case_hello :: Assertion case_hello = checkHelpText "hello" Hello.opts ["--help"] case_modes :: Assertion case_modes = checkHelpText "commands" Commands.opts ["--help"] case_cabal_conf :: Assertion case_cabal_conf = checkHelpText "cabal" Cabal.pinfo ["configure", "--help"] case_args :: Assertion case_args = do let result = run Commands.opts ["hello", "foo", "bar"] case result of Left _ -> assertFailure "unexpected parse error" Right (Commands.Hello args) -> ["foo", "bar"] @=? args Right Commands.Goodbye -> assertFailure "unexpected result: Goodbye" case_args_opts :: Assertion case_args_opts = do let result = run Commands.opts ["hello", "foo", "--bar"] case result of Left _ -> return () Right (Commands.Hello xs) -> assertFailure $ "unexpected result: Hello " ++ show xs Right Commands.Goodbye -> assertFailure "unexpected result: Goodbye" case_args_ddash :: Assertion case_args_ddash = do let result = run Commands.opts ["hello", "foo", "--", "--bar", "baz"] case result of Left _ -> assertFailure "unexpected parse error" Right (Commands.Hello args) -> ["foo", "--bar", "baz"] @=? args Right Commands.Goodbye -> assertFailure "unexpected result: Goodbye" case_alts :: Assertion case_alts = do let result = run Alternatives.opts ["-b", "-a", "-b", "-a", "-a", "-b"] case result of Left _ -> assertFailure "unexpected parse error" Right xs -> [b, a, b, a, a, b] @=? xs where a = Alternatives.A b = Alternatives.B case_show_default :: Assertion case_show_default = do let p = option ( short 'n' <> help "set count" <> value (0 :: Int) <> showDefault) i = info (p <**> helper) idm result = run i ["--help"] case result of Left (ParserFailure err _) -> do msg <- err "test" assertHasLine " -n ARG set count (default: 0)" msg Right r -> assertFailure $ "unexpected result: " ++ show r case_alt_cont :: Assertion case_alt_cont = do let p = Alternatives.a <|> Alternatives.b i = info p idm result = run i ["-a", "-b"] case result of Left _ -> return () Right r -> assertFailure $ "unexpected result: " ++ show r case_alt_help :: Assertion case_alt_help = do let p = p1 <|> p2 <|> p3 p1 = (Just . Left) <$> strOption ( long "virtual-machine" <> metavar "VM" <> help "Virtual machine name" ) p2 = (Just . Right) <$> strOption ( long "cloud-service" <> metavar "CS" <> help "Cloud service name" ) p3 = flag' Nothing ( long "dry-run" ) i = info (p <**> helper) idm checkHelpText "alt" i ["--help"] case_nested_commands :: Assertion case_nested_commands = do let p3 = strOption (short 'a' <> metavar "A") p2 = subparser (command "b" (info p3 idm)) p1 = subparser (command "c" (info p2 idm)) i = info (p1 <**> helper) idm checkHelpText "nested" i ["c", "b"] case_many_args :: Assertion case_many_args = do let p = arguments str idm i = info p idm nargs = 20000 result = run i (replicate nargs "foo") case result of Left _ -> assertFailure "unexpected parse error" Right xs -> nargs @=? length xs case_disambiguate :: Assertion case_disambiguate = do let p = flag' (1 :: Int) (long "foo") <|> flag' 2 (long "bar") <|> flag' 3 (long "baz") i = info p idm result = execParserPure (prefs disambiguate) i ["--f"] case result of Left _ -> assertFailure "unexpected parse error" Right val -> 1 @=? val case_ambiguous :: Assertion case_ambiguous = do let p = flag' (1 :: Int) (long "foo") <|> flag' 2 (long "bar") <|> flag' 3 (long "baz") i = info p idm result = execParserPure (prefs disambiguate) i ["--ba"] case result of Left _ -> return () Right val -> assertFailure $ "unexpected result " ++ show val case_completion :: Assertion case_completion = do let p = (,) <$> strOption (long "foo"<> value "") <*> strOption (long "bar"<> value "") i = info p idm result = run i ["--bash-completion-index", "0"] case result of Left (ParserFailure err code) -> do ExitSuccess @=? code completions <- lines <$> err "test" ["--foo", "--bar"] @=? completions Right val -> assertFailure $ "unexpected result " ++ show val case_bind_usage :: Assertion case_bind_usage = do let p = arguments str (metavar "ARGS...") i = info (p <**> helper) briefDesc result = run i ["--help"] case result of Left (ParserFailure err _) -> do text <- head . lines <$> err "test" "Usage: test [ARGS...]" @=? text Right val -> assertFailure $ "unexpected result " ++ show val case_issue_19 :: Assertion case_issue_19 = do let p = option ( short 'x' <> reader (fmap Just . str) <> value Nothing ) i = info (p <**> helper) idm result = run i ["-x", "foo"] case result of Left _ -> assertFailure "unexpected parse error" Right r -> Just "foo" @=? r case_arguments1_none :: Assertion case_arguments1_none = do let p = arguments1 str idm i = info (p <**> helper) idm result = run i [] assertLeft result $ \(ParserFailure _ _) -> return () case_arguments1_some :: Assertion case_arguments1_some = do let p = arguments1 str idm i = info (p <**> helper) idm result = run i ["foo", "--", "bar", "baz"] case result of Left _ -> assertFailure "unexpected parse error" Right r -> ["foo", "bar", "baz"] @=? r case_arguments_switch :: Assertion case_arguments_switch = do let p = switch (short 'x') *> arguments str idm i = info p idm result = run i ["--", "-x"] assertRight result $ \args -> ["-x"] @=? args case_issue_35 :: Assertion case_issue_35 = do let p = flag' True (short 't' <> hidden) <|> flag' False (short 'f') i = info p idm result = run i [] case result of Left (ParserFailure err _) -> do text <- head . lines <$> err "test" "Usage: test -f" @=? text Right val -> assertFailure $ "unexpected result " ++ show val case_backtracking :: Assertion case_backtracking = do let p2 = switch (short 'a') p1 = (,) <$> subparser (command "c" (info p2 idm)) <*> switch (short 'b') i = info (p1 <**> helper) idm result = execParserPure (prefs noBacktrack) i ["c", "-b"] assertLeft result $ \ _ -> return () case_error_context :: Assertion case_error_context = do let p = pk <$> option (long "port") <*> option (long "key") i = info p idm result = run i ["--port", "foo", "--key", "291"] case result of Left (ParserFailure err _) -> do msg <- err "test" let errMsg = head $ lines msg assertBool "no context in error message (option)" ("port" `isInfixOf` errMsg) assertBool "no context in error message (value)" ("foo" `isInfixOf` errMsg) Right val -> assertFailure $ "unexpected result " ++ show val where pk :: Int -> Int -> (Int, Int) pk = (,) condr :: MonadPlus m => (Int -> Bool) -> String -> m Int condr f arg = do x <- auto arg guard (f (x :: Int)) return x case_arg_order_1 :: Assertion case_arg_order_1 = do let p = (,) <$> argument (condr even) idm <*> argument (condr odd) idm i = info p idm result = run i ["3", "6"] assertLeft result $ \_ -> return () case_arg_order_2 :: Assertion case_arg_order_2 = do let p = (,,) <$> argument (condr even) idm <*> option (reader (condr even) <> short 'a') <*> option (reader (condr odd) <> short 'b') i = info p idm result = run i ["2", "-b", "3", "-a", "6"] case result of Left _ -> assertFailure "unexpected parse error" Right res -> (2, 6, 3) @=? res case_arg_order_3 :: Assertion case_arg_order_3 = do let p = (,) <$> ( argument (condr even) idm <|> option (short 'n') ) <*> argument (condr odd) idm i = info p idm result = run i ["-n", "3", "5"] case result of Left _ -> assertFailure "unexpected parse error" Right res -> (3, 5) @=? res case_issue_47 :: Assertion case_issue_47 = do let p = nullOption (long "test" <> reader r <> value 9) :: Parser Int r _ = readerError "error message" result = run (info p idm) ["--test", "x"] assertLeft result $ \(ParserFailure err _) -> do text <- head . lines <$> err "test" assertBool "no error message" ("error message" `isInfixOf` text) case_issue_50 :: Assertion case_issue_50 = do let p = argument str (metavar "INPUT") <* switch (long "version") result = run (info p idm) ["--version", "test"] assertRight result $ \r -> "test" @=? r case_intersperse_1 :: Assertion case_intersperse_1 = do let p = arguments str (metavar "ARGS") <* switch (short 'x') result = execParserPure (prefs noIntersperse) (info p idm) ["a", "-x", "b"] assertRight result $ \args -> ["a", "-x", "b"] @=? args main :: IO () main = $(defaultMainGenerator) optparse-applicative-0.7.0.2/tests/cabal.err.txt0000644000000000000000000000041312230300574017726 0ustar0000000000000000Usage: cabal configure [--enable-tests] [-f|--flags FLAGS] Prepare to build the package Available options: --enable-tests Enable compilation of test suites -f,--flags FLAGS Enable the given flag -h,--help Show this help text optparse-applicative-0.7.0.2/tests/commands.err.txt0000644000000000000000000000030112230300574020461 0ustar0000000000000000Usage: commands COMMAND Available options: -h,--help Show this help text Available commands: hello Print greeting goodbye Say goodbye optparse-applicative-0.7.0.2/tests/nested.err.txt0000644000000000000000000000002712230300574020147 0ustar0000000000000000Usage: nested c b -a A optparse-applicative-0.7.0.2/tests/Examples/0000755000000000000000000000000012230300574017114 5ustar0000000000000000optparse-applicative-0.7.0.2/tests/Examples/Commands.hs0000644000000000000000000000147312230300574021216 0ustar0000000000000000{-# LANGUAGE CPP #-} module Examples.Commands where import Data.List import Options.Applicative #if __GLASGOW_HASKELL__ <= 702 import Data.Monoid (<>) :: Monoid a => a -> a -> a (<>) = mappend #endif data Sample = Hello [String] | Goodbye deriving Show hello :: Parser Sample hello = Hello <$> arguments str (metavar "TARGET...") sample :: Parser Sample sample = subparser ( command "hello" (info hello (progDesc "Print greeting")) <> command "goodbye" (info (pure Goodbye) (progDesc "Say goodbye")) ) run :: Sample -> IO () run (Hello targets) = putStrLn $ "Hello, " ++ intercalate ", " targets ++ "!" run Goodbye = putStrLn "Goodbye." opts :: ParserInfo Sample opts = info (sample <**> helper) idm main :: IO () main = execParser opts >>= run optparse-applicative-0.7.0.2/tests/Examples/Alternatives.hs0000644000000000000000000000044412230300574022113 0ustar0000000000000000module Examples.Alternatives where import Options.Applicative data Value = A | B deriving (Eq, Show) values :: Parser [Value] values = many $ a <|> b a :: Parser Value a = flag' A (short 'a') b :: Parser Value b = flag' B (short 'b') opts :: ParserInfo [Value] opts = info values idm optparse-applicative-0.7.0.2/tests/Examples/Cabal.hs0000644000000000000000000000625712230300574020464 0ustar0000000000000000{-# LANGUAGE Arrows, CPP #-} module Examples.Cabal where import Options.Applicative import Options.Applicative.Arrows #if __GLASGOW_HASKELL__ <= 702 import Data.Monoid (<>) :: Monoid a => a -> a -> a (<>) = mappend #endif data Args = Args CommonOpts Command deriving Show data CommonOpts = CommonOpts { optVerbosity :: Int } deriving Show data Command = Install ConfigureOpts InstallOpts | Update | Configure ConfigureOpts | Build BuildOpts deriving Show data InstallOpts = InstallOpts { instReinstall :: Bool , instForce :: Bool } deriving Show data ConfigureOpts = ConfigureOpts { configTests :: Bool , configFlags :: [String] } deriving Show data BuildOpts = BuildOpts { buildDir :: FilePath } deriving Show version :: Parser (a -> a) version = infoOption "0.0.0" ( long "version" <> help "Print version information" ) parser :: Parser Args parser = runA $ proc () -> do opts <- asA commonOpts -< () cmds <- (asA . hsubparser) ( command "install" (info installParser (progDesc "Installs a list of packages")) <> command "update" (info updateParser (progDesc "Updates list of known packages")) <> command "configure" (info configureParser (progDesc "Prepare to build the package")) <> command "build" (info buildParser (progDesc "Make this package ready for installation")) ) -< () A version >>> A helper -< Args opts cmds commonOpts :: Parser CommonOpts commonOpts = CommonOpts <$> option ( short 'v' <> long "verbose" <> metavar "LEVEL" <> help "Set verbosity to LEVEL" <> value 0 ) installParser :: Parser Command installParser = runA $ proc () -> do config <- asA configureOpts -< () inst <- asA installOpts -< () returnA -< Install config inst installOpts :: Parser InstallOpts installOpts = runA $ proc () -> do reinst <- asA (switch (long "reinstall")) -< () force <- asA (switch (long "force-reinstall")) -< () returnA -< InstallOpts { instReinstall = reinst , instForce = force } updateParser :: Parser Command updateParser = pure Update configureParser :: Parser Command configureParser = runA $ proc () -> do config <- asA configureOpts -< () returnA -< Configure config configureOpts :: Parser ConfigureOpts configureOpts = runA $ proc () -> do tests <- (asA . switch) ( long "enable-tests" <> help "Enable compilation of test suites" ) -< () flags <- (asA . many . strOption) ( short 'f' <> long "flags" <> metavar "FLAGS" <> help "Enable the given flag" ) -< () returnA -< ConfigureOpts tests flags buildParser :: Parser Command buildParser = runA $ proc () -> do opts <- asA buildOpts -< () returnA -< Build opts buildOpts :: Parser BuildOpts buildOpts = runA $ proc () -> do bdir <- (asA . strOption) ( long "builddir" <> metavar "DIR" <> value "dist" ) -< () returnA -< BuildOpts bdir pinfo :: ParserInfo Args pinfo = info parser idm main :: IO () main = do r <- execParser pinfo print r optparse-applicative-0.7.0.2/tests/Examples/Hello.hs0000644000000000000000000000145412230300574020517 0ustar0000000000000000{-# LANGUAGE CPP #-} module Examples.Hello where import Options.Applicative #if __GLASGOW_HASKELL__ <= 702 import Data.Monoid (<>) :: Monoid a => a -> a -> a (<>) = mappend #endif data Sample = Sample { hello :: String , quiet :: Bool } deriving Show sample :: Parser Sample sample = Sample <$> strOption ( long "hello" <> metavar "TARGET" <> help "Target for the greeting" ) <*> switch ( long "quiet" <> help "Whether to be quiet" ) greet :: Sample -> IO () greet (Sample h False) = putStrLn $ "Hello, " ++ h greet _ = return () main :: IO () main = execParser opts >>= greet opts :: ParserInfo Sample opts = info (sample <**> helper) ( fullDesc <> progDesc "Print a greeting for TARGET" <> header "hello - a test for optparse-applicative" ) optparse-applicative-0.7.0.2/Options/0000755000000000000000000000000012230300574015627 5ustar0000000000000000optparse-applicative-0.7.0.2/Options/Applicative.hs0000644000000000000000000000215212230300574020424 0ustar0000000000000000module Options.Applicative ( -- * Applicative option parsers -- -- | This is an empty module which simply re-exports all the public definitions -- of this package. -- -- See for a tutorial, -- and a general introduction to applicative option parsers. -- -- See the documentation of individual modules for more details. -- * Exported modules -- -- | The standard @Applicative@ module is re-exported here for convenience. module Control.Applicative, -- | Parser type and low-level parsing functionality. module Options.Applicative.Common, -- | Utilities to build parsers out of basic primitives. module Options.Applicative.Builder, -- | Common completion functions. module Options.Applicative.Builder.Completer, -- | Utilities to run parsers and display a help text. module Options.Applicative.Extra, ) where -- reexport Applicative here for convenience import Control.Applicative import Options.Applicative.Common import Options.Applicative.Builder import Options.Applicative.Builder.Completer import Options.Applicative.Extra optparse-applicative-0.7.0.2/Options/Applicative/0000755000000000000000000000000012230300574020070 5ustar0000000000000000optparse-applicative-0.7.0.2/Options/Applicative/Utils.hs0000644000000000000000000000146012230300574021525 0ustar0000000000000000module Options.Applicative.Utils ( (<+>), vcat, tabulate, pad ) where import Data.List (intercalate) -- | Concatenate two strings with a space in the middle. (<+>) :: String -> String -> String "" <+> s = s s <+> "" = s s1 <+> s2 = s1 ++ " " ++ s2 -- | Concatenate strings vertically with empty lines in between. vcat :: [String] -> String vcat = intercalate "\n\n" . filter (not . null) tabulate' :: Int -> [(String, String)] -> [String] tabulate' size table = [ " " ++ pad size key ++ " " ++ value | (key, value) <- table ] -- | Display pairs of strings in a table. tabulate :: [(String, String)] -> [String] tabulate = tabulate' 24 -- | Pad a string to a fixed size with whitespace. pad :: Int -> String -> String pad size str = str ++ replicate (size - n `max` 0) ' ' where n = length str optparse-applicative-0.7.0.2/Options/Applicative/Help.hs0000644000000000000000000000654112230300574021322 0ustar0000000000000000module Options.Applicative.Help ( cmdDesc, briefDesc, fullDesc, parserHelpText, ) where import Data.List (intercalate, sort) import Data.Maybe (maybeToList, catMaybes) import Options.Applicative.Common import Options.Applicative.Types import Options.Applicative.Utils -- | Style for rendering an option. data OptDescStyle = OptDescStyle { descSep :: String , descHidden :: Bool , descSurround :: Bool } -- | Generate description for a single option. optDesc :: ParserPrefs -> OptDescStyle -> OptHelpInfo -> Option a -> String optDesc pprefs style info opt = let ns = optionNames $ optMain opt mv = optMetaVar opt descs = map showOption (sort ns) desc' = intercalate (descSep style) descs <+> mv show_opt | optVisibility opt == Hidden = descHidden style | otherwise = optVisibility opt == Visible suffix | hinfoMulti info = prefMultiSuffix pprefs | otherwise = "" render text | not show_opt = "" | null text || not (descSurround style) = text ++ suffix | hinfoDefault info = "[" ++ text ++ "]" ++ suffix | null (drop 1 descs) = text ++ suffix | otherwise = "(" ++ text ++ ")" ++ suffix in render desc' -- | Generate descriptions for commands. cmdDesc :: Parser a -> [String] cmdDesc = concat . mapParser desc where desc _ opt = case optMain opt of CmdReader cmds p -> tabulate [(cmd, d) | cmd <- reverse cmds , d <- maybeToList . fmap infoProgDesc $ p cmd ] _ -> [] -- | Generate a brief help text for a parser. briefDesc :: ParserPrefs -> Parser a -> String briefDesc pprefs = fold_tree . treeMapParser (optDesc pprefs style) where style = OptDescStyle { descSep = "|" , descHidden = False , descSurround = True } fold_tree (Leaf x) = x fold_tree (MultNode xs) = unwords (fold_trees xs) fold_tree (AltNode xs) = alt_node (fold_trees xs) alt_node [n] = n alt_node ns = "(" ++ intercalate " | " ns ++ ")" fold_trees = filter (not . null) . map fold_tree -- | Generate a full help text for a parser. fullDesc :: ParserPrefs -> Parser a -> [String] fullDesc pprefs = tabulate . catMaybes . mapParser doc where doc info opt | null n = Nothing | null h = Nothing | otherwise = Just (n, h ++ hdef) where n = optDesc pprefs style info opt h = optHelp opt hdef = maybe "" show_def (optShowDefault opt) show_def s = " (default: " ++ s ++ ")" style = OptDescStyle { descSep = "," , descHidden = True , descSurround = False } -- | Generate the help text for a program. parserHelpText :: ParserPrefs -> ParserInfo a -> String parserHelpText pprefs pinfo = unlines $ nn [infoHeader pinfo] ++ [ " " ++ line | line <- nn [infoProgDesc pinfo] ] ++ [ line | let opts = fullDesc pprefs p , not (null opts) , line <- ["", "Available options:"] ++ opts , infoFullDesc pinfo ] ++ [ line | let cmds = cmdDesc p , not (null cmds) , line <- ["", "Available commands:"] ++ cmds , infoFullDesc pinfo ] ++ [ line | footer <- nn [infoFooter pinfo] , line <- ["", footer] ] where nn = filter (not . null) p = infoParser pinfo optparse-applicative-0.7.0.2/Options/Applicative/Common.hs0000644000000000000000000002263012230300574021657 0ustar0000000000000000{-# LANGUAGE Rank2Types #-} module Options.Applicative.Common ( -- * Option parsers -- -- | A 'Parser' is composed of a list of options. Several kinds of options -- are supported: -- -- * Flags: simple no-argument options. When a flag is encountered on the -- command line, its value is returned. -- -- * Options: options with an argument. An option can define a /reader/, -- which converts its argument from String to the desired value, or throws a -- parse error if the argument does not validate correctly. -- -- * Arguments: positional arguments, validated in the same way as option -- arguments. -- -- * Commands. A command defines a completely independent sub-parser. When a -- command is encountered, the whole command line is passed to the -- corresponding parser. -- Parser, liftOpt, showOption, -- * Program descriptions -- -- A 'ParserInfo' describes a command line program, used to generate a help -- screen. Two help modes are supported: brief and full. In brief mode, only -- an option and argument summary is displayed, while in full mode each -- available option and command, including hidden ones, is described. -- -- A basic 'ParserInfo' with default values for fields can be created using -- the 'info' function. ParserInfo(..), -- * Running parsers runParser, runParserFully, evalParser, -- * Low-level utilities mapParser, treeMapParser, optionNames ) where import Control.Applicative (pure, (<*>), (<$>), (<|>), (<$)) import Control.Monad (guard, mzero, msum, when, liftM, MonadPlus) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.State (StateT(..), get, put, runStateT) import Data.List (isPrefixOf) import Data.Maybe (maybeToList, isJust, isNothing) import Data.Monoid (Monoid(..)) import Options.Applicative.Internal import Options.Applicative.Types showOption :: OptName -> String showOption (OptLong n) = "--" ++ n showOption (OptShort n) = '-' : [n] optionNames :: OptReader a -> [OptName] optionNames (OptReader names _ _) = names optionNames (FlagReader names _) = names optionNames _ = [] isOptionPrefix :: OptName -> OptName -> Bool isOptionPrefix (OptShort x) (OptShort y) = x == y isOptionPrefix (OptLong x) (OptLong y) = x `isPrefixOf` y isOptionPrefix _ _ = False -- | Create a parser composed of a single option. liftOpt :: Option a -> Parser a liftOpt = OptP data MatchResult = NoMatch | Match (Maybe String) instance Monoid MatchResult where mempty = NoMatch mappend m@(Match _) _ = m mappend _ m = m type Args = [String] argMatches :: MonadP m => OptReader a -> String -> Maybe (StateT Args m a) argMatches opt arg = case opt of ArgReader rdr -> do result <- crReader rdr arg Just $ return result CmdReader _ f -> flip fmap (f arg) $ \subp -> StateT $ \args -> do setContext (Just arg) subp prefs <- getPrefs let runSubparser | prefBacktrack prefs = \p a -> do policy <- getPolicy runParser policy p a | otherwise = \p a -> (,) <$> runParserFully p a <*> pure [] runSubparser (infoParser subp) args _ -> Nothing optMatches :: MonadP m => Bool -> OptReader a -> OptWord -> Maybe (StateT Args m a) optMatches disambiguate opt (OptWord arg1 val) = case opt of OptReader names rdr no_arg_err -> do guard $ has_name arg1 names Just $ do args <- get let mb_args = uncons $ maybeToList val ++ args let missing_arg = lift $ missingArgP no_arg_err (crCompleter rdr) (arg', args') <- maybe missing_arg return mb_args put args' case runReadM (crReader rdr arg') of Left e -> lift $ errorFor arg1 e Right r -> return r FlagReader names x -> do guard $ has_name arg1 names guard $ isNothing val Just $ return x _ -> Nothing where errorFor name (ErrorMsg msg) = errorP (ErrorMsg ("option " ++ showOption name ++ ": " ++ msg)) errorFor _ e = errorP e has_name a | disambiguate = any (isOptionPrefix a) | otherwise = elem a isArg :: OptReader a -> Bool isArg (ArgReader _) = True isArg _ = False data OptWord = OptWord OptName (Maybe String) parseWord :: String -> Maybe OptWord parseWord ('-' : '-' : w) = Just $ let (opt, arg) = case span (/= '=') w of (_, "") -> (w, Nothing) (w', _ : rest) -> (w', Just rest) in OptWord (OptLong opt) arg parseWord ('-' : w) = case w of [] -> Nothing (a : rest) -> Just $ let arg = rest <$ guard (not (null rest)) in OptWord (OptShort a) arg parseWord _ = Nothing searchParser :: Monad m => (forall r . Option r -> NondetT m r) -> Parser a -> NondetT m (Parser a) searchParser _ (NilP _) = mzero searchParser f (OptP opt) = liftM pure (f opt) searchParser f (MultP p1 p2) = foldr1 () [ do p1' <- searchParser f p1 return (p1' <*> p2) , do p2' <- searchParser f p2 return (p1 <*> p2') ] searchParser f (AltP p1 p2) = msum [ searchParser f p1 , searchParser f p2 ] searchParser f (BindP p k) = do p' <- searchParser f p x <- hoistMaybe (evalParser p') return (k x) searchOpt :: MonadP m => ParserPrefs -> OptWord -> Parser a -> NondetT (StateT Args m) (Parser a) searchOpt pprefs w = searchParser $ \opt -> do let disambiguate = prefDisambiguate pprefs && optVisibility opt > Internal case optMatches disambiguate (optMain opt) w of Just matcher -> lift matcher Nothing -> mzero searchArg :: MonadP m => String -> Parser a -> NondetT (StateT Args m) (Parser a) searchArg arg = searchParser $ \opt -> do when (isArg (optMain opt)) cut case argMatches (optMain opt) arg of Just matcher -> lift matcher Nothing -> mzero data ArgPolicy = SkipOpts | AllowOpts deriving Eq stepParser :: MonadP m => ParserPrefs -> ArgPolicy -> String -> Parser a -> NondetT (StateT Args m) (Parser a) stepParser pprefs SkipOpts arg p = case parseWord arg of Just w -> searchOpt pprefs w p Nothing -> searchArg arg p stepParser pprefs AllowOpts arg p = msum [ searchArg arg p , do w <- hoistMaybe (parseWord arg) searchOpt pprefs w p ] -- | Apply a 'Parser' to a command line, and return a result and leftover -- arguments. This function returns an error if any parsing error occurs, or -- if any options are missing and don't have a default value. runParser :: MonadP m => ArgPolicy -> Parser a -> Args -> m (a, Args) runParser policy p args = case args of [] -> exitP p result ("--" : argt) -> runParser AllowOpts p argt (arg : argt) -> do prefs <- getPrefs (mp', args') <- do_step prefs arg argt case mp' of Nothing -> hoistMaybe result <|> parseError arg Just p' -> runParser policy p' args' where result = (,) <$> evalParser p <*> pure args do_step prefs arg argt = (`runStateT` argt) . disamb (not (prefDisambiguate prefs)) $ stepParser prefs policy arg p parseError :: MonadP m => String -> m a parseError arg = errorP . ErrorMsg $ msg where msg = case arg of ('-':_) -> "Invalid option `" ++ arg ++ "'" _ -> "Invalid argument `" ++ arg ++ "'" getPolicy :: MonadP m => m ArgPolicy getPolicy = do prefs <- getPrefs return $ if prefIntersperse prefs then SkipOpts else AllowOpts runParserFully :: MonadP m => Parser a -> Args -> m a runParserFully p args = do policy <- getPolicy (r, args') <- runParser policy p args guard $ null args' return r -- | The default value of a 'Parser'. This function returns an error if any of -- the options don't have a default value. evalParser :: Parser a -> Maybe a evalParser (NilP r) = r evalParser (OptP _) = Nothing evalParser (MultP p1 p2) = evalParser p1 <*> evalParser p2 evalParser (AltP p1 p2) = evalParser p1 <|> evalParser p2 evalParser (BindP p k) = evalParser p >>= evalParser . k -- | Map a polymorphic function over all the options of a parser, and collect -- the results in a list. mapParser :: (forall x. OptHelpInfo -> Option x -> b) -> Parser a -> [b] mapParser f = flatten . treeMapParser f where flatten (Leaf x) = [x] flatten (MultNode xs) = xs >>= flatten flatten (AltNode xs) = xs >>= flatten -- | Like 'mapParser', but collect the results in a tree structure. treeMapParser :: (forall x . OptHelpInfo -> Option x -> b) -> Parser a -> OptTree b treeMapParser g = simplify . go False False g where has_default :: Parser a -> Bool has_default p = isJust (evalParser p) go :: Bool -> Bool -> (forall x . OptHelpInfo -> Option x -> b) -> Parser a -> OptTree b go _ _ _ (NilP _) = MultNode [] go m d f (OptP opt) | optVisibility opt > Internal = Leaf (f (OptHelpInfo m d) opt) | otherwise = MultNode [] go m d f (MultP p1 p2) = MultNode [go m d f p1, go m d f p2] go m d f (AltP p1 p2) = AltNode [go m d' f p1, go m d' f p2] where d' = d || has_default p1 || has_default p2 go _ d f (BindP p _) = go True d f p simplify :: OptTree a -> OptTree a simplify (Leaf x) = Leaf x simplify (MultNode xs) = case concatMap (remove_mult . simplify) xs of [x] -> x xs' -> MultNode xs' where remove_mult (MultNode ts) = ts remove_mult t = [t] simplify (AltNode xs) = case concatMap (remove_alt . simplify) xs of [] -> MultNode [] [x] -> x xs' -> AltNode xs' where remove_alt (AltNode ts) = ts remove_alt (MultNode []) = [] remove_alt t = [t] optparse-applicative-0.7.0.2/Options/Applicative/Extra.hs0000644000000000000000000001202412230300574021506 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} module Options.Applicative.Extra ( -- * Extra parser utilities -- -- | This module contains high-level functions to run parsers. helper, hsubparser, execParser, execParserMaybe, customExecParser, customExecParserMaybe, execParserPure, usage, ParserFailure(..), ) where import Control.Applicative ((<$>), (<|>), (<**>)) import Data.Monoid (mconcat) import System.Environment (getArgs, getProgName) import System.Exit (exitWith, ExitCode(..)) import System.IO (hPutStr, stderr) import Options.Applicative.BashCompletion import Options.Applicative.Builder hiding (briefDesc) import Options.Applicative.Builder.Internal import Options.Applicative.Common import Options.Applicative.Help import Options.Applicative.Internal import Options.Applicative.Types import Options.Applicative.Utils -- | A hidden \"helper\" option which always fails. helper :: Parser (a -> a) helper = abortOption ShowHelpText $ mconcat [ long "help" , short 'h' , help "Show this help text" ] hsubparser :: Mod CommandFields a -> Parser a hsubparser m = mkParser d g rdr where Mod _ d g = m `mappend` metavar "COMMAND" (cmds, subs) = mkCommand m rdr = CmdReader cmds (fmap add_helper . subs) add_helper pinfo = pinfo { infoParser = infoParser pinfo <**> helper } -- | Run a program description. -- -- Parse command line arguments. Display help text and exit if any parse error -- occurs. execParser :: ParserInfo a -> IO a execParser = customExecParser (prefs idm) -- | Run a program description with custom preferences. customExecParser :: ParserPrefs -> ParserInfo a -> IO a customExecParser pprefs pinfo = do args <- getArgs case execParserPure pprefs pinfo args of Right a -> return a Left failure -> do progn <- getProgName let c = errExitCode failure msg <- errMessage failure progn case c of ExitSuccess -> putStr msg _ -> hPutStr stderr msg exitWith c -- | Run a program description in pure code. -- -- This function behaves like 'execParser', but can be called from pure code. -- Note that, in case of errors, no message is displayed, and this function -- simply returns 'Nothing'. -- -- If you need to keep track of error messages, use 'execParserPure' instead. execParserMaybe :: ParserInfo a -> [String] -> Maybe a execParserMaybe = customExecParserMaybe (prefs idm) -- | Run a program description with custom preferences in pure code. -- -- See 'execParserMaybe' for details. customExecParserMaybe :: ParserPrefs -> ParserInfo a -> [String] -> Maybe a customExecParserMaybe pprefs pinfo = either (const Nothing) Just . execParserPure pprefs pinfo data Result a = Result a | Extra ParserFailure -- | The most general way to run a program description in pure code. execParserPure :: ParserPrefs -- ^ Global preferences for this parser -> ParserInfo a -- ^ Description of the program to run -> [String] -- ^ Program arguments -> Either ParserFailure a execParserPure pprefs pinfo args = case runP p pprefs of (Right r, _) -> case r of Result a -> Right a Extra failure -> Left failure (Left msg, ctx) -> Left $ parserFailure pprefs pinfo msg ctx where parser = infoParser pinfo parser' = (Extra <$> bashCompletionParser parser pprefs) <|> (Result <$> parser) p = runParserFully parser' args parserFailure :: ParserPrefs -> ParserInfo a -> ParseError -> Context -> ParserFailure parserFailure pprefs pinfo msg ctx = ParserFailure { errMessage = \progn -> with_context ctx pinfo $ \names -> return . show_help . add_error . add_usage names progn , errExitCode = exit_code } where add_usage names progn i = case msg of InfoMsg _ -> i _ -> i { infoHeader = vcat ( header_line i ++ [ usage pprefs (infoParser i) ename ] ) } where ename = unwords (progn : names) add_error i = i { infoHeader = vcat (error_msg ++ [infoHeader i]) } error_msg = case msg of ShowHelpText -> [] ErrorMsg m -> [m] InfoMsg m -> [m] exit_code = case msg of InfoMsg _ -> ExitSuccess _ -> ExitFailure (infoFailureCode pinfo) show_full_help = case msg of ShowHelpText -> True _ -> prefShowHelpOnError pprefs show_help i | show_full_help = parserHelpText pprefs i | otherwise = unlines $ filter (not . null) [ infoHeader i ] header_line i | show_full_help = [ infoHeader i ] | otherwise = [] with_context :: Context -> ParserInfo a -> (forall b . [String] -> ParserInfo b -> c) -> c with_context NullContext i f = f [] i with_context (Context n i) _ f = f n i -- | Generate option summary. usage :: ParserPrefs -> Parser a -> String -> String usage pprefs p progn = foldr (<+>) "" [ "Usage:" , progn , briefDesc pprefs p ] optparse-applicative-0.7.0.2/Options/Applicative/Internal.hs0000644000000000000000000001617512230300574022212 0ustar0000000000000000{-# LANGUAGE GADTs, RankNTypes #-} module Options.Applicative.Internal ( P , Context(..) , MonadP(..) , ParseError(..) , uncons , hoistMaybe , hoistEither , runP , Completion , runCompletion , SomeParser(..) , ComplError(..) , ListT , takeListT , runListT , NondetT , cut , () , disamb ) where import Control.Applicative (Applicative(..), Alternative(..), (<$>)) import Control.Monad (MonadPlus(..), liftM, ap, guard) import Control.Monad.Trans.Class (MonadTrans, lift) import Control.Monad.Trans.Error (runErrorT, ErrorT(..), Error(..), throwError, catchError) import Control.Monad.Trans.Reader (runReader, runReaderT, Reader, ReaderT, ask) import Control.Monad.Trans.Writer (runWriterT, WriterT, tell) import Control.Monad.Trans.State (StateT, get, put, evalStateT) import Data.Maybe (maybeToList) import Data.Monoid (Monoid(..)) import Options.Applicative.Types class (Alternative m, MonadPlus m) => MonadP m where setContext :: Maybe String -> ParserInfo a -> m () setParser :: Maybe String -> Parser a -> m () getPrefs :: m ParserPrefs missingArgP :: ParseError -> Completer -> m a tryP :: m a -> m (Either ParseError a) errorP :: ParseError -> m a exitP :: Parser b -> Maybe a -> m a newtype P a = P (ErrorT ParseError (WriterT Context (Reader ParserPrefs)) a) instance Functor P where fmap f (P m) = P $ fmap f m instance Applicative P where pure a = P $ pure a P f <*> P a = P $ f <*> a instance Alternative P where empty = P empty P x <|> P y = P $ x <|> y instance Monad P where return a = P $ return a P x >>= k = P $ x >>= \a -> case k a of P y -> y instance MonadPlus P where mzero = P mzero mplus (P x) (P y) = P $ mplus x y data Context where Context :: [String] -> ParserInfo a -> Context NullContext :: Context contextNames :: Context -> [String] contextNames (Context ns _) = ns contextNames NullContext = [] instance Monoid Context where mempty = NullContext mappend c (Context ns i) = Context (contextNames c ++ ns) i mappend c _ = c instance MonadP P where setContext name = P . lift . tell . Context (maybeToList name) setParser _ _ = return () getPrefs = P . lift . lift $ ask missingArgP e _ = errorP e tryP (P p) = P $ lift $ runErrorT p exitP _ = P . hoistMaybe errorP = P . throwError hoistMaybe :: MonadPlus m => Maybe a -> m a hoistMaybe = maybe mzero return hoistEither :: MonadP m => Either ParseError a -> m a hoistEither = either errorP return runP :: P a -> ParserPrefs -> (Either ParseError a, Context) runP (P p) = runReader . runWriterT . runErrorT $ p uncons :: [a] -> Maybe (a, [a]) uncons [] = Nothing uncons (x : xs) = Just (x, xs) data SomeParser where SomeParser :: Parser a -> SomeParser data ComplError = ComplParseError String | ComplExit instance Error ComplError where strMsg = ComplParseError data ComplResult a = ComplParser SomeParser | ComplOption Completer | ComplResult a instance Functor ComplResult where fmap = liftM instance Applicative ComplResult where pure = ComplResult (<*>) = ap instance Monad ComplResult where return = pure m >>= f = case m of ComplResult r -> f r ComplParser p -> ComplParser p ComplOption c -> ComplOption c newtype Completion a = Completion (ErrorT ParseError (ReaderT ParserPrefs ComplResult) a) instance Functor Completion where fmap f (Completion m) = Completion $ fmap f m instance Applicative Completion where pure a = Completion $ pure a Completion f <*> Completion a = Completion $ f <*> a instance Alternative Completion where empty = Completion empty Completion x <|> Completion y = Completion $ x <|> y instance Monad Completion where return a = Completion $ return a Completion x >>= k = Completion $ x >>= \a -> case k a of Completion y -> y instance MonadPlus Completion where mzero = Completion mzero mplus (Completion x) (Completion y) = Completion $ mplus x y instance MonadP Completion where setContext _ _ = return () setParser _ _ = return () getPrefs = Completion $ lift ask missingArgP _ = Completion . lift . lift . ComplOption tryP (Completion p) = Completion $ catchError (Right <$> p) (return . Left) exitP p _ = Completion . lift . lift . ComplParser $ SomeParser p errorP = Completion . throwError runCompletion :: Completion r -> ParserPrefs -> Maybe (Either SomeParser Completer) runCompletion (Completion c) prefs = case runReaderT (runErrorT c) prefs of ComplResult _ -> Nothing ComplParser p' -> Just $ Left p' ComplOption compl -> Just $ Right compl -- A "ListT done right" implementation newtype ListT m a = ListT { stepListT :: m (TStep a (ListT m a)) } data TStep a x = TNil | TCons a x bimapTStep :: (a -> b) -> (x -> y) -> TStep a x -> TStep b y bimapTStep _ _ TNil = TNil bimapTStep f g (TCons a x) = TCons (f a) (g x) hoistList :: Monad m => [a] -> ListT m a hoistList = foldr (\x xt -> ListT (return (TCons x xt))) mzero takeListT :: Monad m => Int -> ListT m a -> ListT m a takeListT 0 = const mzero takeListT n = ListT . liftM (bimapTStep id (takeListT (n - 1))) . stepListT runListT :: Monad m => ListT m a -> m [a] runListT xs = do s <- stepListT xs case s of TNil -> return [] TCons x xt -> liftM (x :) (runListT xt) instance Monad m => Functor (ListT m) where fmap f = ListT . liftM (bimapTStep f (fmap f)) . stepListT instance Monad m => Applicative (ListT m) where pure = hoistList . pure (<*>) = ap instance Monad m => Monad (ListT m) where return = pure xs >>= f = ListT $ do s <- stepListT xs case s of TNil -> return TNil TCons x xt -> stepListT $ f x `mplus` (xt >>= f) instance Monad m => Alternative (ListT m) where empty = mzero (<|>) = mplus instance MonadTrans ListT where lift = ListT . liftM (`TCons` mzero) instance Monad m => MonadPlus (ListT m) where mzero = ListT (return TNil) mplus xs ys = ListT $ do s <- stepListT xs case s of TNil -> stepListT ys TCons x xt -> return $ TCons x (xt `mplus` ys) -- nondeterminism monad with cut operator newtype NondetT m a = NondetT { runNondetT :: ListT (StateT Bool m) a } instance Monad m => Functor (NondetT m) where fmap f = NondetT . fmap f . runNondetT instance Monad m => Applicative (NondetT m) where pure = NondetT . pure NondetT m1 <*> NondetT m2 = NondetT (m1 <*> m2) instance Monad m => Monad (NondetT m) where return = pure NondetT m1 >>= f = NondetT $ m1 >>= runNondetT . f instance Monad m => MonadPlus (NondetT m) where mzero = NondetT mzero NondetT m1 `mplus` NondetT m2 = NondetT (m1 `mplus` m2) instance Monad m => Alternative (NondetT m) where empty = mzero (<|>) = mplus instance MonadTrans NondetT where lift = NondetT . lift . lift () :: Monad m => NondetT m a -> NondetT m a -> NondetT m a () m1 m2 = NondetT . mplus (runNondetT m1) $ do s <- lift get guard (not s) runNondetT m2 cut :: Monad m => NondetT m () cut = NondetT $ lift (put True) disamb :: Monad m => Bool -> NondetT m a -> m (Maybe a) disamb allow_amb xs = do xs' <- (`evalStateT` False) . runListT . takeListT (if allow_amb then 1 else 2) . runNondetT $ xs return $ case xs' of [x] -> Just x _ -> Nothing optparse-applicative-0.7.0.2/Options/Applicative/BashCompletion.hs0000644000000000000000000000520312230300574023333 0ustar0000000000000000module Options.Applicative.BashCompletion ( bashCompletionParser ) where import Control.Applicative ((<$>), (<*>), many) import Data.Foldable (asum) import Data.List (isPrefixOf) import Data.Maybe (fromMaybe, listToMaybe) import System.Exit (ExitCode(..)) import Options.Applicative.Builder import Options.Applicative.Common import Options.Applicative.Internal import Options.Applicative.Types bashCompletionParser :: Parser a -> ParserPrefs -> Parser ParserFailure bashCompletionParser parser pprefs = complParser where failure opts = ParserFailure { errMessage = \progn -> unlines <$> opts progn , errExitCode = ExitSuccess } complParser = asum [ failure <$> ( bashCompletionQuery parser pprefs <$> (many . strOption) (long "bash-completion-word" `mappend` internal) <*> option (long "bash-completion-index" `mappend` internal) ) , failure <$> (bashCompletionScript <$> strOption (long "bash-completion-script" `mappend` internal)) ] bashCompletionQuery :: Parser a -> ParserPrefs -> [String] -> Int -> String -> IO [String] bashCompletionQuery parser pprefs ws i _ = case runCompletion compl pprefs of Just (Left (SomeParser p)) -> list_options p Just (Right c) -> run_completer c _ -> return [] where list_options = fmap concat . sequence . mapParser (\_ -> opt_completions) opt_completions opt = case optMain opt of OptReader ns _ _ -> show_names ns FlagReader ns _ -> show_names ns ArgReader rdr -> run_completer (crCompleter rdr) CmdReader ns _ -> filter_names ns show_name (OptShort c) = '-':[c] show_name (OptLong name) = "--" ++ name show_names = filter_names . map show_name filter_names = return . filter is_completion run_completer :: Completer -> IO [String] run_completer c = runCompleter c (fromMaybe "" (listToMaybe ws'')) (ws', ws'') = splitAt i ws is_completion = case ws'' of w:_ -> isPrefixOf w _ -> const True compl = do setParser Nothing parser runParserFully parser (drop 1 ws') bashCompletionScript :: String -> String -> IO [String] bashCompletionScript prog progn = return [ "_" ++ progn ++ "()" , "{" , " local cmdline" , " CMDLINE=(--bash-completion-index $COMP_CWORD)" , "" , " for arg in ${COMP_WORDS[@]}; do" , " CMDLINE=(${CMDLINE[@]} --bash-completion-word $arg)" , " done" , "" , " COMPREPLY=( $(" ++ prog ++ " \"${CMDLINE[@]}\") )" , "}" , "" , "complete -o filenames -F _" ++ progn ++ " " ++ progn ] optparse-applicative-0.7.0.2/Options/Applicative/Arrows.hs0000644000000000000000000000462512230300574021710 0ustar0000000000000000-- | This module contains an arrow interface for option parsers, which allows -- to define and combine parsers using the arrow notation and arrow -- combinators. -- -- The arrow syntax is particularly useful to create parsers of nested -- structures, or records where the order of fields is different from the order -- in which the parsers should be applied. -- -- For example, an 'Options.Applicative.Builder.arguments` parser often needs -- to be applied last, and that makes it inconvenient to use it for a field -- which is not the last one in a record. -- -- Using the arrow syntax and the functions in this module, one can write, e.g.: -- -- > data Options = Options -- > { optArgs :: [String] -- > , optVerbose :: Bool } -- > -- > opts :: Parser Options -- > opts = runA $ proc () -> do -- > verbose <- asA (switch (short 'v')) -< () -- > args <- asA (arguments str idm) -< () -- > returnA -< Options args verbose -- -- Parser arrows, created out of regular 'Parser' values using the 'asA' -- function, are arrows taking @()@ as argument and returning the parsed value. module Options.Applicative.Arrows ( module Control.Arrow, A(..), asA, runA, ParserA, ) where import Control.Arrow import Control.Category (Category(..)) import Options.Applicative import Prelude hiding ((.), id) -- | For any 'Applicative' functor @f@, @A f@ is the 'Arrow' instance -- associated to @f@. -- -- The 'A' constructor can be used to convert a value of type @f (a -> b)@ into -- an arrow. newtype A f a b = A { unA :: f (a -> b) } -- | Convert a value of type @f a@ into an arrow taking @()@ as argument. -- -- Applied to a value of type 'Parser', it turns it into an arrow that can be -- used inside an arrow command, or passed to arrow combinators. asA :: Applicative f => f a -> A f () a asA x = A $ const <$> x -- | Convert an arrow back to an applicative value. -- -- This function can be used to return a result of type 'Parser' from an arrow -- command. runA :: Applicative f => A f () a -> f a runA a = unA a <*> pure () instance Applicative f => Category (A f) where id = A $ pure id -- use reverse composition, because we want effects to run from -- top to bottom in the arrow syntax (A f) . (A g) = A $ flip (.) <$> g <*> f instance Applicative f => Arrow (A f) where arr = A . pure first (A f) = A $ first <$> f -- | The type of arrows associated to the applicative 'Parser' functor. type ParserA = A Parser optparse-applicative-0.7.0.2/Options/Applicative/Types.hs0000644000000000000000000001706412230300574021540 0ustar0000000000000000{-# LANGUAGE GADTs, Rank2Types #-} module Options.Applicative.Types ( ParseError(..), ParserInfo(..), ParserPrefs(..), Option(..), OptName(..), OptReader(..), OptProperties(..), OptVisibility(..), ReadM(..), readerAbort, readerError, CReader(..), Parser(..), ParserM(..), Completer(..), mkCompleter, ParserFailure(..), OptHelpInfo(..), OptTree(..), fromM, oneM, manyM, someM, optVisibility, optMetaVar, optHelp, optShowDefault ) where import Control.Applicative (Applicative(..), Alternative(..), (<$>), optional) import Control.Monad (ap, liftM, MonadPlus, mzero, mplus) import Control.Monad.Trans.Error (Error(..)) import Data.Monoid (Monoid(..)) import System.Exit (ExitCode(..)) data ParseError = ErrorMsg String | InfoMsg String | ShowHelpText deriving Show instance Error ParseError where strMsg = ErrorMsg -- | A full description for a runnable 'Parser' for a program. data ParserInfo a = ParserInfo { infoParser :: Parser a -- ^ the option parser for the program , infoFullDesc :: Bool -- ^ whether the help text should contain full documentation , infoProgDesc :: String -- ^ brief parser description , infoHeader :: String -- ^ header of the full parser description , infoFooter :: String -- ^ footer of the full parser description , infoFailureCode :: Int -- ^ exit code for a parser failure } instance Functor ParserInfo where fmap f i = i { infoParser = fmap f (infoParser i) } -- | Global preferences for a top-level 'Parser'. data ParserPrefs = ParserPrefs { prefMultiSuffix :: String -- ^ metavar suffix for multiple options , prefDisambiguate :: Bool -- ^ automatically disambiguate abbreviations -- (default: False) , prefShowHelpOnError :: Bool -- ^ always show help text on parse errors -- (default: False) , prefBacktrack :: Bool -- ^ backtrack to parent parser when a -- subcommand fails (default: True) , prefIntersperse :: Bool -- ^ allow regular options and flags to occur -- after arguments (default: True) } data OptName = OptShort !Char | OptLong !String deriving (Eq, Ord) -- | Visibility of an option in the help text. data OptVisibility = Internal -- ^ does not appear in the help text at all | Hidden -- ^ only visible in the full description | Visible -- ^ visible both in the full and brief descriptions deriving (Eq, Ord) -- | Specification for an individual parser option. data OptProperties = OptProperties { propVisibility :: OptVisibility -- ^ whether this flag is shown is the brief description , propHelp :: String -- ^ help text for this option , propMetaVar :: String -- ^ metavariable for this option , propShowDefault :: Maybe String -- ^ what to show in the help text as the default } -- | A single option of a parser. data Option a = Option { optMain :: OptReader a -- ^ reader for this option , optProps :: OptProperties -- ^ properties of this option } instance Functor Option where fmap f (Option m p) = Option (fmap f m) p data CReader m a = CReader { crCompleter :: Completer , crReader :: String -> m a } instance Functor m => Functor (CReader m) where fmap f (CReader c r) = CReader c (fmap f . r) -- | A newtype over the 'Either' monad used by option readers. newtype ReadM a = ReadM { runReadM :: Either ParseError a } instance Functor ReadM where fmap f (ReadM m) = ReadM (fmap f m) instance Applicative ReadM where pure = ReadM . Right ReadM b <*> ReadM a = ReadM (b <*> a) instance Monad ReadM where return = ReadM . Right ReadM m >>= f = ReadM $ m >>= runReadM . f fail = ReadM . Left . ErrorMsg instance MonadPlus ReadM where mzero = ReadM $ Left (strMsg "") mplus m1 m2 = case runReadM m1 of Left _ -> m2 Right r -> return r -- | Abort option reader by exiting with a 'ParseError'. readerAbort :: ParseError -> ReadM a readerAbort = ReadM . Left -- | Abort option reader by exiting with an error message. readerError :: String -> ReadM a readerError = readerAbort . ErrorMsg type OptCReader = CReader ReadM type ArgCReader = CReader Maybe -- | An 'OptReader' defines whether an option matches an command line argument. data OptReader a = OptReader [OptName] (OptCReader a) ParseError -- ^ option reader | FlagReader [OptName] !a -- ^ flag reader | ArgReader (ArgCReader a) -- ^ argument reader | CmdReader [String] (String -> Maybe (ParserInfo a)) -- ^ command reader instance Functor OptReader where fmap f (OptReader ns cr e) = OptReader ns (fmap f cr) e fmap f (FlagReader ns x) = FlagReader ns (f x) fmap f (ArgReader cr) = ArgReader (fmap f cr) fmap f (CmdReader cs g) = CmdReader cs ((fmap . fmap) f . g) -- | A @Parser a@ is an option parser returning a value of type 'a'. data Parser a where NilP :: Maybe a -> Parser a OptP :: Option a -> Parser a MultP :: Parser (a -> b) -> Parser a -> Parser b AltP :: Parser a -> Parser a -> Parser a BindP :: Parser a -> (a -> Parser b) -> Parser b instance Functor Parser where fmap f (NilP x) = NilP (fmap f x) fmap f (OptP opt) = OptP (fmap f opt) fmap f (MultP p1 p2) = MultP (fmap (f.) p1) p2 fmap f (AltP p1 p2) = AltP (fmap f p1) (fmap f p2) fmap f (BindP p k) = BindP p (fmap f . k) instance Applicative Parser where pure = NilP . Just (<*>) = MultP newtype ParserM r = ParserM { runParserM :: forall x . (r -> Parser x) -> Parser x } instance Monad ParserM where return x = ParserM $ \k -> k x ParserM f >>= g = ParserM $ \k -> f (\x -> runParserM (g x) k) instance Functor ParserM where fmap = liftM instance Applicative ParserM where pure = return (<*>) = ap fromM :: ParserM a -> Parser a fromM (ParserM f) = f pure oneM :: Parser a -> ParserM a oneM p = ParserM (BindP p) manyM :: Parser a -> ParserM [a] manyM p = do mx <- oneM (optional p) case mx of Nothing -> return [] Just x -> (x:) <$> manyM p someM :: Parser a -> ParserM [a] someM p = (:) <$> oneM p <*> manyM p instance Alternative Parser where empty = NilP Nothing (<|>) = AltP many p = fromM $ manyM p some p = fromM $ (:) <$> oneM p <*> manyM p newtype Completer = Completer { runCompleter :: String -> IO [String] } mkCompleter :: (String -> IO [String]) -> Completer mkCompleter = Completer instance Monoid Completer where mempty = Completer $ \_ -> return [] mappend (Completer c1) (Completer c2) = Completer $ \s -> (++) <$> c1 s <*> c2 s -- | Result after a parse error. data ParserFailure = ParserFailure { errMessage :: String -> IO String -- ^ Function which takes the program name -- as input and returns an error message , errExitCode :: ExitCode -- ^ Exit code to use for this error } instance Error ParserFailure where strMsg msg = ParserFailure { errMessage = \_ -> return msg , errExitCode = ExitFailure 1 } data OptHelpInfo = OptHelpInfo { hinfoMulti :: Bool , hinfoDefault :: Bool } data OptTree a = Leaf a | MultNode [OptTree a] | AltNode [OptTree a] deriving Show optVisibility :: Option a -> OptVisibility optVisibility = propVisibility . optProps optHelp :: Option a -> String optHelp = propHelp . optProps optMetaVar :: Option a -> String optMetaVar = propMetaVar . optProps optShowDefault :: Option a -> Maybe String optShowDefault = propShowDefault . optProps optparse-applicative-0.7.0.2/Options/Applicative/Builder.hs0000644000000000000000000002502012230300574022011 0ustar0000000000000000{-# 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, argument, arguments, arguments1, flag, flag', switch, nullOption, abortOption, infoOption, strOption, option, -- * Modifiers short, long, help, value, showDefaultWith, showDefault, metavar, reader, eitherReader, noArgError, ParseError(..), hidden, internal, command, completeWith, action, completer, idm, (&), #if __GLASGOW_HASKELL__ > 702 (<>), #endif mappend, -- * Readers -- -- | A collection of basic 'Option' readers. auto, str, disabled, readerAbort, readerError, -- * Builder for 'ParserInfo' InfoMod, fullDesc, briefDesc, header, progDesc, footer, failureCode, info, -- * Builder for 'ParserPrefs' PrefsMod, multiSuffix, disambiguate, showHelpOnError, noBacktrack, noIntersperse, prefs, -- * Types Mod, ReadM, OptionFields, FlagFields, ArgumentFields, CommandFields ) where import Control.Applicative (pure, (<|>), many, some) import Data.Monoid (Monoid (..) #if __GLASGOW_HASKELL__ > 702 , (<>) #endif ) import Options.Applicative.Builder.Completer import Options.Applicative.Builder.Internal import Options.Applicative.Common import Options.Applicative.Types -- readers -- -- | 'Option' reader based on the 'Read' type class. auto :: Monad m => Read a => String -> m a auto arg = case reads arg of [(r, "")] -> return r _ -> fail $ "cannot parse value `" ++ arg ++ "'" -- | String 'Option' reader. str :: Monad m => String -> m String str = return -- | Null 'Option' reader. All arguments will fail validation. disabled :: Monad m => String -> m a disabled = const . fail $ "disabled option" -- modifiers -- -- | Specify a short name for an option. short :: HasName f => Char -> Mod f a short = fieldMod . name . OptShort -- | Specify a long name for an option. long :: HasName f => String -> Mod f a long = fieldMod . name . OptLong -- | Specify a default value for an option. value :: a -> Mod f a value x = Mod id (DefaultProp (Just x) Nothing) id -- | Specify a function to show the default value for an option. showDefaultWith :: (a -> String) -> Mod f a showDefaultWith s = Mod id (DefaultProp Nothing (Just s)) id -- | Show the default value for this option using its 'Show' instance. showDefault :: Show a => Mod f a showDefault = showDefaultWith show -- | Specify the help text for an option. help :: String -> Mod f a help s = optionMod $ \p -> p { propHelp = s } -- | Specify the 'Option' reader. reader :: (String -> ReadM a) -> Mod OptionFields a reader f = fieldMod $ \p -> p { optReader = f } -- | Specify the 'Option' reader as a function in the 'Either' monad. eitherReader :: (String -> Either String a) -> Mod OptionFields a eitherReader f = reader (either readerError return . f) -- | Specify the error to display when no argument is provided to this option. noArgError :: ParseError -> Mod OptionFields a noArgError e = fieldMod $ \p -> p { optNoArgError = e } -- | Specify the metavariable. metavar :: String -> Mod f a metavar var = optionMod $ \p -> p { propMetaVar = var } -- | Hide this option from the brief description. hidden :: Mod f a hidden = optionMod $ \p -> p { propVisibility = min Hidden (propVisibility p) } -- | Add a command to a subparser option. command :: String -> ParserInfo a -> Mod CommandFields a command cmd pinfo = fieldMod $ \p -> p { cmdCommands = (cmd, pinfo) : cmdCommands p } -- | Add a list of possible completion values. completeWith :: HasCompleter f => [String] -> Mod f a completeWith xs = completer (listCompleter xs) -- | 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 act = completer (bashCompleter act) -- | 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 f = fieldMod $ modCompleter (`mappend` f) -- parsers -- -- | Builder for a command parser. The 'command' modifier can be used to -- specify individual commands. subparser :: Mod CommandFields a -> Parser a subparser m = mkParser d g rdr where Mod _ d g = m `mappend` metavar "COMMAND" rdr = uncurry CmdReader (mkCommand m) -- | Builder for an argument parser. argument :: (String -> Maybe a) -> Mod ArgumentFields a -> Parser a argument p (Mod f d g) = mkParser d g (ArgReader rdr) where ArgumentFields compl = f (ArgumentFields mempty) rdr = CReader compl p -- | Builder for an argument list parser. All arguments are collected and -- returned as a list. arguments :: (String -> Maybe a) -> Mod ArgumentFields a -> Parser [a] arguments r m = many (argument r m) -- | Like `arguments`, but require at least one argument. arguments1 :: (String -> Maybe a) -> Mod ArgumentFields a -> Parser [a] arguments1 r m = some (argument r m) -- | 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. flag :: a -- ^ default value -> a -- ^ active value -> Mod FlagFields a -- ^ option modifier -> Parser a flag defv actv m = flag' actv m <|> pure 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. flag' :: a -- ^ active value -> Mod FlagFields a -- ^ option modifier -> Parser a flag' actv (Mod f d g) = mkParser d g rdr where rdr = let fields = f (FlagFields [] actv) in FlagReader (flagNames fields) (flagActive fields) -- | Builder for a boolean flag. -- -- > switch = flag False True switch :: Mod FlagFields Bool -> Parser Bool switch = flag False True -- | Builder for an option with a null reader. A non-trivial reader can be -- added using the 'reader' modifier. nullOption :: Mod OptionFields a -> Parser a nullOption m = mkParser d g rdr where Mod f d g = metavar "ARG" `mappend` m fields = f (OptionFields [] mempty disabled (ErrorMsg "")) crdr = CReader (optCompleter fields) (optReader fields) rdr = OptReader (optNames fields) crdr (optNoArgError fields) -- | 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 err m = nullOption . (`mappend` m) $ mconcat [ reader (const (ReadM (Left err))) , noArgError err , value id , metavar "" , hidden ] -- | An option that always fails and displays a message. infoOption :: String -> Mod OptionFields (a -> a) -> Parser (a -> a) infoOption = abortOption . InfoMsg -- | Builder for an option taking a 'String' argument. strOption :: Mod OptionFields String -> Parser String strOption m = nullOption $ reader str `mappend` m -- | Builder for an option using the 'auto' reader. option :: Read a => Mod OptionFields a -> Parser a option m = nullOption $ reader auto `mappend` m -- | Modifier for 'ParserInfo'. newtype InfoMod a = InfoMod { applyInfoMod :: ParserInfo a -> ParserInfo a } instance Monoid (InfoMod a) where mempty = InfoMod id mappend m1 m2 = InfoMod $ applyInfoMod m2 . applyInfoMod m1 -- | Show a full description in the help text of this parser. fullDesc :: InfoMod a fullDesc = InfoMod $ \i -> i { infoFullDesc = True } -- | Only show a brief description in the help text of this parser. briefDesc :: InfoMod a briefDesc = InfoMod $ \i -> i { infoFullDesc = False } -- | Specify a header for this parser. header :: String -> InfoMod a header s = InfoMod $ \i -> i { infoHeader = s } -- | Specify a footer for this parser. footer :: String -> InfoMod a footer s = InfoMod $ \i -> i { infoFooter = s } -- | Specify a short program description. progDesc :: String -> InfoMod a progDesc s = InfoMod $ \i -> i { infoProgDesc = s } -- | Specify an exit code if a parse error occurs. failureCode :: Int -> InfoMod a failureCode n = InfoMod $ \i -> i { infoFailureCode = n } -- | Create a 'ParserInfo' given a 'Parser' and a modifier. info :: Parser a -> InfoMod a -> ParserInfo a info parser m = applyInfoMod m base where base = ParserInfo { infoParser = parser , infoFullDesc = True , infoProgDesc = "" , infoHeader = "" , infoFooter = "" , infoFailureCode = 1 } newtype PrefsMod = PrefsMod { applyPrefsMod :: ParserPrefs -> ParserPrefs } instance Monoid PrefsMod where mempty = PrefsMod id mappend m1 m2 = PrefsMod $ applyPrefsMod m2 . applyPrefsMod m1 multiSuffix :: String -> PrefsMod multiSuffix s = PrefsMod $ \p -> p { prefMultiSuffix = s } disambiguate :: PrefsMod disambiguate = PrefsMod $ \p -> p { prefDisambiguate = True } showHelpOnError :: PrefsMod showHelpOnError = PrefsMod $ \p -> p { prefShowHelpOnError = True } noBacktrack :: PrefsMod noBacktrack = PrefsMod $ \p -> p { prefBacktrack = False } noIntersperse :: PrefsMod noIntersperse = PrefsMod $ \p -> p { prefIntersperse = False } prefs :: PrefsMod -> ParserPrefs prefs m = applyPrefsMod m base where base = ParserPrefs { prefMultiSuffix = "" , prefDisambiguate = False , prefShowHelpOnError = False , prefBacktrack = True , prefIntersperse = True } -- convenience shortcuts -- | Trivial option modifier. idm :: Monoid m => m idm = mempty -- | Compose modifiers. {-# DEPRECATED (&) "Use (<>) instead" #-} (&) :: Monoid m => m -> m -> m (&) = mappend optparse-applicative-0.7.0.2/Options/Applicative/Builder/0000755000000000000000000000000012230300574021456 5ustar0000000000000000optparse-applicative-0.7.0.2/Options/Applicative/Builder/Internal.hs0000644000000000000000000001023512230300574023567 0ustar0000000000000000module Options.Applicative.Builder.Internal ( -- * Internals Mod(..), HasName(..), HasCompleter(..), OptionFields(..), FlagFields(..), CommandFields(..), ArgumentFields(..), DefaultProp(..), optionMod, fieldMod, baseProps, mkCommand, mkParser, mkOption, mkProps, internal ) where import Control.Applicative (pure, (<*>), empty, (<|>)) import Control.Monad (mplus) import Data.Monoid (Monoid(..)) import Options.Applicative.Common import Options.Applicative.Types data OptionFields a = OptionFields { optNames :: [OptName] , optCompleter :: Completer , optReader :: String -> ReadM a , optNoArgError :: ParseError } data FlagFields a = FlagFields { flagNames :: [OptName] , flagActive :: a } data CommandFields a = CommandFields { cmdCommands :: [(String, ParserInfo a)] } data ArgumentFields a = ArgumentFields { argCompleter :: Completer } class HasName f where name :: OptName -> f a -> f a instance HasName OptionFields where name n fields = fields { optNames = n : optNames fields } instance HasName FlagFields where name n fields = fields { flagNames = n : flagNames fields } class HasCompleter f where modCompleter :: (Completer -> Completer) -> f a -> f a instance HasCompleter OptionFields where modCompleter f p = p { optCompleter = f (optCompleter p) } instance HasCompleter ArgumentFields where modCompleter f p = p { argCompleter = f (argCompleter p) } -- mod -- data DefaultProp a = DefaultProp (Maybe a) (Maybe (a -> String)) instance Monoid (DefaultProp a) where mempty = DefaultProp Nothing Nothing mappend (DefaultProp d1 s1) (DefaultProp d2 s2) = DefaultProp (d1 `mplus` d2) (s1 `mplus` s2) -- | 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 by @f@. -- -- - 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. -- -- You rarely need 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 'Options.Applicative.Builder'). data Mod f a = Mod (f a -> f a) (DefaultProp a) (OptProperties -> OptProperties) optionMod :: (OptProperties -> OptProperties) -> Mod f a optionMod = Mod id mempty fieldMod :: (f a -> f a) -> Mod f a fieldMod f = Mod f mempty id instance Monoid (Mod f a) where mempty = Mod id mempty id Mod f1 d1 g1 `mappend` Mod f2 d2 g2 = Mod (f2 . f1) (d2 `mappend` d1) (g2 . g1) -- | Base default properties. baseProps :: OptProperties baseProps = OptProperties { propMetaVar = "" , propVisibility = Visible , propHelp = "" , propShowDefault = Nothing } mkCommand :: Mod CommandFields a -> ([String], String -> Maybe (ParserInfo a)) mkCommand m = (map fst cmds, (`lookup` cmds)) where Mod f _ _ = m CommandFields cmds = f (CommandFields []) mkParser :: DefaultProp a -> (OptProperties -> OptProperties) -> OptReader a -> Parser a mkParser d@(DefaultProp def _) g rdr = liftOpt opt <|> maybe empty pure def where opt = mkOption d g rdr mkOption :: DefaultProp a -> (OptProperties -> OptProperties) -> OptReader a -> Option a mkOption d g rdr = Option rdr (mkProps d g) mkProps :: DefaultProp a -> (OptProperties -> OptProperties) -> OptProperties mkProps (DefaultProp def sdef) g = props where props = (g baseProps) { propShowDefault = sdef <*> def } -- | Hide this option from the help text internal :: Mod f a internal = optionMod $ \p -> p { propVisibility = Internal } optparse-applicative-0.7.0.2/Options/Applicative/Builder/Completer.hs0000644000000000000000000000146712230300574023754 0ustar0000000000000000module Options.Applicative.Builder.Completer ( Completer , mkCompleter , listIOCompleter , listCompleter , bashCompleter ) where import Control.Applicative ((<$>), pure) import Control.Exception (IOException, try) import Data.List (isPrefixOf) import System.Process (readProcess) import Options.Applicative.Types listIOCompleter :: IO [String] -> Completer listIOCompleter ss = Completer $ \s -> filter (isPrefixOf s) <$> ss listCompleter :: [String] -> Completer listCompleter = listIOCompleter . pure bashCompleter :: String -> Completer bashCompleter action = Completer $ \word -> do let cmd = unwords ["compgen", "-A", action, "--", word] result <- tryIO $ readProcess "bash" ["-c", cmd] "" return . lines . either (const []) id $ result tryIO :: IO a -> IO (Either IOException a) tryIO = try