optparse-applicative-0.14.3.0/0000755000000000000000000000000013355265316014270 5ustar0000000000000000optparse-applicative-0.14.3.0/Setup.hs0000644000000000000000000000005613355265316015725 0ustar0000000000000000import Distribution.Simple main = defaultMain optparse-applicative-0.14.3.0/LICENSE0000644000000000000000000000277013355265316015303 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.14.3.0/CHANGELOG.md0000644000000000000000000002741713355265316016114 0ustar0000000000000000## Version 0.14.3.0 (03 Oct 2018) - Updated dependency bounds. - Fix tab completion with Commands being unreachable. - Clean ups and Documentation. ## Version 0.14.2.0 (26 Feb 2018) - Updated dependency bounds. ## Version 0.14.1.0 (23 Feb 2018) - Updated dependency bounds. - Export `HasName`, `HasCompleter`, `HasValue`, and `HasMetavar` type classes. - Doc. ## Version 0.14.0.0 (09 Jun 2017) - Upgrade `str` and related builders to be polymorphic over `IsString`. This allows `Text` and `Bytestring` to be used naturally with `strOption` and `strArgument` and friends. *Note:* This change may require additional type signatures in cases where the reader was necessary for type inference. - Export public API explicitly from `Options.Applicative` instead of re-exporting other modules. *Note:* Minor changes to exports were made in conjunction to this change. `ParserHelp` no longer requires an an extra import, and some internally used functions from `Options.Applicative.Common` are no longer exported from the main module. - Add Zsh and Fish completions with rich descriptions for options and commands. Use "--zsh-completion-script" and "fish-completion-script" to generate scripts for these shells. - Fix bash completions with quoted sections, tilde expansions and completions after "--". - Add suggestions to error message when a user mistypes a command or option. - Add `style` builder, for styling option descriptions. - Improve error message for options when a required argument is not supplied. - Fix #242 regarding flags with long options, where a flag given a long option could be interpreted incorrectly. - Fix `noIntersperse` to be more like its namesakes in other libraries. When on, options will be accepted until an argument is passed, after which all options will be treated as positional arguments. - Add `forwardOptions` builder, which will allow unknown options and flags to be passed to an argument builder. This is useful to mixed parsing environments, or wrappers to other commands. - Add `Semigroup` instances for `Completer` and `Chunk`. - Forwards compatibility with `MonadFail` proposal. - Doc ## Version 0.13.2.0 (9 Mar 2017) - Updated dependency bounds. - Doc ## Version 0.13.1.0 (10 Feb 2017) - Updated dependency bounds. - Add required test files to cabal package. - Doc ## Version 0.13.0.0 (15 Aug 2016) - Implement command groups, which allow subcommands to have their own usage description. - Implement showHelpOnEmpty, which is similar to showHelpOnError, but only fires when a command or subcommand is begun, and suppresses the "Missing:" error text. - Fix ghc 8.0 warnings - Fix ghc 7.10 warnings - Bump dependency bounds - Add maybeReader function for convenient ReadM creation - Move eitherReader to Readers section (for better discoverability) - Fix hsubparser metavar override - Remove ComplError, which was dead code. - Reimplement Missing error generation, which overly complicated evalParser. - Export Semigroup instances for types which are also Monoids. Removes mempty synonym `(<>)` export, as it clashes with Semigroup exports. One may need to import Data.Monoid or Data.Semigroup when upgrading. - Use a Cabal test suite for tests, simplify test dependencies. ## Version 0.12.1.0 (18 Jan 2016) - Updated dependency bounds. - Improve subparser contexts to improve usage error texts - Doc - Fixed bugs * \# 164 - Invalid options and invalid arguments after parser has succeeded not displaying * \# 146 - multi-word filename completion is broken ## Version 0.12.0.0 (17 Sep 2015) - Add "missing" error condition descriptions when required flags and arguments are not provided. - Allow multiple short flags to be concatenated together behind a single hyphen, e.g. "-xcf". - Updated dependency bounds on `process` and `ansi-wl-pprint`. - Add `Show` and `Eq` instances to some types for easier debugging. - Add defaultPrefs, a default preferences value - Docs. ## Version 0.11.0.2 (17 Feb 2015) - Updated dependency bounds. ## Version 0.11.0.1 (5 Oct 2014) - Updated documentation. ## Version 0.11.0 (4 Oct 2014) - Added Alternative instances for `Chunk` and `ReadM`. - The `ReadM` monad is now a `ReaderT` for the argument being parsed. User defined readers do not need to handle their argument explicitly, but can always access it using `readerAsk`. - Argument builders now take a `ReadM` parameter, just like options. - Fixed bugs * \#106 - argument should perhaps use `ReadM` ## Version 0.10.0 (1 Sep 2014) - Parser execution and help text generation are now more modular, and allow for greater customisation. - More consistent API for `option` and `argument` builders: now `option` takes a reader as argument, and `nullOption` is deprecated in favour of `option`. The `reader` modifier is gone. Quick migration guide: * `option` (without a `reader` modifier) => `option auto` * `nullOption` (without a `reader` modifier) => `option disabled` * `option`/`nullOption` (with a `reader r` modifier) => `option r`. - Added convenience builder `strArgument`, equivalent to `argument str`. - Removed functions deprecated from at least version 0.8.0. - Switched test infrastructure to `tasty`. - Fixed bugs * \#63 - Inconsistency between 'argument' and 'strOption' types ## Version 0.9.1.1 (31 Jul 2014) - Fixed bugs * \#97 - Version 0.9.1 fails test suite ## Version 0.9.1 (30 Jul 2014) - Documentation tweaks. - Added low-level function to handle parse results (pull request \#94). - `ParserResult` now has a `Show` instance (see issue \#95). - Fixed bugs * \#93 - Formatting problem for several sub-parsers ## Version 0.9.0 (23 May 2014) - The option returned by `abortOption` is now visible by default. ## Version 0.8.1 (5 May 2014) - Fixed bugs * \#74 - Missing newline ## Version 0.8.0.1 (19 Mar 2014) - Fixed bugs * \#73 - Release 0.8.0 is broken ## Version 0.8.0 (16 Mar 2014) - Help page formatting. Added `columns` preference modifier, which can be used to specify the number of columns in the output terminal. - Deprecated `arguments` and `arguments1` builders. Using `many` and `some` on a parser built using `argument` now returns a multiple argument parsers that behaves correctly with respect to `--`. - Fixed bugs * \#60 - runParser can't be called * \#64 - --help behaviour ## Version 0.7.0.2 (18 Oct 2013) - Fixed bugs * \#51 - Build fails with ghc 6.12.3 and ghc 7.0.4 ## Version 0.7.0.1 (18 Oct 2013) - Minor docs fixes ## Version 0.7.0 (17 Oct 2013) - Added builders for options that always fail. This makes it easier to create options that just print an error message or display some brief information and then exit (like `--version`). - Added `execParserMaybe` and `customExecParserMaybe` functions (pull request #49). - Fixed bugs * \#47 - Current master prints help text instead of error * \#48 - Can we have an eitherReader convenience function? * \#50 - In order parsing problems. * \#22 - Strict (no-intersperse) arguments ## Version 0.6.0 (11 Oct 2013) - Arguments are now always parsed in order. - Fixed bugs * \#40 - Add context information to error messages * \#41 - Readme uses old reader API * \#38 - Internal types leaking into public API * \#44 - Can the build input restriction process == 1.1.* be relaxed? * \#28 - Help for subcommands ## Version 0.5.2.1 (24 Dic 2012) - Minor docs fixes. ## Version 0.5.2 (23 Dic 2012) - Fixed compatibility with GHC 7.2. ## Version 0.5.1 (23 Dic 2012) - There is a new parser preference `noBacktrack`, that controls whether how a failure in a subparser is propagated. By default, an unknown option in a subparser causes the option to be looked up in parent parsers. When `noBacktrack` is used, this behavior is disabled. This is useful to implement subcommands that have no relations with their parent commands. - Fixed bugs * \#35 - Artifacts of "hidden" * \#31 - Backtracking on commands * \#25 - Allow for using Maybe in options types to specify optional arguments * \#34 - No simple/obvious way to add a --version switch * \#29 - Document Mod * \#26 - Improve docs for the `Arrow` interface ## Version 0.5.0 (22 Dic 2012) - Fewer GHC extensions required. - Improved error handling: unrecognized options now result in an error message. - By default, the full help text is not displayed on parse errors anymore. This behavior can be controlled with the `prefShowHelpOnError` field of `ParserPrefs`. - The `(&)` operator is now deprecated. Modifiers can still be combined using `(<>)` or `mappend`. - Fixed bugs * \#37 - Use (\<\>) instead of (&) in documentation ## Version 0.4.3 (09 Dic 2012) - Updated dependency bounds. ## Version 0.4.2 (26 Nov 2012) - Fixed bugs * \#27 - Please include the test source files in the cabal sdist tarball ## Version 0.4.1 (04 Sep 2012) - Fixed bugs * \#19 - Regression ## Version 0.4.0 (05 Aug 2012) - Brief help text for nested commands now shows the full command line. - Fixed inefficiency in the `arguments` parsers for long argument lists. - Added automatic [bash completion](https://github.com/pcapriotti/optparse-applicative/wiki/Bash-Completion). - Added `disambiguate` modifier for `prefs`, which enabled automatic disambiguation of option abbreviations. With disambiguation on, a command line like: foo --out will match an option called `--output`, as long as its the only one starting with the string `out`. - Added `briefDesc` modifier. - Fixed bugs * \#8 - Long options not disambiguated * \#10 - Shell completions * \#16 - Possible memory leak? ## Version 0.3.2 (31 Jul 2012) - Fixed bug where both branches of an alternative could be matched. - Improved brief help text for alternatives. ## Version 0.3.1 (30 Jul 2012) - Added new `showDefault` and `showDefaultWith` modifiers, which will result in the default value (if present) to be displayed in the help text. - Fixed bugs * \#12 - Optionally display default values in help ## Version 0.3.0 (30 Jul 2012) - Option modifiers are now instances of `Monoid` instead of `Category`. - Dropped dependencies on data-default and data-lens. - Fixed bugs * \#14 - "arguments" can no longer take a list as a default ## Version 0.2.0 (23 Jul 2012) - Parser is now an instance of Alternative. This makes it possible to build certain complex parsers that were not definable before. See `tests/Examples/Alternatives.hs` for a simple example. - Removed `multi` modifier. You can now use the `many` or `some` methods from `Alternative`, instead, to create parsers for options that can appear more than once. - Added new `flag'` builder that returns a flag without a default value. Although flags without default values were not useful before, with the addition of `Alternative` combinators, they do have valid use cases. - Added new `internal` modifier for options. An internal option is completely invisible in the help text. - Added a new `customExecParser` function, which takes an additional `ParserPrefs` parameter. At the moment, `ParserPrefs` can only be used to control how many-valued option metavars are displayed in the help text. Setting its `multiSuffix` field to e.g. `...` will result in an `arguments` parser description like `[METAVAR]...`. - Fixed bugs * \#6 - "arguments" swallows options * \#5 - Help formatting for "arguments" misleading ## Version 0.1.1 (21 Jul 2012) - New arrow interface - Fixed bugs * \#7 - "arguments" reads positional arguments in reverse ## Version 0.1.0 (07 Jul 2012) - Improved error reporting internals - Removed template-haskell dependency - Fixed bugs: * \#3 - No help for subparsers * \#4 - Extra empty lines around command list ## Version 0.0.1 (09 Jun 2012) - Initial release. optparse-applicative-0.14.3.0/README.md0000644000000000000000000010206413355265316015552 0ustar0000000000000000# optparse-applicative [![Continuous Integration status][status-png]][status] [![Hackage page (downloads and API reference)][hackage-png]][hackage] [![Hackage-Deps][hackage-deps-png]][hackage-deps] optparse-applicative is a haskell library for parsing options on the command line, providing a powerful [applicative] interface for composing these options. optparse-applicative takes care of reading and validating the arguments passed to the command line, handling and reporting errors, generating a usage line, a comprehensive help screen, and enabling context-sensitive bash, zsh, and fish completions. **Table of Contents** - [Introduction](#introduction) - [Quick Start](#quick-start) - [Basics](#basics) - [Parsers](#parsers) - [Applicative](#applicative) - [Alternative](#alternative) - [Running parsers](#running-parsers) - [Builders](#builders) - [Regular options](#regular-options) - [Flags](#flags) - [Arguments](#arguments) - [Commands](#commands) - [Modifiers](#modifiers) - [Custom parsing and error handling](#custom-parsing-and-error-handling) - [Parser runners](#parser-runners) - [Option readers](#option-readers) - [Preferences](#preferences) - [Disambiguation](#disambiguation) - [Customising the help screen](#customising-the-help-screen) - [Command Groups](#command-groups) - [Bash completion](#bash-zsh-and-fish-completions) - [Actions and completers](#actions-and-completers) - [Internals](#internals) - [Arrow interface](#arrow-interface) - [Applicative Do](#applicative-do) - [FAQ](#faq) - [How it works](#how-it-works) ## Introduction The core type in optparse-applicative is a `Parser` ```haskell data Parser a instance Functor Parser instance Applicative Parser instance Alternative Parser ``` A value of type `Parser a` represents a specification for a set of options, which will yield a value of type `a` when the command line arguments are successfully parsed. If you are familiar with parser combinator libraries like [parsec], [attoparsec], or the json parser [aeson] you will feel right at home with optparse-applicative. If not, don't worry! All you really need to learn are a few basic parsers, and how to compose them as instances of `Applicative` and `Alternative`. ## Quick Start Here's a simple example of a parser. ```haskell import Options.Applicative import Data.Semigroup ((<>)) data Sample = Sample { hello :: String , quiet :: Bool , enthusiasm :: Int } sample :: Parser Sample sample = Sample <$> strOption ( long "hello" <> metavar "TARGET" <> help "Target for the greeting" ) <*> switch ( long "quiet" <> short 'q' <> help "Whether to be quiet" ) <*> option auto ( long "enthusiasm" <> help "How enthusiastically to greet" <> showDefault <> value 1 <> metavar "INT" ) ``` The parser is built using an [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 a switch) and enthusiasm gets parsed as an `Int` with help of the `Read` type class. The parser can be used like this: ```haskell main :: IO () main = greet =<< execParser opts where opts = info (sample <**> helper) ( fullDesc <> progDesc "Print a greeting for TARGET" <> header "hello - a test for optparse-applicative" ) greet :: Sample -> IO () greet (Sample h False n) = putStrLn $ "Hello, " ++ h ++ replicate n '!' greet _ = return () ``` 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 an appropriate error message and a short option summary: Missing: --hello TARGET Usage: hello --hello TARGET [-q|--quiet] [--enthusiasm INT] Print a greeting for TARGET Running the program with the `--help` option will display the full help text containing a detailed list of options with descriptions ``` hello - a test for optparse-applicative Usage: hello --hello TARGET [-q|--quiet] [--enthusiasm INT] Print a greeting for TARGET Available options: --hello TARGET Target for the greeting -q,--quiet Whether to be quiet --enthusiasm INT How enthusiastically to greet (default: 1) -h,--help Show this help text ``` ## Basics ### Parsers optparse-applicative provides a number of primitive parsers, corresponding to different posix style options, through its *Builder* interface. These are detailed in their [own section](#builders) below, for now, here's a look at a few more examples to get a feel for how parsers can be defined. Here is a parser for a mandatory option with an argument: ```haskell target :: Parser String target = strOption ( long "hello" <> metavar "TARGET" <> help "Target for the greeting" ) ``` One can see that we are defining an option parser for a `String` argument, with *long* option name "hello", *metavariable* "TARGET", and the given help text. This means that the `target` parser defined above will require an option like --hello world on the command line. The metavariable and the help text will appear in the generated help text, but don't otherwise affect the behaviour of the parser. The attributes passed to the option are called *modifiers*, and are composed using the [semigroup] operation `(<>)`. Options with an argument such as `target` are referred to as *regular options*, and are very common. Another type of option is a *flag*, the simplest of which is a boolean *switch*, for example: ```haskell quiet :: Parser Bool quiet = switch ( long "quiet" <> short 'q' <> help "Whether to be quiet" ) ``` Here we used a `short` modifier to specify a one-letter name for the option. This means that this switch can be set either with `--quiet` or `-q`. Flags, unlike regular options, have no arguments. They simply return a predetermined value. For the simple switch above, this is `True` if the user types the flag, and `False` otherwise. There are other kinds of basic parsers, and several ways to configure them. These are covered in the [Builders](#builders) section. ### Applicative Now we may combine the `target` and `quiet` into a single parser that accepts both options and returns a combined value. Given a type ```haskell data Options = Options { optTarget :: String , optQuiet :: Bool } ``` and now it's just a matter of using `Applicative`'s apply operator `(<*>)` to combine the two previously defined parsers ```haskell opts :: Parser Options opts = Options <$> target <*> quiet ``` No matter which parsers appear first in the sequence, options will still be parsed in whatever order they appear in the command line. A parser with such a property is sometimes called a *permutation parser*. In our example, a command line like: --target world -q will give the same result as -q --target world It is this property which leads us to an Applicative interface instead of a Monadic one, as all options must be considered in parallel, and can not depend on the output of other options. Note, however, that the order of sequencing is still somewhat significant, in that it affects the generated help text. Customisation can be achieved easily through a lambda abstraction, with [Arrow notation](#arrow-interface), or by taking advantage of GHC 8's [ApplicativeDo](#applicative-do) extension. ### Alternative It is also common to find programs that can be configured in different ways through the command line. A typical example is a program that can be given a text file as input, or alternatively read it directly from the standard input. We can model this easily and effectively in Haskell using *sum types*: ```haskell data Input = FileInput FilePath | StdInput run :: Input -> IO () run = ... ``` We can now define two basic parsers for the components of the sum type: ```haskell fileInput :: Parser Input fileInput = FileInput <$> strOption ( long "file" <> short 'f' <> metavar "FILENAME" <> help "Input file" ) stdInput :: Parser Input stdInput = flag' StdInput ( long "stdin" <> help "Read from stdin" ) ``` As the `Parser` type constructor is an instance of `Alternative`, we can compose these parsers with a choice operator `(<|>)` ```haskell input :: Parser Input input = fileInput <|> stdInput ``` Now `--file "foo.txt"` will be parsed as `FileInput "foo.txt"`, `--stdin` will be parsed as `StdInput`, but a command line containing both options, like --file "foo.txt" --stdin will be rejected. Having `Applicative` and `Alternative` instances, optparse-applicative parsers are also able to be composed with standard combinators. For example: `optional :: Alternative f => f a -> f (Maybe a)` will mean the user is not required to provide input for the affected `Parser`. ### Running parsers Before we can run a `Parser`, we need to wrap it into a `ParserInfo` structure, that specifies a number of properties that only apply to top level parsers, such as a header describing what the program does, to be displayed in the help screen. The function `info` will help with this step. In the [Quick Start](#quick-start) we saw ```haskell opts :: ParserInfo Sample opts = info (sample <**> helper) ( fullDesc <> progDesc "Print a greeting for TARGET" <> header "hello - a test for optparse-applicative" ) ``` The `helper` parser that we added after `opts` just creates a dummy `--help` option that displays the help text. Besides that, we just set some of the fields of the `ParserInfo` structure with meaningful values. Now that we have a `ParserInfo`, we can finally run the parser. The simplest way to do so is to simply call the `execParser` function in your `main`: ```haskell main :: IO () main = do options <- execParser opts ... ``` The `execParser` function takes care of everything, including getting the arguments from the command line, displaying errors and help screens to the user, and exiting with an appropriate exit code. There are other ways to run a `ParserInfo`, in situations where you need finer control over the behaviour of your parser, or if you want to use it in pure code. They will be covered in [Custom parsing and error handling](#custom-parsing-and-error-handling). ## Builders Builders allow you to define parsers using a convenient combinator-based syntax. We have already seen examples of builders in action, like `strOption` and `switch`, which we used to define the `opts` parser for our "hello" example. Builders always take a [modifier](#modifiers) argument, which is essentially a composition of functions acting on the option, setting values for properties or adding features. Builders work by building the option from scratch, and eventually lifting it to a single-option parser, ready to be combined with other parsers using normal `Applicative` and `Alternative` combinators. See the [haddock documentation][hackage] for `Options.Applicative.Builder` for a full list of builders and modifiers. There are four different kinds of options in `optparse-applicative`: regular options, flags, arguments, and commands. In the following, we will go over each one of these and describe the builders that can be used to create them. ### 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" <> value "out.txt" <> 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), default value "out.txt", a long name "output" and a short name "o". A regular `option` can return an object of any type, and takes a *reader* parameter which specifies how the argument should be parsed. A common reader is `auto`, which requires a `Read` instance for the return type and uses it to parse its argument. For example: ```haskell lineCount :: Parser Int lineCount = option auto ( 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. Further information on *readers* is available [below](#option-readers). ### 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. This was demonstrated earlier for our `--stdin` flag example, and is usually used as one side of an alternative. Another interesting use for the `flag'` builder is to count the number of instances on the command line, for example, verbosity settings could be specified on a scale; the following parser will count the number of instances of `-v` on the command line. ```haskell length <$> many (flag' () (short 'v')) ``` Flags can be used together after a single hyphen, so `-vvv` and `-v -v -v` will both yield 3 for the above parser. ### 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. To accept an arbitrary number of arguments, combine the `argument` builder with either the `many` or `some` combinator: ```haskell some (argument str (metavar "FILES...")) ``` 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. Arguments use the same *readers* as regular options. ### 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 (or `hsubparser`, which is identical but for an additional `--help` option on each command), 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 { 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) ``` ### Modifiers *Modifiers* are instances of the `Semigroup` and `Monoid` typeclasses, so they can be combined using the composition function `mappend` (or simply `(<>)`). Since different builders accept different sets of modifiers, modifiers have a type parameter that specifies which builders support it. For example, ```haskell command :: String -> ParserInfo a -> Mod CommandFields a ``` can only be used with [commands](#commands), as the `CommandFields` type argument of `Mod` will prevent it from being passed to builders for other types of options. Many modifiers are polymorphic in this type argument, which means that they can be used with any builder. ## Custom parsing and error handling ### Parser runners Parsers are run with the `execParser` family of functions — from easiest to use to most flexible these are: ```haskell execParser :: ParserInfo a -> IO a customExecParser :: ParserPrefs -> ParserInfo a -> IO a execParserPure :: ParserPrefs -> ParserInfo a -> [String] -> ParserResult a ``` When using the `IO` functions, retrieving command line arguments and handling exit codes and failure will be done automatically. When using `execParserPure`, the functions ```haskell handleParseResult :: ParserResult a -> IO a overFailure :: (ParserHelp -> ParserHelp) -> ParserResult a -> ParserResult a ``` can be used to correctly set exit codes and display the help message; and modify the help message in the event of a failure (adding additional information for example). ### Option readers Options and Arguments require a way to interpret the string passed on the command line to the type desired. The `str` and `auto` *readers* are the most common way, but one can also create a custom reader that doesn't use the `Read` type class or return a `String`, and use it to parse the option. A custom reader is a value in the `ReadM` monad. We provide the `eitherReader :: (String -> Either String a) -> ReadM a` convenience function to help create these values, where a `Left` will hold the error message for a parse failure. ```haskell data FluxCapacitor = ... parseFluxCapacitor :: ReadM FluxCapacitor parseFluxCapacitor = eitherReader $ \s -> ... option parseFluxCapacitor ( long "flux-capacitor" ) ``` One can also use `ReadM` directly, using `readerAsk` to obtain the command line string, and `readerAbort` or `readerError` within the `ReadM` monad to exit with an error message. One nice property of `eitherReader` is how well it composes with [attoparsec] parsers with ```haskell import qualified Data.Attoparsec.Text as A attoReadM :: A.Parser a -> ReadM a attoReadM p = eitherReader (A.parseOnly p . T.pack) ``` ### Preferences `PrefsMod`s can be used to customise the look of the usage text and control when it is displayed; turn off backtracking of subparsers; and turn on [disambiguation](#disambiguation). To use these modifications, provide them to the `prefs` builder, and pass the resulting preferences to one of the parser runners that take an `ParserPrefs` parameter, like `customExecParser`. ### Disambiguation It is possible to configure optparse-applicative to perform automatic disambiguation of prefixes of long options. For example, given a program `foo` with options `--filename` and `--filler`, typing $ foo --fil test.txt fails, whereas typing $ foo --file test.txt succeeds, and correctly identifies `"file"` as an unambiguous prefix of the `filename` option. Option disambiguation is *off* by default. To enable it, use the `disambiguate` `PrefsMod` modifier as described above. Here is a minimal example: ```haskell import Options.Applicative sample :: Parser () sample = () <$ switch (long "filename") <* switch (long "filler") main :: IO () main = customExecParser p opts where opts = info (helper <*> sample) idm p = prefs disambiguate ``` ### Customising the help screen optparse-applicative has a number of combinators to help customise the usage text, and determine when it should be displayed. The `progDesc`, `header`, and `footer` functions can be used to specify a brief description or tagline for the program, and detailed information surrounding the generated option and command descriptions. Internally we actually use the [ansi-wl-pprint][ansi-wl-pprint] library, and one can use the `headerDoc` combinator and friends if additional customisation is required. To display the usage text, the user may type `--help` if the `helper` combinator has been applied to the `Parser`. Authors can also use the preferences `showHelpOnError` or `showHelpOnEmpty` to show the help text on any parser failure or when a command is not complete and at the beginning of the parse of the main program or one of its subcommands respectively. Even if the help text is not shown for an error, a specific error message will be, indicating what's missing, or what was unable to be parsed. ```haskell myParser :: Parser () myParser = ... main :: IO () main = customExecParser p opts where opts = info (myParser <**> helper) idm p = prefs showHelpOnEmpty ``` ### Command groups One experimental feature which may be useful for programs with many subcommands is command group separation. ```haskell data Sample = Hello [String] | Goodbye deriving (Eq, Show) hello :: Parser Sample hello = Hello <$> many (argument str (metavar "TARGET...")) sample :: Parser Sample sample = subparser ( command "hello" (info hello (progDesc "Print greeting")) <> command "goodbye" (info (pure Goodbye) (progDesc "Say goodbye")) ) <|> subparser ( command "bonjour" (info hello (progDesc "Print greeting")) <> command "au-revoir" (info (pure Goodbye) (progDesc "Say goodbye")) <> commandGroup "French commands:" <> hidden ) ``` This will logically separate the usage text for the two subparsers (these would normally appear together if the `commandGroup` modifier was not used). The `hidden` modifier suppresses the metavariable for the second subparser being show in the brief usage line, which is desirable in some cases. In this example we have essentially created synonyms for our parser, but one could use this to separate common commands from rare ones, or safe from dangerous. The usage text for the preceding example is: ``` Usage: commands COMMAND Available options: -h,--help Show this help text Available commands: hello Print greeting goodbye Say goodbye French commands: bonjour Print greeting au-revoir Say goodbye ``` ## Bash, Zsh, and Fish Completions `optparse-applicative` has built-in support for the completion of command line options and arguments in bash, zsh, and fish shells. Any parser, when run using the `execParser` family of functions, is automatically extended with a few (hidden) options for the completion system: - `--bash-completion-script`: this takes the full path of the program as argument, and prints a bash script, which, when sourced into a bash session, will install the necessary machinery to make bash completion work. For a quick test, you can run something like (for a program called `foo` on the `PATH`): ```console $ source <(foo --bash-completion-script `which foo`) ``` Normally, the output of `--bash-completion-script` should be shipped with the program and copied to the appropriate directory (usually `/etc/bash_completion.d/`) during installation; - `--zsh-completion-script`: which is analogous for zsh; - `--fish-completion-script`: which is analogous for fish shell; - `--bash-completion-index`, `--bash-completion-word`: internal options used by the completion script to obtain a list of possible completions for a given command line; - `--bash-completion-enriched`: a flag to tell the completion system to emit descriptions along with possible completions. This is used to provide help along with the completion for `zsh` and `fish`. ### Actions and completers By default, options and commands are always completed. So, for example, if the program `foo` has an option with a long name `output`, typing ```console $ foo --ou ``` will complete `--output` automatically. Arguments (either of regular options, or top-level) are not completed by default. To enable completion for arguments, use one of the following modifiers on a regular option or argument: - `completeWith`: specifies a list of possible completions to choose from; - `action`: specifies a completion "action". An action dynamically determines a list of possible completions. Common actions are "file" and "directory"; the full list of actions can be found in the [bash documentation]; - `completer`: a completer is a function `String -> IO [String]`, returning all possible completions for a given string. You can use this modifier to specify a custom completion for an argument. Completion modifiers can be used multiple times: the resulting completions will call all of them and join the results. ### Internals When running a parser with `execParser`, the parser is extended with `bashCompletionParser`, which defines the above options. When completion is triggered, the completion script calls the executable with the special `--bash-completion-index` and `--bash-completion-word` options. The original parser is therefore run in *completion mode*, i.e. `runParser` is called on a different monad, which keeps track of the current state of the parser, and exits when all arguments have been processed. The completion monad returns, on failure, either the last state of the parser (if no option could be matched), or the completer associated to an option (if it failed while fetching the argument for that option). From that we generate a list of possible completions, and print them to standard output. They are then read by the completion script and put into the `COMPREPLY` variable (or an appropriate alternative for the other shells). ## 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 auto (short 'v' <> value 0)) -< () let verbose = verbosity > 0 args <- asA (many (argument 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. ## Applicative do Some may find using optparse-applicative easier using do notation. However, as `Parser` is not an instance of `Monad`, this can only be done in recent versions of GHC using the *ApplicativeDo* extension. For example, a parser specified in this manner might be ```haskell {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ApplicativeDo #-} data Options = Options { optArgs :: [String] , optVerbose :: Bool } opts :: Parser Options opts = do optVerbose <- switch (short 'v') optArgs <- many (argument str idm) pure Options {..} ``` Here we've also used the *RecordWildCards* extension to make the parser specification cleaner. Compilation errors referring to `Monad` instances not being found are likely because the `Parser` specified can not be implemented entirely with `Applicative` (Note however, there were a few desugaring bugs regarding ApplicativeDo in GHC 8.0.1, function application with `($)` in particular may not work, and the `pure` value should instead be wrapped parenthetically). ## FAQ * Monadic parsing? If a Monadic style were to be used, there would be no possible way to traverse the parser and generate a usage string, or for us to allow for options to be parsed in any order. Therefore it is intentionally unsupported to write a `Parser` in this manner with optparse-applicative, and the `Parser` type does not have an instance for `Monad`. * Overlapping flags and options / options with optional arguments? This is not supported as it can lead to an ambiguous parse. For example, if we supported and had an optional value option "--foo" and a flag "--bar", is "--foo --bar" the option with value "--bar", or the default value with the flag switched on? What if instead of a switch we had many positional string arguments, is the first string the option's value or the first positional? It is suggested to instead use the `Alternative` instance of `Parser` and create a flag', an option, and a pure value for the default (with different names for the flag and option). * Backtracking on `ReadM` errors? Parser structures are predetermined at parse time. This means that if a `ReadM` fails, the whole parse must also fail, we can't consider any alternatives, as there can be no guarantee that the remaining structure will fit. One occasionally confusing side effect of this is that two positional arguments for different constructors of a sum type can't be composed at the parser level; rather, this must be done at the `ReadM` level. For example: ```haskell import Options.Applicative data S3orFile = S3 BucketKey | File FilePath s3Read, fileRead :: ReadM S3orFile s3Read = S3 <$> ... fileRead = File <$> ... correct :: Parser S3orFile correct = argument (s3Read <|> fileRead) idm incorrect :: Parser S3orFile incorrect = argument s3Read idm <|> argument fileRead idm ``` ## How it works An applicative `Parser` is essentially a heterogeneous list or tree 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. Indeed, when displaying the usage text for a parser, we use an intermediate tree structure. When we examine the user's input, each argument is examined to determine if it's an option or flag, or a positional argument. The parse tree is then searched for a matching term, and if it finds one, that leaf of the tree is replaced with the value itself. When all input has been processed, we see if we can generate the complete value, and if not issue an error. See [this blog post][blog] for a more detailed explanation based on a simplified implementation. [aeson]: http://hackage.haskell.org/package/aeson [applicative]: http://hackage.haskell.org/package/base/docs/Control-Applicative.html [arrows]: http://www.haskell.org/arrows/syntax.html [attoparsec]: http://hackage.haskell.org/package/attoparsec [bash documentation]: http://www.gnu.org/software/bash/manual/html_node/Programmable-Completion-Builtins.html [blog]: http://paolocapriotti.com/blog/2012/04/27/applicative-option-parser/ [hackage]: http://hackage.haskell.org/package/optparse-applicative [hackage-png]: http://img.shields.io/hackage/v/optparse-applicative.svg [hackage-deps]: http://packdeps.haskellers.com/reverse/optparse-applicative [hackage-deps-png]: https://img.shields.io/hackage-deps/v/optparse-applicative.svg [monoid]: http://hackage.haskell.org/package/base/docs/Data-Monoid.html [semigroup]: http://hackage.haskell.org/package/base/docs/Data-Semigroup.html [parsec]: http://hackage.haskell.org/package/parsec [status]: http://travis-ci.org/pcapriotti/optparse-applicative?branch=master [status-png]: https://api.travis-ci.org/pcapriotti/optparse-applicative.svg?branch=master [ansi-wl-pprint]: http://hackage.haskell.org/package/ansi-wl-pprint optparse-applicative-0.14.3.0/optparse-applicative.cabal0000644000000000000000000001032513355265316021411 0ustar0000000000000000name: optparse-applicative version: 0.14.3.0 synopsis: Utilities and combinators for parsing command line options description: optparse-applicative is a haskell library for parsing options on the command line, providing a powerful applicative interface for composing these options. . optparse-applicative takes care of reading and validating the arguments passed to the command line, handling and reporting errors, generating a usage line, a comprehensive help screen, and enabling context-sensitive bash completions. . See the included README for detailed instructions and examples, which is also available on github . license: BSD3 license-file: LICENSE author: Paolo Capriotti, Huw Campbell maintainer: huw.campbell@gmail.com copyright: (c) 2012-2017 Paolo Capriotti category: System, CLI, Options, Parsing build-type: Simple cabal-version: >= 1.8 extra-source-files: CHANGELOG.md README.md tests/alt.err.txt tests/cabal.err.txt tests/carry.err.txt tests/commands.err.txt tests/commands_header.err.txt tests/commands_header_full.err.txt tests/dropback.err.txt tests/hello.err.txt tests/helponempty.err.txt tests/helponemptysub.err.txt tests/formatting.err.txt tests/nested.err.txt tests/subparsers.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 ghc-options: -Wall -- See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0#base-4.9.0.0 if impl(ghc >= 8.0) ghc-options: -Wno-redundant-constraints -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances 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.Help.Chunk , Options.Applicative.Help.Core , Options.Applicative.Help.Levenshtein , Options.Applicative.Help.Pretty , Options.Applicative.Help.Types , Options.Applicative.Types , Options.Applicative.Internal build-depends: base == 4.* , transformers >= 0.2 && < 0.6 , transformers-compat >= 0.3 && < 0.7 , process >= 1.0 && < 1.7 , ansi-wl-pprint >= 0.6.6 && < 0.7 if !impl(ghc >= 8) build-depends: semigroups >= 0.10 && < 0.19 , fail == 4.9.* test-suite optparse-applicative-tests type: exitcode-stdio-1.0 main-is: test.hs ghc-options: -Wall -threaded -O2 -funbox-strict-fields hs-source-dirs: tests other-modules: Examples.Alternatives , Examples.Cabal , Examples.Commands , Examples.Formatting , Examples.Hello build-depends: base , bytestring == 0.10.* , optparse-applicative , QuickCheck >= 2.8 && < 2.13 if !impl(ghc >= 8) build-depends: semigroups optparse-applicative-0.14.3.0/Options/0000755000000000000000000000000013355265316015723 5ustar0000000000000000optparse-applicative-0.14.3.0/Options/Applicative.hs0000644000000000000000000001343113355265316020522 0ustar0000000000000000module Options.Applicative ( -- * Applicative option parsers -- -- | This module exports all one should need for defining and using -- optparse-applicative command line option parsers. -- -- See for a tutorial, -- and a general introduction to applicative option parsers. -- -- See the sections below for more detail -- * Exported modules -- -- | The standard @Applicative@ module is re-exported here for convenience. module Control.Applicative, -- * Option Parsers -- -- | A 'Parser' is the core type in optparse-applicative. A value of type -- @Parser a@ represents a specification for a set of options, which will -- yield a value of type a when the command line arguments are successfully -- parsed. -- -- There are several types of primitive 'Parser'. -- -- * 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. -- -- See the "Parser Builders" section for how to construct and customise -- these parsers. Parser, -- ** Parser builders -- -- | This section 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 here 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\". flag, flag', switch, strOption, option, strArgument, argument, subparser, hsubparser, abortOption, infoOption, helper, -- ** Modifiers -- -- | 'Parser' builders take a modifier, which represents a modification of the -- properties of an option, and can be composed as a monoid. -- -- Contraints are often used to ensure that the modifiers can be sensibly applied. -- For example, positional arguments can't be specified by long or short names, -- so the 'HasName' constraint is used to ensure we have a flag or option. Mod, short, long, help, helpDoc, value, showDefaultWith, showDefault, metavar, noArgError, hidden, internal, style, command, commandGroup, completeWith, action, completer, idm, mappend, OptionFields, FlagFields, ArgumentFields, CommandFields, HasName, HasCompleter, HasValue, HasMetavar, -- ** Readers -- -- | A reader is used by the 'option' and 'argument' builders to parse -- the data passed by the user on the command line into a data type. -- -- The most common are 'str' which is used for 'String' like types, -- including 'ByteString' and 'Text'; and 'auto', which uses the 'Read' -- typeclass, and is good for simple types like 'Int' or 'Double'. -- -- More complex types can use the 'eitherReader' or 'maybeReader' -- functions to pattern match or use a more expressive parser like a -- member of the 'Parsec' family. ReadM, auto, str, maybeReader, eitherReader, disabled, readerAbort, readerError, -- * Program descriptions -- -- ** 'ParserInfo' -- -- | 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 'ParserInfo' should be created with the 'info' function and a set of -- 'InfoMod' modifiers. -- info, ParserInfo(..), InfoMod, fullDesc, briefDesc, header, headerDoc, footer, footerDoc, progDesc, progDescDoc, failureCode, noIntersperse, forwardOptions, -- * Running parsers -- -- | The execParser family of functions are used to run parsers execParser, customExecParser, execParserPure, -- ** Handling parser results manually getParseResult, handleParseResult, parserFailure, renderFailure, overFailure, -- ** 'ParserPrefs' -- -- | A 'ParserPrefs' contains general preferences for all command-line -- options, and should be built with the 'prefs' function. prefs, ParserPrefs(..), PrefsMod, multiSuffix, disambiguate, showHelpOnError, showHelpOnEmpty, noBacktrack, columns, defaultPrefs, -- * Completions -- -- | optparse-applicative supplies a rich completion system for bash, -- zsh, and fish shells. -- -- 'Completer' functions are used for option and argument to complete -- their values. -- -- Use the 'completer' builder to use these. -- The 'action' and 'completeWith' builders are also provided for -- convenience, to use 'bashCompleter' and 'listCompleter' as a 'Mod'. Completer, mkCompleter, listIOCompleter, listCompleter, bashCompleter, -- * Types ParseError(..), ParserHelp(..), ParserFailure(..), ParserResult(..), CompletionResult(..) ) 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 import Options.Applicative.Types {-# ANN module "HLint: ignore Use import/export shortcut" #-} optparse-applicative-0.14.3.0/Options/Applicative/0000755000000000000000000000000013355265316020164 5ustar0000000000000000optparse-applicative-0.14.3.0/Options/Applicative/Common.hs0000644000000000000000000002456613355265316021765 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. -- -- A 'ParserPrefs' contains general preferences for all command-line -- options, and can be built with the 'prefs' function. ParserInfo(..), ParserPrefs(..), -- * Running parsers runParserInfo, runParserFully, runParser, evalParser, -- * Low-level utilities mapParser, treeMapParser, optionNames ) where import Control.Applicative import Control.Monad (guard, mzero, msum, when, liftM) 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 Prelude 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 argMatches :: MonadP m => OptReader a -> String -> Maybe (StateT Args m a) argMatches opt arg = case opt of ArgReader rdr -> Just . lift $ runReadM (crReader rdr) arg CmdReader _ _ f -> flip fmap (f arg) $ \subp -> StateT $ \args -> do prefs <- getPrefs let runSubparser | prefBacktrack prefs = \i a -> runParser (infoPolicy i) CmdStart (infoParser i) a | otherwise = \i a -> (,) <$> runParserInfo i a <*> pure [] enterContext arg subp *> runSubparser subp args <* exitContext _ -> 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 = missingArgP (no_arg_err $ showOption arg1) (crCompleter rdr) (arg', args') <- maybe (lift missing_arg) return mb_args put args' lift $ runReadM (withReadM (errorFor arg1) (crReader rdr)) arg' FlagReader names x -> do guard $ has_name arg1 names -- #242 Flags/switches succeed incorrectly when given an argument. -- We'll not match a long option for a flag if there's a word attached. -- This was revealing an implementation detail as -- `--foo=val` was being parsed as `--foo -val`, which is gibberish. guard $ is_short arg1 || isNothing val Just $ do args <- get let val' = (\s -> '-' : s) <$> val put $ maybeToList val' ++ args return x _ -> Nothing where errorFor name msg = "option " ++ showOption name ++ ": " ++ msg is_short (OptShort _) = True is_short (OptLong _) = False 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) = msum [ do p' <- searchParser f p return $ BindP p' k , case evalParser p of Nothing -> mzero Just aa -> searchParser f (k aa) ] 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 stepParser :: MonadP m => ParserPrefs -> ArgPolicy -> String -> Parser a -> NondetT (StateT Args m) (Parser a) stepParser _ AllPositionals arg p = searchArg arg p stepParser pprefs ForwardOptions arg p = case parseWord arg of Just w -> searchOpt pprefs w p <|> searchArg arg p Nothing -> searchArg arg p stepParser pprefs _ arg p = case parseWord arg of Just w -> searchOpt pprefs w p Nothing -> searchArg arg 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 -> IsCmdStart -> Parser a -> Args -> m (a, Args) runParser policy _ p ("--" : argt) | policy /= AllPositionals = runParser AllPositionals CmdCont p argt runParser policy isCmdStart p args = case args of [] -> exitP isCmdStart policy p result (arg : argt) -> do prefs <- getPrefs (mp', args') <- do_step prefs arg argt case mp' of Nothing -> hoistMaybe result <|> parseError arg p Just p' -> runParser (newPolicy arg) CmdCont p' args' where result = (,) <$> evalParser p <*> pure args do_step prefs arg argt = (`runStateT` argt) . disamb (not (prefDisambiguate prefs)) $ stepParser prefs policy arg p newPolicy a = case policy of NoIntersperse -> if isJust (parseWord a) then NoIntersperse else AllPositionals x -> x parseError :: MonadP m => String -> Parser x -> m a parseError arg = errorP . UnexpectedError arg . SomeParser runParserInfo :: MonadP m => ParserInfo a -> Args -> m a runParserInfo i = runParserFully (infoPolicy i) (infoParser i) runParserFully :: MonadP m => ArgPolicy -> Parser a -> Args -> m a runParserFully policy p args = do (r, args') <- runParser policy CmdStart p args case args' of [] -> return r a:_ -> parseError a (pure ()) -- | 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 False g where has_default :: Parser a -> Bool has_default p = isJust (evalParser p) go :: Bool -> Bool -> Bool -> (forall x . OptHelpInfo -> Option x -> b) -> Parser a -> OptTree b go _ _ _ _ (NilP _) = MultNode [] go m d r f (OptP opt) | optVisibility opt > Internal = Leaf (f (OptHelpInfo m d r) opt) | otherwise = MultNode [] go m d r f (MultP p1 p2) = MultNode [go m d r f p1, go m d r' f p2] where r' = r || hasArg p1 go m d r f (AltP p1 p2) = AltNode [go m d' r f p1, go m d' r f p2] where d' = d || has_default p1 || has_default p2 go _ d r f (BindP p k) = let go' = go True d r f p in case evalParser p of Nothing -> go' Just aa -> MultNode [ go', go True d r f (k aa) ] hasArg :: Parser a -> Bool hasArg (NilP _) = False hasArg (OptP p) = (isArg . optMain) p hasArg (MultP p1 p2) = hasArg p1 || hasArg p2 hasArg (AltP p1 p2) = hasArg p1 || hasArg p2 hasArg (BindP p _) = hasArg 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.14.3.0/Options/Applicative/Builder.hs0000644000000000000000000003705713355265316022122 0ustar0000000000000000module Options.Applicative.Builder ( -- * Parser builders -- -- | This module contains utility functions and combinators to create parsers -- for individual options. -- -- Each parser builder takes an option modifier. A modifier can be created by -- composing the basic modifiers provided by this module using the 'Monoid' -- operations 'mempty' and 'mappend', or their aliases 'idm' and '<>'. -- -- For example: -- -- > out = strOption -- > ( long "output" -- > <> short 'o' -- > <> metavar "FILENAME" ) -- -- creates a parser for an option called \"output\". subparser, strArgument, argument, flag, flag', switch, abortOption, infoOption, strOption, option, nullOption, -- * Modifiers short, long, help, helpDoc, value, showDefaultWith, showDefault, metavar, noArgError, ParseError(..), hidden, internal, style, command, commandGroup, completeWith, action, completer, idm, mappend, -- * Readers -- -- | A collection of basic 'Option' readers. auto, str, maybeReader, eitherReader, disabled, readerAbort, readerError, -- * Builder for 'ParserInfo' InfoMod, fullDesc, briefDesc, header, headerDoc, footer, footerDoc, progDesc, progDescDoc, failureCode, noIntersperse, forwardOptions, info, -- * Builder for 'ParserPrefs' PrefsMod, multiSuffix, disambiguate, showHelpOnError, showHelpOnEmpty, noBacktrack, columns, prefs, defaultPrefs, -- * Types Mod, ReadM, OptionFields, FlagFields, ArgumentFields, CommandFields, HasName, HasCompleter, HasValue, HasMetavar ) where import Control.Applicative import Data.Semigroup hiding (option) import Data.String (fromString, IsString) import Options.Applicative.Builder.Completer import Options.Applicative.Builder.Internal import Options.Applicative.Common import Options.Applicative.Types import Options.Applicative.Help.Pretty import Options.Applicative.Help.Chunk -- Readers -- -- | 'Option' reader based on the 'Read' type class. auto :: Read a => ReadM a auto = eitherReader $ \arg -> case reads arg of [(r, "")] -> return r _ -> Left $ "cannot parse value `" ++ arg ++ "'" -- | String 'Option' reader. -- -- Polymorphic over the `IsString` type class since 0.14. str :: IsString s => ReadM s str = fromString <$> readerAsk -- | Convert a function producing an 'Either' into a reader. -- -- As an example, one can create a ReadM from an attoparsec Parser -- easily with -- -- > import qualified Data.Attoparsec.Text as A -- > import qualified Data.Text as T -- > attoparsecReader :: A.Parser a -> ReadM a -- > attoparsecReader p = eitherReader (A.parseOnly p . T.pack) eitherReader :: (String -> Either String a) -> ReadM a eitherReader f = readerAsk >>= either readerError return . f -- | Convert a function producing a 'Maybe' into a reader. maybeReader :: (String -> Maybe a) -> ReadM a maybeReader f = do arg <- readerAsk maybe (readerError $ "cannot parse value `" ++ arg ++ "'") return . f $ arg -- | Null 'Option' reader. All arguments will fail validation. disabled :: ReadM a disabled = readerError "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. -- -- /Note/: Because this modifier means the parser will never fail, -- do not use it with combinators such as 'some' or 'many', as -- these combinators continue until a failure occurs. -- Careless use will thus result in a hang. -- -- To display the default value, combine with showDefault or -- showDefaultWith. value :: HasValue f => a -> Mod f a value 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 = paragraph s } -- | Specify the help text for an option as a 'Text.PrettyPrint.ANSI.Leijen.Doc' -- value. helpDoc :: Maybe Doc -> Mod f a helpDoc doc = optionMod $ \p -> p { propHelp = Chunk doc } -- | Specify the error to display when no argument is provided to this option. noArgError :: ParseError -> Mod OptionFields a noArgError e = fieldMod $ \p -> p { optNoArgError = const e } -- | Specify a metavariable for the argument. -- -- Metavariables have no effect on the actual parser, and only serve to specify -- the symbolic name for an argument to be displayed in the help text. metavar :: HasMetavar f => String -> Mod f a metavar 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) } -- | Apply a function to the option description in the usage text. -- -- > import Options.Applicative.Help -- > flag' () (short 't' <> style bold) -- -- /NOTE/: This builder is more flexible than its name and example -- allude. One of the motivating examples for its addition was to -- used `const` to completely replace the usage text of an option. style :: ( Doc -> Doc ) -> Mod f a style x = optionMod $ \p -> p { propDescMod = Just x } -- | Add a command to a subparser option. -- -- Suggested usage for multiple commands is to add them to a single subparser. e.g. -- -- @ -- sample :: Parser Sample -- sample = subparser -- ( command "hello" -- (info hello (progDesc "Print greeting")) -- <> command "goodbye" -- (info goodbye (progDesc "Say goodbye")) -- ) -- @ command :: String -> ParserInfo a -> Mod CommandFields a command cmd pinfo = fieldMod $ \p -> p { cmdCommands = (cmd, pinfo) : cmdCommands p } -- | Add a description to a group of commands. -- -- Advanced feature for separating logical groups of commands on the parse line. -- -- If using the same `metavar` for each group of commands, it may yield a more -- attractive usage text combined with `hidden` for some groups. commandGroup :: String -> Mod CommandFields a commandGroup g = fieldMod $ \p -> p { cmdGroup = Just g } -- | Add a list of possible completion values. completeWith :: HasCompleter f => [String] -> Mod f a completeWith = completer . listCompleter -- | Add a bash completion action. Common actions include @file@ and -- @directory@. See -- -- for a complete list. action :: HasCompleter f => String -> Mod f a action = completer . bashCompleter -- | Add a completer to an argument. -- -- A completer is a function String -> IO String which, given a partial -- argument, returns all possible completions for that argument. completer :: HasCompleter f => Completer -> Mod f a completer 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 = metavar "COMMAND" `mappend` m (groupName, cmds, subs) = mkCommand m rdr = CmdReader groupName cmds subs -- | Builder for an argument parser. argument :: ReadM 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 a 'String' argument. strArgument :: IsString s => Mod ArgumentFields s -> Parser s strArgument = argument str -- | Builder for a flag parser. -- -- A flag that switches from a \"default value\" to an \"active value\" when -- encountered. For a simple boolean value, use `switch` instead. -- -- /Note/: Because this parser will never fail, it can not be used with -- combinators such as 'some' or 'many', as these combinators continue until -- a failure occurs. See @flag'@. flag :: a -- ^ default value -> a -- ^ active value -> Mod FlagFields a -- ^ option modifier -> Parser a flag 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, -- alternatively -- -- > flag' True (long "on") <|> flag' False (long "off") -- -- will require the user to enter '--on' or '--off' on the command line. flag' :: a -- ^ active value -> Mod FlagFields a -- ^ option modifier -> Parser a flag' 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. -- -- /Note/: Because this parser will never fail, it can not be used with -- combinators such as 'some' or 'many', as these combinators continue until -- a failure occurs. See @flag'@. -- -- > switch = flag False True switch :: Mod FlagFields Bool -> Parser Bool switch = flag False True -- | An option that always fails. -- -- When this option is encountered, the option parser immediately aborts with -- the given parse error. If you simply want to output a message, use -- 'infoOption' instead. abortOption :: ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a) abortOption err m = option (readerAbort err) . (`mappend` m) $ mconcat [ noArgError err , value id , metavar "" ] -- | 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 :: IsString s => Mod OptionFields s -> Parser s strOption = option str -- | Same as 'option'. {-# DEPRECATED nullOption "Use 'option' instead" #-} nullOption :: ReadM a -> Mod OptionFields a -> Parser a nullOption = option -- | Builder for an option using the given reader. -- -- This is a regular option, and should always have either a @long@ or -- @short@ name specified in the modifiers (or both). -- -- > nameParser = option str ( long "name" <> short 'n' ) -- option :: ReadM a -> Mod OptionFields a -> Parser a option r m = mkParser d g rdr where Mod f d g = metavar "ARG" `mappend` m fields = f (OptionFields [] mempty ExpectsArgError) crdr = CReader (optCompleter fields) r rdr = OptReader (optNames fields) crdr (optNoArgError fields) -- | Modifier for 'ParserInfo'. newtype InfoMod a = InfoMod { applyInfoMod :: ParserInfo a -> ParserInfo a } instance Monoid (InfoMod a) where mempty = InfoMod id mappend = (<>) instance Semigroup (InfoMod a) where 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 = paragraph s } -- | Specify a header for this parser as a 'Text.PrettyPrint.ANSI.Leijen.Doc' -- value. headerDoc :: Maybe Doc -> InfoMod a headerDoc doc = InfoMod $ \i -> i { infoHeader = Chunk doc } -- | Specify a footer for this parser. footer :: String -> InfoMod a footer s = InfoMod $ \i -> i { infoFooter = paragraph s } -- | Specify a footer for this parser as a 'Text.PrettyPrint.ANSI.Leijen.Doc' -- value. footerDoc :: Maybe Doc -> InfoMod a footerDoc doc = InfoMod $ \i -> i { infoFooter = Chunk doc } -- | Specify a short program description. progDesc :: String -> InfoMod a progDesc s = InfoMod $ \i -> i { infoProgDesc = paragraph s } -- | Specify a short program description as a 'Text.PrettyPrint.ANSI.Leijen.Doc' -- value. progDescDoc :: Maybe Doc -> InfoMod a progDescDoc doc = InfoMod $ \i -> i { infoProgDesc = Chunk doc } -- | Specify an exit code if a parse error occurs. failureCode :: Int -> InfoMod a failureCode n = InfoMod $ \i -> i { infoFailureCode = n } -- | Disable parsing of regular options after arguments. After a positional -- argument is parsed, all remaining options and arguments will be treated -- as a positional arguments. Not recommended in general as users often -- expect to be able to freely intersperse regular options and flags within -- command line options. noIntersperse :: InfoMod a noIntersperse = InfoMod $ \p -> p { infoPolicy = NoIntersperse } -- | Intersperse matched options and arguments normally, but allow unmatched -- options to be treated as positional arguments. -- This is sometimes useful if one is wrapping a third party cli tool and -- needs to pass options through, while also providing a handful of their -- own options. Not recommended in general as typos by the user may not -- yield a parse error and cause confusion. forwardOptions :: InfoMod a forwardOptions = InfoMod $ \p -> p { infoPolicy = ForwardOptions } -- | 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 = mempty , infoHeader = mempty , infoFooter = mempty , infoFailureCode = 1 , infoPolicy = Intersperse } newtype PrefsMod = PrefsMod { applyPrefsMod :: ParserPrefs -> ParserPrefs } instance Monoid PrefsMod where mempty = PrefsMod id mappend = (<>) instance Semigroup PrefsMod where m1 <> m2 = PrefsMod $ applyPrefsMod m2 . applyPrefsMod m1 -- | Include a suffix to attach to the metavar when multiple values -- can be entered. multiSuffix :: String -> PrefsMod multiSuffix s = PrefsMod $ \p -> p { prefMultiSuffix = s } -- | Turn on disambiguation. -- -- See -- https://github.com/pcapriotti/optparse-applicative#disambiguation disambiguate :: PrefsMod disambiguate = PrefsMod $ \p -> p { prefDisambiguate = True } -- | Show full help text on any error. showHelpOnError :: PrefsMod showHelpOnError = PrefsMod $ \p -> p { prefShowHelpOnError = True } -- | Show the help text if the user enters only the program name or -- subcommand. -- -- This will suppress a "Missing:" error and show the full usage -- instead if a user just types the name of the program. showHelpOnEmpty :: PrefsMod showHelpOnEmpty = PrefsMod $ \p -> p { prefShowHelpOnEmpty = True } -- | Turn off backtracking after subcommand is parsed. noBacktrack :: PrefsMod noBacktrack = PrefsMod $ \p -> p { prefBacktrack = False } -- | Set the maximum width of the generated help text. columns :: Int -> PrefsMod columns cols = PrefsMod $ \p -> p { prefColumns = cols } -- | Create a `ParserPrefs` given a modifier prefs :: PrefsMod -> ParserPrefs prefs m = applyPrefsMod m base where base = ParserPrefs { prefMultiSuffix = "" , prefDisambiguate = False , prefShowHelpOnError = False , prefShowHelpOnEmpty = False , prefBacktrack = True , prefColumns = 80 } -- Convenience shortcuts -- | Trivial option modifier. idm :: Monoid m => m idm = mempty -- | Default preferences. defaultPrefs :: ParserPrefs defaultPrefs = prefs idm optparse-applicative-0.14.3.0/Options/Applicative/BashCompletion.hs0000644000000000000000000002062613355265316023435 0ustar0000000000000000-- | You don't need to import this module to enable bash completion. -- -- See -- -- for more information on bash completion. module Options.Applicative.BashCompletion ( bashCompletionParser ) where import Control.Applicative import Prelude import Data.Foldable ( asum ) import Data.List ( isPrefixOf ) import Data.Maybe ( fromMaybe, listToMaybe ) import Options.Applicative.Builder import Options.Applicative.Common import Options.Applicative.Internal import Options.Applicative.Types import Options.Applicative.Help.Pretty import Options.Applicative.Help.Chunk -- | Provide basic or rich command completions data Richness = Standard -- ^ Add no help descriptions to the completions | Enriched Int Int -- ^ Include tab separated description for options -- and commands when available. -- Takes option description length and command -- description length. deriving (Eq, Ord, Show) bashCompletionParser :: ParserInfo a -> ParserPrefs -> Parser CompletionResult bashCompletionParser pinfo pprefs = complParser where failure opts = CompletionResult { execCompletion = \progn -> unlines <$> opts progn } complParser = asum [ failure <$> ( bashCompletionQuery pinfo pprefs -- To get rich completions, one just needs the first -- command. To customise the lengths, use either of -- the `desc-length` options. -- zsh commands can go on a single line, so they might -- want to be longer. <$> ( flag' Enriched (long "bash-completion-enriched" `mappend` internal) <*> option auto (long "bash-completion-option-desc-length" `mappend` internal `mappend` value 40) <*> option auto (long "bash-completion-command-desc-length" `mappend` internal `mappend` value 40) <|> pure Standard ) <*> (many . strOption) (long "bash-completion-word" `mappend` internal) <*> option auto (long "bash-completion-index" `mappend` internal) ) , failure <$> (bashCompletionScript <$> strOption (long "bash-completion-script" `mappend` internal)) , failure <$> (fishCompletionScript <$> strOption (long "fish-completion-script" `mappend` internal)) , failure <$> (zshCompletionScript <$> strOption (long "zsh-completion-script" `mappend` internal)) ] bashCompletionQuery :: ParserInfo a -> ParserPrefs -> Richness -> [String] -> Int -> String -> IO [String] bashCompletionQuery pinfo pprefs richness ws i _ = case runCompletion compl pprefs of Just (Left (SomeParser p, a)) -> list_options a p Just (Right c) -> run_completer c Nothing -> return [] where compl = runParserInfo pinfo (drop 1 ws') list_options a = fmap concat . sequence . mapParser (opt_completions a) -- -- Prior to 0.14 there was a subtle bug which would -- mean that completions from positional arguments -- further into the parse would be shown. -- -- We therefore now check to see that -- hinfoUnreachableArgs is off before running the -- completion for position arguments. -- -- For options and flags, ensure that the user -- hasn't disabled them with `--`. opt_completions argPolicy hinfo opt = case optMain opt of OptReader ns _ _ | argPolicy /= AllPositionals -> return . add_opt_help opt $ show_names ns | otherwise -> return [] FlagReader ns _ | argPolicy /= AllPositionals -> return . add_opt_help opt $ show_names ns | otherwise -> return [] ArgReader rdr | hinfoUnreachableArgs hinfo -> return [] | otherwise -> run_completer (crCompleter rdr) CmdReader _ ns p | hinfoUnreachableArgs hinfo -> return [] | otherwise -> return . add_cmd_help p $ filter_names ns -- When doing enriched completions, add any help specified -- to the completion variables (tab separated). add_opt_help :: Functor f => Option a -> f String -> f String add_opt_help opt = case richness of Standard -> id Enriched len _ -> fmap (\o -> let h = unChunk $ optHelp opt in maybe o (\h' -> o ++ "\t" ++ render_line len h') h) -- When doing enriched completions, add the command description -- to the completion variables (tab separated). add_cmd_help :: Functor f => (String -> Maybe (ParserInfo a)) -> f String -> f String add_cmd_help p = case richness of Standard -> id Enriched _ len -> fmap (\cmd -> let h = p cmd >>= unChunk . infoProgDesc in maybe cmd (\h' -> cmd ++ "\t" ++ render_line len h') h) show_names :: [OptName] -> [String] show_names = filter_names . map showOption -- We only want to show a single line in the completion results description. -- If there was a line break, it would come across as a different completion -- possibility. render_line :: Int -> Doc -> String render_line len doc = case lines (displayS (renderPretty 1 len doc) "") of [] -> "" [x] -> x x : _ -> x ++ "..." filter_names :: [String] -> [String] filter_names = filter is_completion run_completer :: Completer -> IO [String] run_completer c = runCompleter c (fromMaybe "" (listToMaybe ws'')) (ws', ws'') = splitAt i ws is_completion :: String -> Bool is_completion = case ws'' of w:_ -> isPrefixOf w _ -> const True bashCompletionScript :: String -> String -> IO [String] bashCompletionScript prog progn = return [ "_" ++ progn ++ "()" , "{" , " local CMDLINE" , " local IFS=$'\\n'" , " 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 ] {- /Note/: Fish Shell Derived from Drezil's post in #169. @ commandline -c or --cut-at-cursor only print selection up until the current cursor position -o or --tokenize tokenize the selection and print one string-type token per line @ We tokenize so that the call to count (and hence --bash-completion-index) gets the right number use cut-at-curstor to not bother sending anything after the cursor position, which allows for completion of the middle of words. Tab characters separate items from descriptions. -} fishCompletionScript :: String -> String -> IO [String] fishCompletionScript prog progn = return [ " function _" ++ progn , " set -l cl (commandline --tokenize --current-process)" , " # Hack around fish issue #3934" , " set -l cn (commandline --tokenize --cut-at-cursor --current-process)" , " set -l cn (count $cn)" , " set -l tmpline --bash-completion-enriched --bash-completion-index $cn" , " for arg in $cl" , " set tmpline $tmpline --bash-completion-word $arg" , " end" , " for opt in (" ++ prog ++ " $tmpline)" , " if test -d $opt" , " echo -E \"$opt/\"" , " else" , " echo -E \"$opt\"" , " end" , " end" , "end" , "" , "complete --no-files --command " ++ progn ++ " --arguments '(_" ++ progn ++ ")'" ] zshCompletionScript :: String -> String -> IO [String] zshCompletionScript prog progn = return [ "#compdef " ++ progn , "" , "local request" , "local completions" , "local word" , "local index=$((CURRENT - 1))" , "" , "request=(--bash-completion-enriched --bash-completion-index $index)" , "for arg in ${words[@]}; do" , " request=(${request[@]} --bash-completion-word $arg)" , "done" , "" , "IFS=$'\\n' completions=($( " ++ prog ++ " \"${request[@]}\" ))" , "" , "for word in $completions; do" , " local -a parts" , "" , " # Split the line at a tab if there is one." , " IFS=$'\\t' parts=($( echo $word ))" , "" , " if [[ -n $parts[2] ]]; then" , " if [[ $word[1] == \"-\" ]]; then" , " local desc=(\"$parts[1] ($parts[2])\")" , " compadd -d desc -- $parts[1]" , " else" , " local desc=($(print -f \"%-019s -- %s\" $parts[1] $parts[2]))" , " compadd -l -d desc -- $parts[1]" , " fi" , " else" , " compadd -f -- $word" , " fi" , "done" ] optparse-applicative-0.14.3.0/Options/Applicative/Help.hs0000644000000000000000000000155513355265316021416 0ustar0000000000000000module Options.Applicative.Help ( -- | This is an empty module which re-exports -- the help text system for optparse. -- | Pretty printer. Reexports most combinators -- from Text.PrettyPrint.ANSI.Leijen module Options.Applicative.Help.Pretty, -- | A free monoid over Doc with helpers for -- composing help text components. module Options.Applicative.Help.Chunk, -- | Types required by the help system. module Options.Applicative.Help.Types, -- | Core implementation of the help text -- generator. module Options.Applicative.Help.Core, -- | Edit distance calculations for suggestions module Options.Applicative.Help.Levenshtein ) where import Options.Applicative.Help.Chunk import Options.Applicative.Help.Core import Options.Applicative.Help.Levenshtein import Options.Applicative.Help.Pretty import Options.Applicative.Help.Types optparse-applicative-0.14.3.0/Options/Applicative/Arrows.hs0000644000000000000000000000462513355265316022004 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.14.3.0/Options/Applicative/Internal.hs0000644000000000000000000001544313355265316022303 0ustar0000000000000000module Options.Applicative.Internal ( P , MonadP(..) , ParseError(..) , uncons , hoistMaybe , hoistEither , runReadM , withReadM , runP , Completion , runCompletion , contextNames , ListT , takeListT , runListT , NondetT , cut , () , disamb ) where import Control.Applicative import Prelude import Control.Monad (MonadPlus(..), liftM, ap, guard) import Control.Monad.Trans.Class (MonadTrans, lift) import Control.Monad.Trans.Except (runExcept, runExceptT, withExcept, ExceptT(..), throwE) import Control.Monad.Trans.Reader (mapReaderT, runReader, runReaderT, Reader, ReaderT, ask) import Control.Monad.Trans.State (StateT, get, put, modify, evalStateT, runStateT) import Options.Applicative.Types class (Alternative m, MonadPlus m) => MonadP m where enterContext :: String -> ParserInfo a -> m () exitContext :: m () getPrefs :: m ParserPrefs missingArgP :: ParseError -> Completer -> m a errorP :: ParseError -> m a exitP :: IsCmdStart -> ArgPolicy -> Parser b -> Maybe a -> m a newtype P a = P (ExceptT ParseError (StateT [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 = pure 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 contextNames :: [Context] -> [String] contextNames ns = let go (Context n _) = n in reverse $ go <$> ns instance MonadP P where enterContext name pinfo = P $ lift $ modify $ (:) $ Context name pinfo exitContext = P $ lift $ modify $ drop 1 getPrefs = P . lift . lift $ ask missingArgP e _ = errorP e exitP i _ p = P . maybe (throwE . MissingError i . SomeParser $ p) return errorP = P . throwE 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 . flip runStateT [] . runExceptT $ p uncons :: [a] -> Maybe (a, [a]) uncons [] = Nothing uncons (x : xs) = Just (x, xs) runReadM :: MonadP m => ReadM a -> String -> m a runReadM (ReadM r) s = hoistEither . runExcept $ runReaderT r s withReadM :: (String -> String) -> ReadM a -> ReadM a withReadM f = ReadM . mapReaderT (withExcept f') . unReadM where f' (ErrorMsg err) = ErrorMsg (f err) f' e = e data ComplResult a = ComplParser SomeParser ArgPolicy | 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 a -> ComplParser p a ComplOption c -> ComplOption c newtype Completion a = Completion (ExceptT 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 = pure 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 enterContext _ _ = return () exitContext = return () getPrefs = Completion $ lift ask missingArgP _ = Completion . lift . lift . ComplOption exitP _ a p _ = Completion . lift . lift $ ComplParser (SomeParser p) a errorP = Completion . throwE runCompletion :: Completion r -> ParserPrefs -> Maybe (Either (SomeParser, ArgPolicy) Completer) runCompletion (Completion c) prefs = case runReaderT (runExceptT c) prefs of ComplResult _ -> Nothing ComplParser p' a' -> Just $ Left (p', a') 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.14.3.0/Options/Applicative/Extra.hs0000644000000000000000000002347613355265316021617 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, getParseResult, handleParseResult, parserFailure, renderFailure, ParserFailure(..), overFailure, ParserResult(..), ParserPrefs(..), CompletionResult(..), ) where import Control.Applicative import Data.Monoid import Prelude import System.Environment (getArgs, getProgName) import System.Exit (exitSuccess, exitWith, ExitCode(..)) import System.IO (hPutStrLn, stderr) import Options.Applicative.BashCompletion import Options.Applicative.Builder import Options.Applicative.Builder.Internal import Options.Applicative.Common import Options.Applicative.Help import Options.Applicative.Internal import Options.Applicative.Types -- | A hidden \"helper\" option which always fails. -- -- A common usage pattern is to apply this applicatively when -- creating a 'ParserInfo' -- -- > opts :: ParserInfo Sample -- > opts = info (sample <**> helper) mempty helper :: Parser (a -> a) helper = abortOption ShowHelpText $ mconcat [ long "help" , short 'h' , help "Show this help text" , hidden ] -- | Builder for a command parser with a \"helper\" option attached. -- Used in the same way as `subparser`, but includes a \"--help|-h\" inside -- the subcommand. hsubparser :: Mod CommandFields a -> Parser a hsubparser m = mkParser d g rdr where Mod _ d g = metavar "COMMAND" `mappend` m (groupName, cmds, subs) = mkCommand m rdr = CmdReader groupName 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 defaultPrefs -- | Run a program description with custom preferences. customExecParser :: ParserPrefs -> ParserInfo a -> IO a customExecParser pprefs pinfo = execParserPure pprefs pinfo <$> getArgs >>= handleParseResult -- | Handle `ParserResult`. handleParseResult :: ParserResult a -> IO a handleParseResult (Success a) = return a handleParseResult (Failure failure) = do progn <- getProgName let (msg, exit) = renderFailure failure progn case exit of ExitSuccess -> putStrLn msg _ -> hPutStrLn stderr msg exitWith exit handleParseResult (CompletionInvoked compl) = do progn <- getProgName msg <- execCompletion compl progn putStr msg exitSuccess -- | Extract the actual result from a `ParserResult` value. -- -- This function returns 'Nothing' in case of errors. Possible error messages -- or completion actions are simply discarded. -- -- If you want to display error messages and invoke completion actions -- appropriately, use 'handleParseResult' instead. getParseResult :: ParserResult a -> Maybe a getParseResult (Success a) = Just a getParseResult _ = Nothing -- | 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. {-# DEPRECATED execParserMaybe "Use execParserPure together with getParseResult instead" #-} execParserMaybe :: ParserInfo a -> [String] -> Maybe a execParserMaybe = customExecParserMaybe defaultPrefs -- | Run a program description with custom preferences in pure code. -- -- See 'execParserMaybe' for details. {-# DEPRECATED customExecParserMaybe "Use execParserPure together with getParseResult instead" #-} customExecParserMaybe :: ParserPrefs -> ParserInfo a -> [String] -> Maybe a customExecParserMaybe pprefs pinfo args = getParseResult $ execParserPure pprefs pinfo args -- | 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 -> ParserResult a execParserPure pprefs pinfo args = case runP p pprefs of (Right (Right r), _) -> Success r (Right (Left c), _) -> CompletionInvoked c (Left err, ctx) -> Failure $ parserFailure pprefs pinfo err ctx where pinfo' = pinfo { infoParser = (Left <$> bashCompletionParser pinfo pprefs) <|> (Right <$> infoParser pinfo) } p = runParserInfo pinfo' args -- | Generate a `ParserFailure` from a `ParseError` in a given `Context`. -- -- This function can be used, for example, to show the help text for a parser: -- -- @handleParseResult . Failure $ parserFailure pprefs pinfo ShowHelpText mempty@ parserFailure :: ParserPrefs -> ParserInfo a -> ParseError -> [Context] -> ParserFailure ParserHelp parserFailure pprefs pinfo msg ctx = ParserFailure $ \progn -> let h = with_context ctx pinfo $ \names pinfo' -> mconcat [ base_help pinfo' , usage_help progn names pinfo' , suggestion_help , error_help ] in (h, exit_code, prefColumns pprefs) where exit_code = case msg of ErrorMsg {} -> ExitFailure (infoFailureCode pinfo) UnknownError -> ExitFailure (infoFailureCode pinfo) MissingError {} -> ExitFailure (infoFailureCode pinfo) ExpectsArgError {} -> ExitFailure (infoFailureCode pinfo) UnexpectedError {} -> ExitFailure (infoFailureCode pinfo) ShowHelpText -> ExitSuccess InfoMsg {} -> ExitSuccess with_context :: [Context] -> ParserInfo a -> (forall b . [String] -> ParserInfo b -> c) -> c with_context [] i f = f [] i with_context c@(Context _ i:_) _ f = f (contextNames c) i usage_help progn names i = case msg of InfoMsg _ -> mempty _ -> usageHelp $ vcatChunks [ pure . parserUsage pprefs (infoParser i) . unwords $ progn : names , fmap (indent 2) . infoProgDesc $ i ] error_help = errorHelp $ case msg of ShowHelpText -> mempty ErrorMsg m -> stringChunk m InfoMsg m -> stringChunk m MissingError CmdStart _ | prefShowHelpOnEmpty pprefs -> mempty MissingError _ (SomeParser x) -> stringChunk "Missing:" <<+>> missingDesc pprefs x ExpectsArgError x -> stringChunk $ "The option `" ++ x ++ "` expects an argument." UnexpectedError arg _ -> stringChunk msg' where -- -- This gives us the same error we have always -- reported msg' = case arg of ('-':_) -> "Invalid option `" ++ arg ++ "'" _ -> "Invalid argument `" ++ arg ++ "'" UnknownError -> mempty suggestion_help = suggestionsHelp $ case msg of UnexpectedError arg (SomeParser x) -- -- We have an unexpected argument and the parser which -- it's running over. -- -- We can make a good help suggestion here if we do -- a levenstein distance between all possible suggestions -- and the supplied option or argument. -> suggestions where -- -- Not using chunked here, as we don't want to -- show "Did you mean" if there's nothing there -- to show suggestions = (.$.) <$> prose <*> (indent 4 <$> (vcatChunks . fmap stringChunk $ good )) -- -- We won't worry about the 0 case, it won't be -- shown anyway. prose = if length good < 2 then stringChunk "Did you mean this?" else stringChunk "Did you mean one of these?" -- -- Suggestions we will show, they're close enough -- to what the user wrote good = filter isClose possibles -- -- Bit of an arbitrary decision here. -- Edit distances of 1 or 2 will give hints isClose a = editDistance a arg < 3 -- -- Similar to how bash completion works. -- We map over the parser and get the names -- ( no IO here though, unlike for completers ) possibles = concat $ mapParser opt_completions x -- -- Look at the option and give back the possible -- things the user could type. If it's a command -- reader also ensure that it can be immediately -- reachable from where the error was given. opt_completions hinfo opt = case optMain opt of OptReader ns _ _ -> fmap showOption ns FlagReader ns _ -> fmap showOption ns ArgReader _ -> [] CmdReader _ ns _ | hinfoUnreachableArgs hinfo -> [] | otherwise -> ns _ -> mempty base_help :: ParserInfo a -> ParserHelp base_help i | show_full_help = mconcat [h, f, parserHelp pprefs (infoParser i)] | otherwise = mempty where h = headerHelp (infoHeader i) f = footerHelp (infoFooter i) show_full_help = case msg of ShowHelpText -> True MissingError CmdStart _ | prefShowHelpOnEmpty pprefs -> True _ -> prefShowHelpOnError pprefs renderFailure :: ParserFailure ParserHelp -> String -> (String, ExitCode) renderFailure failure progn = let (h, exit, cols) = execFailure failure progn in (renderHelp cols h, exit) optparse-applicative-0.14.3.0/Options/Applicative/Types.hs0000644000000000000000000002760313355265316021634 0ustar0000000000000000{-# LANGUAGE Rank2Types, ExistentialQuantification #-} module Options.Applicative.Types ( ParseError(..), ParserInfo(..), ParserPrefs(..), Option(..), OptName(..), OptReader(..), OptProperties(..), OptVisibility(..), ReadM(..), readerAsk, readerAbort, readerError, CReader(..), Parser(..), ParserM(..), Completer(..), mkCompleter, CompletionResult(..), ParserFailure(..), ParserResult(..), overFailure, Args, ArgPolicy(..), OptHelpInfo(..), OptTree(..), ParserHelp(..), SomeParser(..), Context(..), IsCmdStart(..), fromM, oneM, manyM, someM, optVisibility, optMetaVar, optHelp, optShowDefault, optDescMod ) where import Control.Applicative import Control.Monad (ap, liftM, MonadPlus, mzero, mplus) import Control.Monad.Trans.Except (Except, throwE) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Reader (ReaderT, ask) import qualified Control.Monad.Fail as Fail import Data.Semigroup hiding (Option) import Prelude import System.Exit (ExitCode(..)) import Options.Applicative.Help.Types import Options.Applicative.Help.Pretty import Options.Applicative.Help.Chunk data ParseError = ErrorMsg String | InfoMsg String | ShowHelpText | UnknownError | MissingError IsCmdStart SomeParser | ExpectsArgError String | UnexpectedError String SomeParser data IsCmdStart = CmdStart | CmdCont deriving Show instance Monoid ParseError where mempty = UnknownError mappend = (<>) instance Semigroup ParseError where m <> UnknownError = m _ <> m = m -- | 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 :: Chunk Doc -- ^ brief parser description , infoHeader :: Chunk Doc -- ^ header of the full parser description , infoFooter :: Chunk Doc -- ^ footer of the full parser description , infoFailureCode :: Int -- ^ exit code for a parser failure , infoPolicy :: ArgPolicy -- ^ allow regular options and flags to occur -- after arguments (default: InterspersePolicy) } 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) , prefShowHelpOnEmpty :: Bool -- ^ show the help text for a command or subcommand -- if it fails with no input (default: False) , prefBacktrack :: Bool -- ^ backtrack to parent parser when a -- subcommand fails (default: True) , prefColumns :: Int -- ^ number of columns in the terminal, used to -- format the help page (default: 80) } deriving (Eq, Show) data OptName = OptShort !Char | OptLong !String deriving (Eq, Ord, Show) -- | 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, Show) -- | Specification for an individual parser option. data OptProperties = OptProperties { propVisibility :: OptVisibility -- ^ whether this flag is shown is the brief description , propHelp :: Chunk Doc -- ^ help text for this option , propMetaVar :: String -- ^ metavariable for this option , propShowDefault :: Maybe String -- ^ what to show in the help text as the default , propDescMod :: Maybe ( Doc -> Doc ) -- ^ a function to run over the brief description } instance Show OptProperties where showsPrec p (OptProperties pV pH pMV pSD _) = showParen (p >= 11) $ showString "OptProperties { propVisibility = " . shows pV . showString ", propHelp = " . shows pH . showString ", propMetaVar = " . shows pMV . showString ", propShowDefault = " . shows pSD . showString ", propDescMod = _ }" -- | A single option of a parser. data Option a = Option { optMain :: OptReader a -- ^ reader for this option , optProps :: OptProperties -- ^ properties of this option } data SomeParser = forall a . SomeParser (Parser a) -- | Subparser context, containing the 'name' of the subparser, and its parser info. -- Used by parserFailure to display relevant usage information when parsing inside a subparser fails. data Context = forall a . Context String (ParserInfo a) instance Show (Option a) where show opt = "Option {optProps = " ++ show (optProps opt) ++ "}" instance Functor Option where fmap f (Option m p) = Option (fmap f m) p -- | A newtype over 'ReaderT String Except', used by option readers. newtype ReadM a = ReadM { unReadM :: ReaderT String (Except ParseError) a } instance Functor ReadM where fmap f (ReadM r) = ReadM (fmap f r) instance Applicative ReadM where pure = ReadM . pure ReadM x <*> ReadM y = ReadM $ x <*> y instance Alternative ReadM where empty = mzero (<|>) = mplus instance Monad ReadM where return = pure ReadM r >>= f = ReadM $ r >>= unReadM . f fail = Fail.fail instance Fail.MonadFail ReadM where fail = readerError instance MonadPlus ReadM where mzero = ReadM mzero mplus (ReadM x) (ReadM y) = ReadM $ mplus x y -- | Return the value being read. readerAsk :: ReadM String readerAsk = ReadM ask -- | Abort option reader by exiting with a 'ParseError'. readerAbort :: ParseError -> ReadM a readerAbort = ReadM . lift . throwE -- | Abort option reader by exiting with an error message. readerError :: String -> ReadM a readerError = readerAbort . ErrorMsg data CReader a = CReader { crCompleter :: Completer , crReader :: ReadM a } instance Functor CReader where fmap f (CReader c r) = CReader c (fmap f r) -- | An 'OptReader' defines whether an option matches an command line argument. data OptReader a = OptReader [OptName] (CReader a) (String -> ParseError) -- ^ option reader | FlagReader [OptName] !a -- ^ flag reader | ArgReader (CReader a) -- ^ argument reader | CmdReader (Maybe String) [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 n cs g) = CmdReader n cs ((fmap . fmap) f . g) -- | A @Parser a@ is an option parser returning a value of type 'a'. data Parser a = NilP (Maybe a) | OptP (Option a) | forall x . MultP (Parser (x -> a)) (Parser x) | AltP (Parser a) (Parser a) | forall x . BindP (Parser x) (x -> Parser a) 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 = pure ParserM f >>= g = ParserM $ \k -> f (\x -> runParserM (g x) k) instance Functor ParserM where fmap = liftM instance Applicative ParserM where pure x = ParserM $ \k -> k x (<*>) = 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 -- | A shell complete function. newtype Completer = Completer { runCompleter :: String -> IO [String] } -- | Smart constructor for a 'Completer' mkCompleter :: (String -> IO [String]) -> Completer mkCompleter = Completer instance Semigroup Completer where (Completer c1) <> (Completer c2) = Completer $ \s -> (++) <$> c1 s <*> c2 s instance Monoid Completer where mempty = Completer $ \_ -> return [] mappend = (<>) newtype CompletionResult = CompletionResult { execCompletion :: String -> IO String } instance Show CompletionResult where showsPrec p _ = showParen (p > 10) $ showString "CompletionResult _" newtype ParserFailure h = ParserFailure { execFailure :: String -> (h, ExitCode, Int) } instance Show h => Show (ParserFailure h) where showsPrec p (ParserFailure f) = showParen (p > 10) $ showString "ParserFailure " . showsPrec 11 (f "") instance Functor ParserFailure where fmap f (ParserFailure err) = ParserFailure $ \progn -> let (h, exit, cols) = err progn in (f h, exit, cols) -- | Result of 'execParserPure'. data ParserResult a = Success a | Failure (ParserFailure ParserHelp) | CompletionInvoked CompletionResult deriving Show instance Functor ParserResult where fmap f (Success a) = Success (f a) fmap _ (Failure f) = Failure f fmap _ (CompletionInvoked c) = CompletionInvoked c overFailure :: (ParserHelp -> ParserHelp) -> ParserResult a -> ParserResult a overFailure f (Failure failure) = Failure $ fmap f failure overFailure _ r = r instance Applicative ParserResult where pure = Success Success f <*> r = fmap f r Failure f <*> _ = Failure f CompletionInvoked c <*> _ = CompletionInvoked c instance Monad ParserResult where return = pure Success x >>= f = f x Failure f >>= _ = Failure f CompletionInvoked c >>= _ = CompletionInvoked c type Args = [String] -- | Policy for how to handle options within the parse data ArgPolicy = Intersperse -- ^ The default policy, options and arguments can -- be interspersed. -- A `--` option can be passed to ensure all following -- commands are treated as arguments. | NoIntersperse -- ^ Options must all come before arguments, once a -- single positional argument or subcommand is parsed, -- all remaining arguments are treated as positionals. -- A `--` option can be passed if the first positional -- one needs starts with `-`. | AllPositionals -- ^ No options are parsed at all, all arguments are -- treated as positionals. -- Is the policy used after `--` is encountered. | ForwardOptions -- ^ Options and arguments can be interspersed, but if -- a given option is not found, it is treated as a -- positional argument. This is sometimes useful if -- one is passing through most options to another tool, -- but are supplying just a few of their own options. deriving (Eq, Ord, Show) data OptHelpInfo = OptHelpInfo { hinfoMulti :: Bool -- ^ Whether this is part of a many or some (approximately) , hinfoDefault :: Bool -- ^ Whether this option has a default value , hinfoUnreachableArgs :: Bool -- ^ If the result is a positional, if it can't be -- accessed in the current parser position ( first arg ) } deriving (Eq, Show) data OptTree a = Leaf a | MultNode [OptTree a] | AltNode [OptTree a] deriving Show optVisibility :: Option a -> OptVisibility optVisibility = propVisibility . optProps optHelp :: Option a -> Chunk Doc optHelp = propHelp . optProps optMetaVar :: Option a -> String optMetaVar = propMetaVar . optProps optShowDefault :: Option a -> Maybe String optShowDefault = propShowDefault . optProps optDescMod :: Option a -> Maybe ( Doc -> Doc ) optDescMod = propDescMod . optProps optparse-applicative-0.14.3.0/Options/Applicative/Builder/0000755000000000000000000000000013355265316021552 5ustar0000000000000000optparse-applicative-0.14.3.0/Options/Applicative/Builder/Internal.hs0000644000000000000000000001154413355265316023667 0ustar0000000000000000module Options.Applicative.Builder.Internal ( -- * Internals Mod(..), HasName(..), HasCompleter(..), HasValue(..), HasMetavar(..), OptionFields(..), FlagFields(..), CommandFields(..), ArgumentFields(..), DefaultProp(..), optionMod, fieldMod, baseProps, mkCommand, mkParser, mkOption, mkProps, internal ) where import Control.Applicative import Control.Monad (mplus) import Data.Semigroup hiding (Option) import Prelude import Options.Applicative.Common import Options.Applicative.Types data OptionFields a = OptionFields { optNames :: [OptName] , optCompleter :: Completer , optNoArgError :: String -> ParseError } data FlagFields a = FlagFields { flagNames :: [OptName] , flagActive :: a } data CommandFields a = CommandFields { cmdCommands :: [(String, ParserInfo a)] , cmdGroup :: Maybe String } 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) } class HasValue f where -- this is just so that it is not necessary to specify the kind of f hasValueDummy :: f a -> () instance HasValue OptionFields where hasValueDummy _ = () instance HasValue ArgumentFields where hasValueDummy _ = () class HasMetavar f where hasMetavarDummy :: f a -> () instance HasMetavar OptionFields where hasMetavarDummy _ = () instance HasMetavar ArgumentFields where hasMetavarDummy _ = () instance HasMetavar CommandFields where hasMetavarDummy _ = () -- mod -- data DefaultProp a = DefaultProp (Maybe a) (Maybe (a -> String)) instance Monoid (DefaultProp a) where mempty = DefaultProp Nothing Nothing mappend = (<>) instance Semigroup (DefaultProp a) where (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. -- -- One rarely needs to deal with modifiers directly, as most of the times it is -- sufficient to pass them to builders (such as 'strOption' or 'flag') to -- create options (see '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 mappend = (<>) -- | @since 0.13.0.0 instance Semigroup (Mod f a) where Mod f1 d1 g1 <> Mod f2 d2 g2 = Mod (f2 . f1) (d2 <> d1) (g2 . g1) -- | Base default properties. baseProps :: OptProperties baseProps = OptProperties { propMetaVar = "" , propVisibility = Visible , propHelp = mempty , propShowDefault = Nothing , propDescMod = Nothing } mkCommand :: Mod CommandFields a -> (Maybe String, [String], String -> Maybe (ParserInfo a)) mkCommand m = (group, map fst cmds, (`lookup` cmds)) where Mod f _ _ = m CommandFields cmds group = f (CommandFields [] Nothing) 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.14.3.0/Options/Applicative/Builder/Completer.hs0000644000000000000000000000710313355265316024041 0ustar0000000000000000module Options.Applicative.Builder.Completer ( Completer , mkCompleter , listIOCompleter , listCompleter , bashCompleter ) where import Control.Applicative import Prelude import Control.Exception (IOException, try) import Data.List (isPrefixOf) import System.Process (readProcess) import Options.Applicative.Types -- | Create a 'Completer' from an IO action listIOCompleter :: IO [String] -> Completer listIOCompleter ss = Completer $ \s -> filter (isPrefixOf s) <$> ss -- | Create a 'Completer' from a constant -- list of strings. listCompleter :: [String] -> Completer listCompleter = listIOCompleter . pure -- | Run a compgen completion action. -- -- Common actions include @file@ and -- @directory@. See -- -- for a complete list. bashCompleter :: String -> Completer bashCompleter action = Completer $ \word -> do let cmd = unwords ["compgen", "-A", action, "--", requote word] result <- tryIO $ readProcess "bash" ["-c", cmd] "" return . lines . either (const []) id $ result tryIO :: IO a -> IO (Either IOException a) tryIO = try -- | Strongly quote the string we pass to compgen. -- -- We need to do this so bash doesn't expand out any ~ or other -- chars we want to complete on, or emit an end of line error -- when seeking the close to the quote. requote :: String -> String requote s = let -- Bash doesn't appear to allow "mixed" escaping -- in bash completions. So we don't have to really -- worry about people swapping between strong and -- weak quotes. unescaped = case s of -- It's already strongly quoted, so we -- can use it mostly as is, but we must -- ensure it's closed off at the end and -- there's no single quotes in the -- middle which might confuse bash. ('\'': rs) -> unescapeN rs -- We're weakly quoted. ('"': rs) -> unescapeD rs -- We're not quoted at all. -- We need to unescape some characters like -- spaces and quotation marks. elsewise -> unescapeU elsewise in strong unescaped where strong ss = '\'' : foldr go "'" ss where -- If there's a single quote inside the -- command: exit from the strong quote and -- emit it the quote escaped, then resume. go '\'' t = "'\\''" ++ t go h t = h : t -- Unescape a strongly quoted string -- We have two recursive functions, as we -- can enter and exit the strong escaping. unescapeN = goX where goX ('\'' : xs) = goN xs goX (x : xs) = x : goX xs goX [] = [] goN ('\\' : '\'' : xs) = '\'' : goN xs goN ('\'' : xs) = goX xs goN (x : xs) = x : goN xs goN [] = [] -- Unescape an unquoted string unescapeU = goX where goX [] = [] goX ('\\' : x : xs) = x : goX xs goX (x : xs) = x : goX xs -- Unescape a weakly quoted string unescapeD = goX where -- Reached an escape character goX ('\\' : x : xs) -- If it's true escapable, strip the -- slashes, as we're going to strong -- escape instead. | x `elem` "$`\"\\\n" = x : goX xs | otherwise = '\\' : x : goX xs -- We've ended quoted section, so we -- don't recurse on goX, it's done. goX ('"' : xs) = xs -- Not done, but not a special character -- just continue the fold. goX (x : xs) = x : goX xs goX [] = [] optparse-applicative-0.14.3.0/Options/Applicative/Help/0000755000000000000000000000000013355265316021054 5ustar0000000000000000optparse-applicative-0.14.3.0/Options/Applicative/Help/Levenshtein.hs0000644000000000000000000000401513355265316023674 0ustar0000000000000000module Options.Applicative.Help.Levenshtein ( editDistance ) where -- | Calculate the Damerau-Levenshtein edit distance -- between two lists (strings). -- -- This is modified from -- https://wiki.haskell.org/Edit_distance -- and is originally from Lloyd Allison's paper -- "Lazy Dynamic-Programming can be Eager" -- -- It's been changed though from Levenshtein to -- Damerau-Levenshtein, which treats transposition -- of adjacent characters as one change instead of -- two. editDistance :: Eq a => [a] -> [a] -> Int editDistance a b = last $ case () of _ | lab == 0 -> mainDiag | lab > 0 -> lowers !! (lab - 1) | otherwise -> uppers !! (-1 - lab) where mainDiag = oneDiag a b (head uppers) (-1 : head lowers) uppers = eachDiag a b (mainDiag : uppers) -- upper diagonals lowers = eachDiag b a (mainDiag : lowers) -- lower diagonals eachDiag _ [] _ = [] eachDiag _ _ [] = [] eachDiag a' (_:bs) (lastDiag:diags) = oneDiag a' bs nextDiag lastDiag : eachDiag a' bs diags where nextDiag = head (tail diags) oneDiag a' b' diagAbove diagBelow = thisdiag where doDiag [] _ _ _ _ = [] doDiag _ [] _ _ _ = [] -- Check for a transposition -- We don't add anything to nw here, the next character -- will be different however and the transposition -- will have an edit distance of 1. doDiag (ach:ach':as) (bch:bch':bs) nw n w | ach' == bch && ach == bch' = nw : (doDiag (ach' : as) (bch' : bs) nw (tail n) (tail w)) -- Standard case doDiag (ach:as) (bch:bs) nw n w = me : (doDiag as bs me (tail n) (tail w)) where me = if ach == bch then nw else 1 + min3 (head w) nw (head n) firstelt = 1 + head diagBelow thisdiag = firstelt : doDiag a' b' firstelt diagAbove (tail diagBelow) lab = length a - length b min3 x y z = if x < y then x else min y z optparse-applicative-0.14.3.0/Options/Applicative/Help/Pretty.hs0000644000000000000000000000040713355265316022700 0ustar0000000000000000module Options.Applicative.Help.Pretty ( module Text.PrettyPrint.ANSI.Leijen , (.$.) ) where import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>), columns) import qualified Text.PrettyPrint.ANSI.Leijen as PP (.$.) :: Doc -> Doc -> Doc (.$.) = (PP.<$>) optparse-applicative-0.14.3.0/Options/Applicative/Help/Chunk.hs0000644000000000000000000001001013355265316022450 0ustar0000000000000000module Options.Applicative.Help.Chunk ( mappendWith , Chunk(..) , chunked , listToChunk , (<<+>>) , (<>) , vcatChunks , vsepChunks , isEmpty , stringChunk , paragraph , extractChunk , tabulate ) where import Control.Applicative import Control.Monad import Data.Maybe import Data.Semigroup import Prelude import Options.Applicative.Help.Pretty mappendWith :: Monoid a => a -> a -> a -> a mappendWith s x y = mconcat [x, s, y] -- | The free monoid on a semigroup 'a'. newtype Chunk a = Chunk { unChunk :: Maybe a } deriving (Eq, Show) instance Functor Chunk where fmap f = Chunk . fmap f . unChunk instance Applicative Chunk where pure = Chunk . pure Chunk f <*> Chunk x = Chunk (f <*> x) instance Alternative Chunk where empty = Chunk Control.Applicative.empty a <|> b = Chunk $ unChunk a <|> unChunk b instance Monad Chunk where return = pure m >>= f = Chunk $ unChunk m >>= unChunk . f instance Monoid a => Semigroup (Chunk a) where (<>) = chunked mappend instance Monoid a => Monoid (Chunk a) where mempty = Chunk Nothing mappend = (<>) instance MonadPlus Chunk where mzero = Chunk mzero mplus m1 m2 = Chunk $ mplus (unChunk m1) (unChunk m2) -- | Given a semigroup structure on 'a', return a monoid structure on 'Chunk a'. -- -- Note that this is /not/ the same as 'liftA2'. chunked :: (a -> a -> a) -> Chunk a -> Chunk a -> Chunk a chunked _ (Chunk Nothing) y = y chunked _ x (Chunk Nothing) = x chunked f (Chunk (Just x)) (Chunk (Just y)) = Chunk (Just (f x y)) -- | Concatenate a list into a Chunk. 'listToChunk' satisfies: -- -- > isEmpty . listToChunk = null -- > listToChunk = mconcat . fmap pure listToChunk :: Monoid a => [a] -> Chunk a listToChunk [] = mempty listToChunk xs = pure (mconcat xs) -- | Part of a constrained comonad instance. -- -- This is the counit of the adjunction between 'Chunk' and the forgetful -- functor from monoids to semigroups. It satisfies: -- -- > extractChunk . pure = id -- > extractChunk . fmap pure = id extractChunk :: Monoid a => Chunk a -> a extractChunk = fromMaybe mempty . unChunk -- we could also define: -- duplicate :: Monoid a => Chunk a -> Chunk (Chunk a) -- duplicate = fmap pure -- | Concatenate two 'Chunk's with a space in between. If one is empty, this -- just returns the other one. -- -- Unlike '<+>' for 'Doc', this operation has a unit element, namely the empty -- 'Chunk'. (<<+>>) :: Chunk Doc -> Chunk Doc -> Chunk Doc (<<+>>) = chunked (<+>) -- | Concatenate two 'Chunk's with a softline in between. This is exactly like -- '<<+>>', but uses a softline instead of a space. (<>) :: Chunk Doc -> Chunk Doc -> Chunk Doc (<>) = chunked () -- | Concatenate 'Chunk's vertically. vcatChunks :: [Chunk Doc] -> Chunk Doc vcatChunks = foldr (chunked (.$.)) mempty -- | Concatenate 'Chunk's vertically separated by empty lines. vsepChunks :: [Chunk Doc] -> Chunk Doc vsepChunks = foldr (chunked (\x y -> x .$. mempty .$. y)) mempty -- | Whether a 'Chunk' is empty. Note that something like 'pure mempty' is not -- considered an empty chunk, even though the underlying 'Doc' is empty. isEmpty :: Chunk a -> Bool isEmpty = isNothing . unChunk -- | Convert a 'String' into a 'Chunk'. This satisfies: -- -- > isEmpty . stringChunk = null -- > extractChunk . stringChunk = string stringChunk :: String -> Chunk Doc stringChunk "" = mempty stringChunk s = pure (string s) -- | Convert a paragraph into a 'Chunk'. The resulting chunk is composed by the -- words of the original paragraph separated by softlines, so it will be -- automatically word-wrapped when rendering the underlying document. -- -- This satisfies: -- -- > isEmpty . paragraph = null . words paragraph :: String -> Chunk Doc paragraph = foldr (chunked () . stringChunk) mempty . words tabulate' :: Int -> [(Doc, Doc)] -> Chunk Doc tabulate' _ [] = mempty tabulate' size table = pure $ vcat [ indent 2 (fillBreak size key <+> value) | (key, value) <- table ] -- | Display pairs of strings in a table. tabulate :: [(Doc, Doc)] -> Chunk Doc tabulate = tabulate' 24 optparse-applicative-0.14.3.0/Options/Applicative/Help/Types.hs0000644000000000000000000000213513355265316022515 0ustar0000000000000000module Options.Applicative.Help.Types ( ParserHelp (..) , renderHelp ) where import Data.Semigroup import Prelude import Options.Applicative.Help.Chunk import Options.Applicative.Help.Pretty data ParserHelp = ParserHelp { helpError :: Chunk Doc , helpSuggestions :: Chunk Doc , helpHeader :: Chunk Doc , helpUsage :: Chunk Doc , helpBody :: Chunk Doc , helpFooter :: Chunk Doc } instance Show ParserHelp where showsPrec _ h = showString (renderHelp 80 h) instance Monoid ParserHelp where mempty = ParserHelp mempty mempty mempty mempty mempty mempty mappend = (<>) instance Semigroup ParserHelp where (ParserHelp e1 s1 h1 u1 b1 f1) <> (ParserHelp e2 s2 h2 u2 b2 f2) = ParserHelp (mappend e1 e2) (mappend s1 s2) (mappend h1 h2) (mappend u1 u2) (mappend b1 b2) (mappend f1 f2) helpText :: ParserHelp -> Doc helpText (ParserHelp e s h u b f) = extractChunk . vsepChunks $ [e, s, h, u, b, f] -- | Convert a help text to 'String'. renderHelp :: Int -> ParserHelp -> String renderHelp cols = (`displayS` "") . renderPretty 1.0 cols . helpText optparse-applicative-0.14.3.0/Options/Applicative/Help/Core.hs0000644000000000000000000001241613355265316022304 0ustar0000000000000000module Options.Applicative.Help.Core ( cmdDesc, briefDesc, missingDesc, fold_tree, fullDesc, ParserHelp(..), errorHelp, headerHelp, suggestionsHelp, usageHelp, bodyHelp, footerHelp, parserHelp, parserUsage, ) where import Control.Applicative import Control.Monad (guard) import Data.Function (on) import Data.List (sort, intersperse, groupBy) import Data.Maybe (maybeToList, catMaybes, fromMaybe) import Data.Monoid import Prelude import Options.Applicative.Common import Options.Applicative.Types import Options.Applicative.Help.Pretty import Options.Applicative.Help.Chunk -- | Style for rendering an option. data OptDescStyle = OptDescStyle { descSep :: Doc , descHidden :: Bool , descOptional :: Bool , descSurround :: Bool } -- | Generate description for a single option. optDesc :: ParserPrefs -> OptDescStyle -> OptHelpInfo -> Option a -> Chunk Doc optDesc pprefs style info opt = let ns = optionNames $ optMain opt mv = stringChunk $ optMetaVar opt descs = map (string . showOption) (sort ns) desc' = listToChunk (intersperse (descSep style) descs) <<+>> mv show_opt | hinfoDefault info && not (descOptional style) = False | optVisibility opt == Hidden = descHidden style | otherwise = optVisibility opt == Visible suffix | hinfoMulti info = stringChunk . prefMultiSuffix $ pprefs | otherwise = mempty render chunk | not show_opt = mempty | isEmpty chunk || not (descSurround style) = mappend chunk suffix | hinfoDefault info = mappend (fmap brackets chunk) suffix | null (drop 1 descs) = mappend chunk suffix | otherwise = mappend (fmap parens chunk) suffix in maybe id fmap (optDescMod opt) (render desc') -- | Generate descriptions for commands. cmdDesc :: Parser a -> [(Maybe String, Chunk Doc)] cmdDesc = mapParser desc where desc _ opt = case optMain opt of CmdReader gn cmds p -> (,) gn $ tabulate [(string cmd, align (extractChunk d)) | cmd <- reverse cmds , d <- maybeToList . fmap infoProgDesc $ p cmd ] _ -> mempty -- | Generate a brief help text for a parser. briefDesc :: ParserPrefs -> Parser a -> Chunk Doc briefDesc = briefDesc' True -- | Generate a brief help text for a parser, only including mandatory -- options and arguments. missingDesc :: ParserPrefs -> Parser a -> Chunk Doc missingDesc = briefDesc' False -- | Generate a brief help text for a parser, allowing the specification -- of if optional arguments are show. briefDesc' :: Bool -> ParserPrefs -> Parser a -> Chunk Doc briefDesc' showOptional pprefs = fold_tree . treeMapParser (optDesc pprefs style) where style = OptDescStyle { descSep = string "|" , descHidden = False , descOptional = showOptional , descSurround = True } fold_tree :: OptTree (Chunk Doc) -> Chunk Doc fold_tree (Leaf x) = x fold_tree (MultNode xs) = foldr ((<>) . fold_tree) mempty xs fold_tree (AltNode xs) = alt_node . filter (not . isEmpty) . map fold_tree $ xs where alt_node :: [Chunk Doc] -> Chunk Doc alt_node [n] = n alt_node ns = fmap parens . foldr (chunked (\x y -> x char '|' y)) mempty $ ns -- | Generate a full help text for a parser. fullDesc :: ParserPrefs -> Parser a -> Chunk Doc fullDesc pprefs = tabulate . catMaybes . mapParser doc where doc info opt = do guard . not . isEmpty $ n guard . not . isEmpty $ h return (extractChunk n, align . extractChunk $ h <<+>> hdef) where n = optDesc pprefs style info opt h = optHelp opt hdef = Chunk . fmap show_def . optShowDefault $ opt show_def s = parens (string "default:" <+> string s) style = OptDescStyle { descSep = string "," , descHidden = True , descOptional = True , descSurround = False } errorHelp :: Chunk Doc -> ParserHelp errorHelp chunk = mempty { helpError = chunk } headerHelp :: Chunk Doc -> ParserHelp headerHelp chunk = mempty { helpHeader = chunk } suggestionsHelp :: Chunk Doc -> ParserHelp suggestionsHelp chunk = mempty { helpSuggestions = chunk } usageHelp :: Chunk Doc -> ParserHelp usageHelp chunk = mempty { helpUsage = chunk } bodyHelp :: Chunk Doc -> ParserHelp bodyHelp chunk = mempty { helpBody = chunk } footerHelp :: Chunk Doc -> ParserHelp footerHelp chunk = mempty { helpFooter = chunk } -- | Generate the help text for a program. parserHelp :: ParserPrefs -> Parser a -> ParserHelp parserHelp pprefs p = bodyHelp . vsepChunks $ ( with_title "Available options:" (fullDesc pprefs p) ) : (group_title <$> cs) where def = "Available commands:" cs = groupBy ((==) `on` fst) $ cmdDesc p group_title a@((n,_):_) = with_title (fromMaybe def n) $ vcatChunks (snd <$> a) group_title _ = mempty with_title :: String -> Chunk Doc -> Chunk Doc with_title title = fmap (string title .$.) -- | Generate option summary. parserUsage :: ParserPrefs -> Parser a -> String -> Doc parserUsage pprefs p progn = hsep [ string "Usage:" , string progn , align (extractChunk (briefDesc pprefs p)) ] {-# ANN footerHelp "HLint: ignore Eta reduce" #-} optparse-applicative-0.14.3.0/tests/0000755000000000000000000000000013355265316015432 5ustar0000000000000000optparse-applicative-0.14.3.0/tests/dropback.err.txt0000644000000000000000000000004013355265316020541 0ustar0000000000000000Missing: C Usage: dropback B C optparse-applicative-0.14.3.0/tests/subparsers.err.txt0000644000000000000000000000035613355265316021157 0ustar0000000000000000Usage: subparsers COMMAND COMMAND Available options: -h,--help Show this help text Available commands: add Add a file to the repository commit Record changes to the repository optparse-applicative-0.14.3.0/tests/alt.err.txt0000644000000000000000000000034413355265316017543 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.14.3.0/tests/commands.err.txt0000644000000000000000000000044413355265316020565 0ustar0000000000000000Usage: commands COMMAND Available options: -h,--help Show this help text Available commands: hello Print greeting goodbye Say goodbye French commands: bonjour Print greeting au-revoir Say goodbye optparse-applicative-0.14.3.0/tests/carry.err.txt0000644000000000000000000000004313355265316020077 0ustar0000000000000000Missing: -a A Usage: carry c -a A optparse-applicative-0.14.3.0/tests/nested.err.txt0000644000000000000000000000004613355265316020244 0ustar0000000000000000Missing: -a A Usage: nested c b -a A optparse-applicative-0.14.3.0/tests/hello.err.txt0000644000000000000000000000054113355265316020065 0ustar0000000000000000hello - a test for optparse-applicative Usage: hello --hello TARGET [-q|--quiet] [--repeat INT] Print a greeting for TARGET Available options: --hello TARGET Target for the greeting -q,--quiet Whether to be quiet --repeat INT Repeats for greeting (default: 1) -h,--help Show this help text optparse-applicative-0.14.3.0/tests/helponempty.err.txt0000644000000000000000000000024713355265316021331 0ustar0000000000000000Usage: helponempty B C Available options: -h,--help Show this help text Available commands: b c optparse-applicative-0.14.3.0/tests/formatting.err.txt0000644000000000000000000000107713355265316021141 0ustar0000000000000000Usage: formatting [-t|--test FOO_BAR_BAZ_LONG_METAVARIABLE] This is a very long program description. This text should be automatically wrapped to fit the size of the terminal Available options: -t,--test FOO_BAR_BAZ_LONG_METAVARIABLE This is an options with a very very long description. Hopefully, this will be nicely formatted by the help text generator. -h,--help Show this help text optparse-applicative-0.14.3.0/tests/commands_header_full.err.txt0000644000000000000000000000055413355265316023121 0ustar0000000000000000Invalid option `-zello' Did you mean this? hello foo Usage: commands_header_full COMMAND Available options: -h,--help Show this help text Available commands: hello Print greeting goodbye Say goodbye French commands: bonjour Print greeting au-revoir Say goodbye optparse-applicative-0.14.3.0/tests/cabal.err.txt0000644000000000000000000000041313355265316020022 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.14.3.0/tests/helponemptysub.err.txt0000644000000000000000000000014713355265316022042 0ustar0000000000000000Usage: helponemptysub c -a A Available options: -a A both commands require this optparse-applicative-0.14.3.0/tests/test.hs0000644000000000000000000006460013355265316016753 0ustar0000000000000000{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} 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 qualified Examples.Formatting as Formatting import Control.Applicative import Control.Monad import Data.ByteString (ByteString) import Data.List hiding (group) import Data.Semigroup hiding (option) import Data.String import System.Exit import Test.QuickCheck hiding (Success, Failure) import Test.QuickCheck.Property import Options.Applicative import Options.Applicative.Types import Options.Applicative.Help.Pretty (Doc, SimpleDoc(..)) import qualified Options.Applicative.Help.Pretty as Doc import Options.Applicative.Help.Chunk import Options.Applicative.Help.Levenshtein import Prelude run :: ParserInfo a -> [String] -> ParserResult a run = execParserPure defaultPrefs assertError :: Show a => ParserResult a -> (ParserFailure ParserHelp -> Property) -> Property assertError x f = case x of Success r -> counterexample ("expected failure, got success: " ++ show r) failed Failure e -> f e CompletionInvoked _ -> counterexample "expected failure, got completion" failed assertResult :: ParserResult a -> (a -> Property) -> Property assertResult x f = case x of Success r -> f r Failure e -> do let (msg, _) = renderFailure e "test" counterexample ("unexpected parse error\n" ++ msg) failed CompletionInvoked _ -> counterexample "expected result, got completion" failed assertHasLine :: String -> String -> Property assertHasLine l s = counterexample ("expected line:\n\t" ++ l ++ "\nnot found") $ l `elem` lines s checkHelpTextWith :: Show a => ExitCode -> ParserPrefs -> String -> ParserInfo a -> [String] -> Property checkHelpTextWith ecode pprefs name p args = ioProperty $ do let result = execParserPure pprefs p args expected <- readFile $ "tests/" ++ name ++ ".err.txt" return $ assertError result $ \failure -> let (msg, code) = renderFailure failure name in (expected === msg ++ "\n") .&&. (ecode === code) checkHelpText :: Show a => String -> ParserInfo a -> [String] -> Property checkHelpText = checkHelpTextWith ExitSuccess defaultPrefs prop_hello :: Property prop_hello = once $ checkHelpText "hello" Hello.opts ["--help"] prop_modes :: Property prop_modes = once $ checkHelpText "commands" Commands.opts ["--help"] prop_cmd_header :: Property prop_cmd_header = once $ let i = info (helper <*> Commands.sample) (header "foo") r1 = checkHelpTextWith (ExitFailure 1) defaultPrefs "commands_header" i ["-zello"] r2 = checkHelpTextWith (ExitFailure 1) (prefs showHelpOnError) "commands_header_full" i ["-zello"] in (r1 .&&. r2) prop_cabal_conf :: Property prop_cabal_conf = once $ checkHelpText "cabal" Cabal.pinfo ["configure", "--help"] prop_args :: Property prop_args = once $ let result = run Commands.opts ["hello", "foo", "bar"] in assertResult result ((===) (Commands.Hello ["foo", "bar"])) prop_args_opts :: Property prop_args_opts = once $ let result = run Commands.opts ["hello", "foo", "--bar"] in assertError result (\_ -> property succeeded) prop_args_ddash :: Property prop_args_ddash = once $ let result = run Commands.opts ["hello", "foo", "--", "--bar", "--", "baz"] in assertResult result ((===) (Commands.Hello ["foo", "--bar", "--", "baz"])) prop_alts :: Property prop_alts = once $ let result = run Alternatives.opts ["-b", "-a", "-b", "-a", "-a", "-b"] in assertResult result $ \xs -> let a = Alternatives.A b = Alternatives.B in [b, a, b, a, a, b] === xs prop_show_default :: Property prop_show_default = once $ let p = option auto ( short 'n' <> help "set count" <> value (0 :: Int) <> showDefault ) i = info (p <**> helper) idm result = run i ["--help"] in assertError result $ \failure -> let (msg, _) = renderFailure failure "test" in assertHasLine " -n ARG set count (default: 0)" msg prop_alt_cont :: Property prop_alt_cont = once $ let p = Alternatives.a <|> Alternatives.b i = info p idm result = run i ["-a", "-b"] in assertError result (\_ -> property succeeded) prop_alt_help :: Property prop_alt_help = once $ let p :: Parser (Maybe (Either String String)) 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 in checkHelpText "alt" i ["--help"] prop_nested_commands :: Property prop_nested_commands = once $ let p3 :: Parser String 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 in checkHelpTextWith (ExitFailure 1) defaultPrefs "nested" i ["c", "b"] prop_drops_back_contexts :: Property prop_drops_back_contexts = once $ let p3 :: Parser String p3 = strOption (short 'a' <> metavar "A") p2 = subparser (command "b" (info p3 idm) <> metavar "B") p1 = subparser (command "c" (info p3 idm) <> metavar "C") p0 = (,) <$> p2 <*> p1 i = info (p0 <**> helper) idm in checkHelpTextWith (ExitFailure 1) defaultPrefs "dropback" i ["b", "-aA"] prop_context_carry :: Property prop_context_carry = once $ let p3 :: Parser String p3 = strOption (short 'a' <> metavar "A") p2 = subparser (command "b" (info p3 idm) <> metavar "B") p1 = subparser (command "c" (info p3 idm) <> metavar "C") p0 = (,) <$> p2 <*> p1 i = info (p0 <**> helper) idm in checkHelpTextWith (ExitFailure 1) defaultPrefs "carry" i ["b", "-aA", "c"] prop_help_on_empty :: Property prop_help_on_empty = once $ let p3 :: Parser String p3 = strOption (short 'a' <> metavar "A") p2 = subparser (command "b" (info p3 idm) <> metavar "B") p1 = subparser (command "c" (info p3 idm) <> metavar "C") p0 = (,) <$> p2 <*> p1 i = info (p0 <**> helper) idm in checkHelpTextWith (ExitFailure 1) (prefs showHelpOnEmpty) "helponempty" i [] prop_help_on_empty_sub :: Property prop_help_on_empty_sub = once $ let p3 :: Parser String p3 = strOption (short 'a' <> metavar "A" <> help "both commands require this") p2 = subparser (command "b" (info p3 idm) <> metavar "B") p1 = subparser (command "c" (info p3 idm) <> metavar "C") p0 = (,) <$> p2 <*> p1 i = info (p0 <**> helper) idm in checkHelpTextWith (ExitFailure 1) (prefs showHelpOnEmpty) "helponemptysub" i ["b", "-aA", "c"] prop_many_args :: Property prop_many_args = forAll (choose (0,2000)) $ \nargs -> let p :: Parser [String] p = many (argument str idm) i = info p idm result = run i (replicate nargs "foo") in assertResult result (\xs -> nargs === length xs) prop_disambiguate :: Property prop_disambiguate = once $ 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"] in assertResult result ((===) 1) prop_ambiguous :: Property prop_ambiguous = once $ 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"] in assertError result (\_ -> property succeeded) prop_completion :: Property prop_completion = once . ioProperty $ let p = (,) <$> strOption (long "foo" <> value "") <*> strOption (long "bar" <> value "") i = info p idm result = run i ["--bash-completion-index", "0"] in case result of CompletionInvoked (CompletionResult err) -> do completions <- lines <$> err "test" return $ ["--foo", "--bar"] === completions Failure _ -> return $ counterexample "unexpected failure" failed Success val -> return $ counterexample ("unexpected result " ++ show val) failed prop_completion_opt_after_double_dash :: Property prop_completion_opt_after_double_dash = once . ioProperty $ let p = (,) <$> strOption (long "foo" <> value "") <*> argument readerAsk (completeWith ["bar"]) i = info p idm result = run i ["--bash-completion-index", "2" , "--bash-completion-word", "test" , "--bash-completion-word", "--"] in case result of CompletionInvoked (CompletionResult err) -> do completions <- lines <$> err "test" return $ ["bar"] === completions Failure _ -> return $ counterexample "unexpected failure" failed Success val -> return $ counterexample ("unexpected result " ++ show val) failed prop_completion_only_reachable :: Property prop_completion_only_reachable = once . ioProperty $ let p :: Parser (String,String) p = (,) <$> strArgument (completeWith ["reachable"]) <*> strArgument (completeWith ["unreachable"]) i = info p idm result = run i ["--bash-completion-index", "0"] in case result of CompletionInvoked (CompletionResult err) -> do completions <- lines <$> err "test" return $ ["reachable"] === completions Failure _ -> return $ counterexample "unexpected failure" failed Success val -> return $ counterexample ("unexpected result " ++ show val) failed prop_completion_only_reachable_deep :: Property prop_completion_only_reachable_deep = once . ioProperty $ let p :: Parser (String,String) p = (,) <$> strArgument (completeWith ["seen"]) <*> strArgument (completeWith ["now-reachable"]) i = info p idm result = run i [ "--bash-completion-index", "2" , "--bash-completion-word", "test-prog" , "--bash-completion-word", "seen" ] in case result of CompletionInvoked (CompletionResult err) -> do completions <- lines <$> err "test" return $ ["now-reachable"] === completions Failure _ -> return $ counterexample "unexpected failure" failed Success val -> return $ counterexample ("unexpected result " ++ show val) failed prop_completion_multi :: Property prop_completion_multi = once . ioProperty $ let p :: Parser [String] p = many (strArgument (completeWith ["reachable"])) i = info p idm result = run i [ "--bash-completion-index", "3" , "--bash-completion-word", "test-prog" , "--bash-completion-word", "nope" ] in case result of CompletionInvoked (CompletionResult err) -> do completions <- lines <$> err "test" return $ ["reachable"] === completions Failure _ -> return $ counterexample "unexpected failure" failed Success val -> return $ counterexample ("unexpected result " ++ show val) failed prop_completion_rich :: Property prop_completion_rich = once . ioProperty $ let p = (,) <$> option readerAsk (long "foo" <> help "Fo?") <*> option readerAsk (long "bar" <> help "Ba?") i = info p idm result = run i ["--bash-completion-enriched", "--bash-completion-index", "0"] in case result of CompletionInvoked (CompletionResult err) -> do completions <- lines <$> err "test" return $ ["--foo\tFo?", "--bar\tBa?"] === completions Failure _ -> return $ counterexample "unexpected failure" failed Success val -> return $ counterexample ("unexpected result " ++ show val) failed prop_completion_rich_lengths :: Property prop_completion_rich_lengths = once . ioProperty $ let p = (,) <$> option readerAsk (long "foo" <> help "Foo hide this") <*> option readerAsk (long "bar" <> help "Bar hide this") i = info p idm result = run i [ "--bash-completion-enriched" , "--bash-completion-index=0" , "--bash-completion-option-desc-length=3" , "--bash-completion-command-desc-length=30"] in case result of CompletionInvoked (CompletionResult err) -> do completions <- lines <$> err "test" return $ ["--foo\tFoo...", "--bar\tBar..."] === completions Failure _ -> return $ counterexample "unexpected failure" failed Success val -> return $ counterexample ("unexpected result " ++ show val) failed prop_bind_usage :: Property prop_bind_usage = once $ let p :: Parser [String] p = many (argument str (metavar "ARGS...")) i = info (p <**> helper) briefDesc result = run i ["--help"] in assertError result $ \failure -> let text = head . lines . fst $ renderFailure failure "test" in "Usage: test [ARGS...]" === text prop_issue_19 :: Property prop_issue_19 = once $ let p = option (fmap Just str) ( short 'x' <> value Nothing ) i = info (p <**> helper) idm result = run i ["-x", "foo"] in assertResult result (Just "foo" ===) prop_arguments1_none :: Property prop_arguments1_none = let p :: Parser [String] p = some (argument str idm) i = info (p <**> helper) idm result = run i [] in assertError result $ \_ -> property succeeded prop_arguments1_some :: Property prop_arguments1_some = once $ let p :: Parser [String] p = some (argument str idm) i = info (p <**> helper) idm result = run i ["foo", "--", "bar", "baz"] in assertResult result (["foo", "bar", "baz"] ===) prop_arguments_switch :: Property prop_arguments_switch = once $ let p :: Parser [String] p = switch (short 'x') *> many (argument str idm) i = info p idm result = run i ["--", "-x"] in assertResult result $ \args -> ["-x"] === args prop_issue_35 :: Property prop_issue_35 = once $ let p = flag' True (short 't' <> hidden) <|> flag' False (short 'f') i = info p idm result = run i [] in assertError result $ \failure -> let text = lines . fst $ renderFailure failure "test" in ["Missing: -f", "", "Usage: test -f"] === text prop_backtracking :: Property prop_backtracking = once $ 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"] in assertError result $ \_ -> property succeeded prop_error_context :: Property prop_error_context = once $ let p = pk <$> option auto (long "port") <*> option auto (long "key") i = info p idm result = run i ["--port", "foo", "--key", "291"] in assertError result $ \failure -> let (msg, _) = renderFailure failure "test" errMsg = head $ lines msg in conjoin [ counterexample "no context in error message (option)" ("port" `isInfixOf` errMsg) , counterexample "no context in error message (value)" ("foo" `isInfixOf` errMsg)] where pk :: Int -> Int -> (Int, Int) pk = (,) condr :: (Int -> Bool) -> ReadM Int condr f = do x <- auto guard (f x) return x prop_arg_order_1 :: Property prop_arg_order_1 = once $ let p = (,) <$> argument (condr even) idm <*> argument (condr odd) idm i = info p idm result = run i ["3", "6"] in assertError result $ \_ -> property succeeded prop_arg_order_2 :: Property prop_arg_order_2 = once $ let p = (,,) <$> argument (condr even) idm <*> option (condr even) (short 'a') <*> option (condr odd) (short 'b') i = info p idm result = run i ["2", "-b", "3", "-a", "6"] in assertResult result ((===) (2, 6, 3)) prop_arg_order_3 :: Property prop_arg_order_3 = once $ let p = (,) <$> ( argument (condr even) idm <|> option auto (short 'n') ) <*> argument (condr odd) idm i = info p idm result = run i ["-n", "3", "5"] in assertResult result ((===) (3, 5)) prop_unix_style :: Int -> Int -> Property prop_unix_style j k = let p = (,) <$> flag' j (short 'x') <*> flag' k (short 'c') i = info p idm result = run i ["-xc"] in assertResult result ((===) (j,k)) prop_unix_with_options :: Property prop_unix_with_options = once $ let p = (,) <$> flag' (1 :: Int) (short 'x') <*> strOption (short 'a') i = info p idm result = run i ["-xac"] in assertResult result ((===) (1, "c")) prop_count_flags :: Property prop_count_flags = once $ let p = length <$> many (flag' () (short 't')) i = info p idm result = run i ["-ttt"] in assertResult result ((===) 3) prop_issue_47 :: Property prop_issue_47 = once $ let p = option r (long "test" <> value 9) :: Parser Int r = readerError "error message" result = run (info p idm) ["--test", "x"] in assertError result $ \failure -> let text = head . lines . fst $ renderFailure failure "test" in counterexample "no error message" ("error message" `isInfixOf` text) prop_long_help :: Property prop_long_help = once $ let p = Formatting.opts <**> helper i = info p ( progDesc (concat [ "This is a very long program description. " , "This text should be automatically wrapped " , "to fit the size of the terminal" ]) ) in checkHelpTextWith ExitSuccess (prefs (columns 50)) "formatting" i ["--help"] prop_issue_50 :: Property prop_issue_50 = once $ let p = argument str (metavar "INPUT") <* switch (long "version") result = run (info p idm) ["--version", "test"] in assertResult result $ \r -> "test" === r prop_intersperse_1 :: Property prop_intersperse_1 = once $ let p = many (argument str (metavar "ARGS")) <* switch (short 'x') result = run (info p noIntersperse) ["a", "-x", "b"] in assertResult result $ \args -> ["a", "-x", "b"] === args prop_intersperse_2 :: Property prop_intersperse_2 = once $ let p = subparser ( command "run" ( info (many (argument str (metavar "OPTIONS"))) noIntersperse ) <> command "test" ( info (many (argument str (metavar "ARGS"))) idm ) ) i = info p idm result1 = run i ["run", "foo", "-x"] result2 = run i ["test", "bar", "-x"] in conjoin [ assertResult result1 $ \args -> ["foo", "-x"] === args , assertError result2 $ \_ -> property succeeded ] prop_intersperse_3 :: Property prop_intersperse_3 = once $ let p = (,,) <$> switch ( long "foo" ) <*> strArgument ( metavar "FILE" ) <*> many ( strArgument ( metavar "ARGS..." ) ) i = info p noIntersperse result = run i ["--foo", "myfile", "-a", "-b", "-c"] in assertResult result $ \(b,f,as) -> conjoin [ ["-a", "-b", "-c"] === as , True === b , "myfile" === f ] prop_forward_options :: Property prop_forward_options = once $ let p = (,) <$> switch ( long "foo" ) <*> many ( strArgument ( metavar "ARGS..." ) ) i = info p forwardOptions result = run i ["--fo", "--foo", "myfile"] in assertResult result $ \(b,a) -> conjoin [ True === b , ["--fo", "myfile"] === a ] prop_issue_52 :: Property prop_issue_52 = once $ let p = subparser ( metavar "FOO" <> command "run" (info (pure "foo") idm) ) i = info p idm in assertError (run i []) $ \failure -> do let text = lines . fst $ renderFailure failure "test" ["Missing: FOO", "", "Usage: test FOO"] === text prop_multiple_subparsers :: Property prop_multiple_subparsers = once $ let p1 = subparser (command "add" (info (pure ()) ( progDesc "Add a file to the repository" ))) p2 = subparser (command "commit" (info (pure ()) ( progDesc "Record changes to the repository" ))) i = info (p1 *> p2 <**> helper) idm in checkHelpText "subparsers" i ["--help"] prop_argument_error :: Property prop_argument_error = once $ let r = (auto >>= \x -> x <$ guard (x == 42)) <|> (str >>= \x -> readerError (x ++ " /= 42")) p1 = argument r idm :: Parser Int i = info (p1 *> p1) idm in assertError (run i ["3", "4"]) $ \failure -> let text = head . lines . fst $ renderFailure failure "test" in "3 /= 42" === text prop_reader_error_mplus :: Property prop_reader_error_mplus = once $ let r = (auto >>= \x -> x <$ guard (x == 42)) <|> (str >>= \x -> readerError (x ++ " /= 42")) p1 = argument r idm :: Parser Int i = info p1 idm in assertError (run i ["foo"]) $ \failure -> let text = head . lines . fst $ renderFailure failure "test" in "foo /= 42" === text prop_missing_flags_described :: Property prop_missing_flags_described = once $ let p :: Parser (String, String, Maybe String) p = (,,) <$> option str (short 'a') <*> option str (short 'b') <*> optional (option str (short 'c')) i = info p idm in assertError (run i ["-b", "3"]) $ \failure -> let text = head . lines . fst $ renderFailure failure "test" in "Missing: -a ARG" === text prop_many_missing_flags_described :: Property prop_many_missing_flags_described = once $ let p :: Parser (String, String) p = (,) <$> option str (short 'a') <*> option str (short 'b') i = info p idm in assertError (run i []) $ \failure -> let text = head . lines . fst $ renderFailure failure "test" in "Missing: -a ARG -b ARG" === text prop_alt_missing_flags_described :: Property prop_alt_missing_flags_described = once $ let p :: Parser String p = option str (short 'a') <|> option str (short 'b') i = info p idm in assertError (run i []) $ \failure -> let text = head . lines . fst $ renderFailure failure "test" in "Missing: (-a ARG | -b ARG)" === text prop_missing_option_parameter_err :: Property prop_missing_option_parameter_err = once $ let p :: Parser String p = option str (short 'a') i = info p idm in assertError (run i ["-a"]) $ \failure -> let text = head . lines . fst $ renderFailure failure "test" in "The option `-a` expects an argument." === text prop_many_pairs_success :: Property prop_many_pairs_success = once $ let p :: Parser [(String, String)] p = many $ (,) <$> argument str idm <*> argument str idm i = info p idm nargs = 10000 result = run i (replicate nargs "foo") in assertResult result $ \xs -> nargs `div` 2 === length xs prop_many_pairs_failure :: Property prop_many_pairs_failure = once $ let p :: Parser [(String, String)] p = many $ (,) <$> argument str idm <*> argument str idm i = info p idm nargs = 9999 result = run i (replicate nargs "foo") in assertError result $ \_ -> property succeeded prop_many_pairs_lazy_progress :: Property prop_many_pairs_lazy_progress = once $ let p :: Parser [(Maybe String, String)] p = many $ (,) <$> optional (option str (short 'a')) <*> argument str idm i = info p idm result = run i ["foo", "-abar", "baz"] in assertResult result $ \xs -> [(Just "bar", "foo"), (Nothing, "baz")] === xs prop_suggest :: Property prop_suggest = once $ let p2 = subparser (command "first" (info (pure ()) idm)) p1 = subparser (command "fst" (info (pure ()) idm)) p3 = subparser (command "far-off" (info (pure ()) idm)) p = p2 *> p1 *> p3 i = info p idm result = run i ["fist"] in assertError result $ \failure -> let (msg, _) = renderFailure failure "prog" in counterexample msg $ isInfixOf "Did you mean one of these?\n first\n fst" msg prop_bytestring_reader :: Property prop_bytestring_reader = once $ let t = "testValue" p :: Parser ByteString p = argument str idm i = info p idm result = run i ["testValue"] in assertResult result $ \xs -> fromString t === xs --- deriving instance Arbitrary a => Arbitrary (Chunk a) deriving instance Eq SimpleDoc deriving instance Show SimpleDoc equalDocs :: Float -> Int -> Doc -> Doc -> Property equalDocs f w d1 d2 = Doc.renderPretty f w d1 === Doc.renderPretty f w d2 prop_listToChunk_1 :: [String] -> Property prop_listToChunk_1 xs = isEmpty (listToChunk xs) === null xs prop_listToChunk_2 :: [String] -> Property prop_listToChunk_2 xs = listToChunk xs === mconcat (fmap pure xs) prop_extractChunk_1 :: String -> Property prop_extractChunk_1 x = extractChunk (pure x) === x prop_extractChunk_2 :: Chunk String -> Property prop_extractChunk_2 x = extractChunk (fmap pure x) === x prop_stringChunk_1 :: Positive Float -> Positive Int -> String -> Property prop_stringChunk_1 (Positive f) (Positive w) s = equalDocs f w (extractChunk (stringChunk s)) (Doc.string s) prop_stringChunk_2 :: String -> Property prop_stringChunk_2 s = isEmpty (stringChunk s) === null s prop_paragraph :: String -> Property prop_paragraph s = isEmpty (paragraph s) === null (words s) --- -- -- From -- https://en.wikipedia.org/wiki/Damerau%E2%80%93Levenshtein_distance -- -- In information theory and computer science, the Damerau–Levenshtein -- distance is a distance (string metric) between two strings, i.e., -- finite sequence of symbols, given by counting the minimum number -- of operations needed to transform one string into the other, where -- an operation is defined as an insertion, deletion, or substitution -- of a single character, or a transposition of two adjacent characters. -- prop_edit_distance_gezero :: String -> String -> Bool prop_edit_distance_gezero a b = editDistance a b >= 0 prop_edit_insertion :: [Char] -> Char -> [Char] -> Property prop_edit_insertion as i bs = editDistance (as ++ bs) (as ++ [i] ++ bs) === 1 prop_edit_symmetric :: [Char] -> [Char] -> Property prop_edit_symmetric as bs = editDistance as bs === editDistance bs as prop_edit_substitution :: [Char] -> [Char] -> Char -> Char -> Property prop_edit_substitution as bs a b = a /= b ==> editDistance (as ++ [a] ++ bs) (as ++ [b] ++ bs) === 1 prop_edit_transposition :: [Char] -> [Char] -> Char -> Char -> Property prop_edit_transposition as bs a b = a /= b ==> editDistance (as ++ [a] ++ [b] ++ bs) (as ++ [b] ++ [a] ++ bs) === 1 --- return [] main :: IO () main = do result <- $(quickCheckAll) unless result exitFailure optparse-applicative-0.14.3.0/tests/commands_header.err.txt0000644000000000000000000000012613355265316022072 0ustar0000000000000000Invalid option `-zello' Did you mean this? hello Usage: commands_header COMMAND optparse-applicative-0.14.3.0/tests/Examples/0000755000000000000000000000000013355265316017210 5ustar0000000000000000optparse-applicative-0.14.3.0/tests/Examples/Alternatives.hs0000644000000000000000000000044413355265316022207 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.14.3.0/tests/Examples/Commands.hs0000644000000000000000000000213513355265316021306 0ustar0000000000000000{-# LANGUAGE CPP #-} module Examples.Commands where import Data.List import Data.Monoid import Options.Applicative #if __GLASGOW_HASKELL__ <= 702 (<>) :: Monoid a => a -> a -> a (<>) = mappend #endif data Sample = Hello [String] | Goodbye deriving (Eq, Show) hello :: Parser Sample hello = Hello <$> many (argument str (metavar "TARGET...")) sample :: Parser Sample sample = subparser ( command "hello" (info hello (progDesc "Print greeting")) <> command "goodbye" (info (pure Goodbye) (progDesc "Say goodbye")) ) <|> subparser ( command "bonjour" (info hello (progDesc "Print greeting")) <> command "au-revoir" (info (pure Goodbye) (progDesc "Say goodbye")) <> commandGroup "French commands:" <> hidden ) 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.14.3.0/tests/Examples/Cabal.hs0000644000000000000000000000633713355265316020557 0ustar0000000000000000{-# LANGUAGE Arrows, CPP #-} module Examples.Cabal where import Options.Applicative import Options.Applicative.Arrows import Data.Monoid #if __GLASGOW_HASKELL__ <= 702 (<>) :: 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 auto ( 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 ( progDesc "An example modelled on cabal" ) main :: IO () main = do r <- execParser pinfo print r optparse-applicative-0.14.3.0/tests/Examples/Hello.hs0000644000000000000000000000175013355265316020612 0ustar0000000000000000{-# LANGUAGE CPP #-} module Examples.Hello where import Options.Applicative import Data.Semigroup ((<>)) import Control.Monad (replicateM_) data Sample = Sample { hello :: String , quiet :: Bool , repeat :: Int } deriving Show sample :: Parser Sample sample = Sample <$> strOption ( long "hello" <> metavar "TARGET" <> help "Target for the greeting" ) <*> switch ( long "quiet" <> short 'q' <> help "Whether to be quiet" ) <*> option auto ( long "repeat" <> help "Repeats for greeting" <> showDefault <> value 1 <> metavar "INT" ) main :: IO () main = greet =<< execParser opts opts :: ParserInfo Sample opts = info (sample <**> helper) ( fullDesc <> progDesc "Print a greeting for TARGET" <> header "hello - a test for optparse-applicative" ) greet :: Sample -> IO () greet (Sample h False n) = replicateM_ n . putStrLn $ "Hello, " ++ h greet _ = return () optparse-applicative-0.14.3.0/tests/Examples/Formatting.hs0000644000000000000000000000061513355265316021660 0ustar0000000000000000module Examples.Formatting where import Data.Monoid import Options.Applicative import Prelude opts :: Parser Int opts = option auto $ mconcat [ long "test" , short 't' , value 0 , metavar "FOO_BAR_BAZ_LONG_METAVARIABLE" , help "This is an options with a very very long description. Hopefully, this will be nicely formatted by the help text generator." ]