options-0.1: Parsing command-line options

Safe HaskellNone

Options

Contents

Description

The options package lets library and application developers easily work with command-line options.

The following example is a full program that can accept two options, --message and --quiet:

{-# LANGUAGE TemplateHaskell #-}

import Options

defineOptions "MainOptions" $ do
    stringOption "optMessage" "message" "Hello world!"
        "A message to show the user."
    boolOption "optQuiet" "quiet" False
        "Whether to be quiet."

main :: IO ()
main = runCommand $ \opts args -> do
    if optQuiet opts
        then return ()
        else putStrLn (optMessage opts)
$ ./hello
Hello world!
$ ./hello --message='ciao mondo'
ciao mondo
$ ./hello --quiet
$

In addition, this library will automatically create documentation options such as --help and --help-all:

$ ./hello --help
Help Options:
  -h, --help                  Show option summary.
  --help-all                  Show all help options.

Application Options:
  --message                   A message to show the user.
  --quiet                     Whether to be quiet.

Synopsis

Options

class Options a Source

Options are defined together in a single data type, which will be an instance of Options.

See defineOptions for details on defining instances of Options.

See options for details on including imported Options types in locally defined options.

defaultOptions :: Options a => aSource

An options value containing only the default values for each option. This is equivalent to the options value when parsing an empty argument list.

Commands

runCommand :: (MonadIO m, Options opts) => (opts -> [String] -> m a) -> m aSource

Retrieve getArgs, and attempt to parse it into a valid value of an Options type plus a list of left-over arguments. The options and arguments are then passed to the provided computation.

If parsing fails, this computation will print an error and call exitFailure.

If parsing succeeds, and the user has passed a --help flag, and the developer is using the default help flag definitions, then this computation will print documentation and call exitSuccess.

See runSubcommand for details on subcommand support.

Subcommands

data Subcommand cmdOpts action Source

subcommandSource

Arguments

:: (Options cmdOpts, Options subcmdOpts) 
=> String

The subcommand name.

-> (cmdOpts -> subcmdOpts -> [String] -> action)

The action to run.

-> Subcommand cmdOpts action 

runSubcommand :: (Options opts, MonadIO m) => [Subcommand opts (m a)] -> m aSource

Used to run applications that are split into subcommands.

Use subcommand to define available commands and their actions, then pass them to this computation to select one and run it. If the user specifies an invalid subcommand, this computation will print an error and call exitFailure. In handling of invalid flags or --help, runSubcommand acts like runCommand.

{-# LANGUAGE TemplateHaskell #-}

import Control.Monad (unless)
import Options

defineOptions "MainOptions" $ do
    boolOption "optQuiet" "quiet" False "Whether to be quiet."

defineOptions "HelloOpts" $ do
    stringOption "optHello" "hello" "Hello!" "How to say hello."

defineOptions "ByeOpts" $ do
    stringOption "optName" "name" "" "The user's name."

hello :: MainOptions -> HelloOpts -> [String] -> IO ()
hello mainOpts opts args = unless (optQuiet mainOpts) $ do
    putStrLn (optHello opts)

bye :: MainOptions -> ByeOpts -> [String] -> IO ()
bye mainOpts opts args = unless (optQuiet mainOpts) $ do
    putStrLn ("Good bye " ++ optName opts)

main :: IO ()
main = runSubcommand
    [ subcommand "hello" hello
    , subcommand "bye" bye
    ]
$ ./app hello
Hello!
$ ./app hello --hello='Allo!'
Allo!
$ ./app bye
Good bye 
$ ./app bye --name='John'
Good bye John

Defining options

defineOptions :: String -> OptionsM () -> Q [Dec]Source

Defines a new data type, containing fields for application or library options. The new type will be an instance of Options.

Example: this use of defineOptions:

defineOptions "MainOptions" $ do
    stringOption "optMessage" "message" "Hello world!" ""
    boolOption "optQuiet" "quiet" False ""

expands to the following definition:

data MainOptions = MainOptions
    { optMessage :: String
    , optQuiet :: Bool
    }

instance Options MainOptions

Simple option definitions

boolOptionSource

Arguments

:: String

Field name

-> String

Long flag

-> Bool

Default value

-> String

Description in --help

-> OptionsM () 

Define an option of type Bool. This is a simple wrapper around option.

stringOptionSource

Arguments

:: String

Field name

-> String

Long flag

-> String

Default value

-> String

Description in --help

-> OptionsM () 

Define an option of type String. This is a simple wrapper around option.

stringsOptionSource

Arguments

:: String

Field name

-> String

Long flag

-> [String]

Default value

-> String

Description in --help

-> OptionsM () 

Define an option of type [String]. This is a simple wrapper around option. Items are comma-separated.

textOptionSource

Arguments

:: String

Field name

-> String

Long flag

-> Text

Default value

-> String

Description in --help

-> OptionsM () 

Define an option of type Text. This is a simple wrapper around option.

textsOptionSource

Arguments

:: String

Field name

-> String

Long flag

-> [Text]

Default value

-> String

Description in --help

-> OptionsM () 

Define an option of type [Text]. This is a simple wrapper around option. Items are comma-separated.

pathOptionSource

Arguments

:: String

Field name

-> String

Long flag

-> FilePath

Default value

-> String

Description in --help

-> OptionsM () 

Define an option of type FilePath. This is a simple wrapper around option.

intOptionSource

Arguments

:: String

Field name

-> String

Long flag

-> Int

Default value

-> String

Description in --help

-> OptionsM () 

Define an option of type Int. This is a simple wrapper around option.

integerOptionSource

Arguments

:: String

Field name

-> String

Long flag

-> Integer

Default value

-> String

Description in --help

-> OptionsM () 

Define an option of type Integer. This is a simple wrapper around option.

floatOptionSource

Arguments

:: String

Field name

-> String

Long flag

-> Float

Default value

-> String

Description in --help

-> OptionsM () 

Define an option of type Float. This is a simple wrapper around option.

doubleOptionSource

Arguments

:: String

Field name

-> String

Long flag

-> Double

Default value

-> String

Description in --help

-> OptionsM () 

Define an option of type Double. This is a simple wrapper around option.

Using imported options

options :: String -> ImportedOptions a -> OptionsM ()Source

Include options defined elsewhere into the current options definition.

This is typically used by application developers to include options defined in third-party libraries. For example, the author of the "foo" library would define and export FooOptions:

module Foo (FooOptions, foo) where

import Options

defineOptions "FooOptions" $ do
    boolOption "optFrob" "frob" True "Enable frobnication."

foo :: FooOptions -> IO ()

and the author of an application would use options to let users specify --frob:

module Main where

import Options
import Foo

defineOptions "MainOptions" $ do
   boolOption "optVerbose" "verbose" False "Be really loud."
   options "optFoo" (importedOptions :: ImportedOptions FooOptions)

main :: IO ()
main = runCommand $ \opts args -> do
    foo (optFoo opts)

Use of options may be arbitrarily nested. Library authors are encouraged to aggregate their options into a single top-level type, so application authors can include it easily in their own option definitions.

Advanted option definitions

data Option a Source

optionSource

Arguments

:: String

Field name

-> (Option String -> Option a)

Option definition

-> OptionsM () 

Defines a new option in the current options type.

All options must have a field name and one or more flags. Options may also have a default value, a description, or a group.

The field name is how the option will be accessed in Haskell, and is typically prefixed with "opt". This is used to define a record field, and must be a valid Haskell field name (see defineOptions for details).

The flags are how the user specifies an option on the command line. Flags may be short or long. See optionShortFlags and optionLongFlags for details.

option "optPort" (\o -> o
    { optionLongFlags = ["port"]
    , optionDefault = "80"
    , optionType = optionTypeWord16
    }

optionShortFlags :: Option a -> [Char]Source

Short flags are a single character. When entered by a user, they are preceded by a dash and possibly other short flags.

Short flags must be a letter or a number.

Example: An option with optionShortFlags = ['p'] may be set using:

$ ./app -p 443
$ ./app -p443

optionLongFlags :: Option a -> [String]Source

Long flags are multiple characters. When entered by a user, they are preceded by two dashes.

Long flags may contain letters, numbers, '-', and '_'.

Example: An option with optionLongFlags = ["port"] may be set using:

$ ./app --port 443
$ ./app --port=443

optionDefault :: Option a -> StringSource

Options may have a default value. This will be parsed as if the user had entered it on the command line.

optionType :: Option a -> OptionType aSource

There are many types which an application or library might want to use when designing their options. By default, options are strings, but optionType may be set to any supported type. See the "Option types" section for a list of supported types.

optionDescription :: Option a -> StringSource

An option's description is used with the default implementation of --help. It should be a short string describing what the option does.

optionGroup :: Option a -> GroupSource

Which group the option is in. See the "Option groups" section for details.

Option types

data OptionType a Source

An option's type determines how the option will be parsed, and which Haskell type the parsed value will be stored as. There are many types available, covering most basic types and a few more advanced types.

optionTypeBool :: OptionType BoolSource

Store an option as a Bool. The option's value must be either "true" or "false".

Boolean options are unary, which means that their value is optional when specified on the command line. If a flag is present, the option is set to True.

$ ./app -q
$ ./app --quiet

Boolean options may still be specified explicitly by using long flags with the --flag=value format. This is the only way to set a unary flag to "false".

$ ./app --quiet=true
$ ./app --quiet=false

optionTypeString :: OptionType StringSource

Store an option value as a String. The value is decoded to Unicode first, if needed. The value may contain non-Unicode bytes, in which case they will be stored using GHC 7.4's encoding for mixed-use strings.

optionTypeText :: OptionType TextSource

Store an option value as a Text. The value is decoded to Unicode first, if needed. If the value cannot be decoded, the stored value may have the Unicode substitution character '\65533' in place of some of the original input.

optionTypeFilePath :: OptionType FilePathSource

Store an option value as a FilePath.

optionTypeInt :: OptionType IntSource

Store an option as an Int. The option value must be an integer n such that minBound <= n <= maxBound.

optionTypeInt8 :: OptionType Int8Source

Store an option as an Int8. The option value must be an integer n such that minBound <= n <= maxBound.

optionTypeInt16 :: OptionType Int16Source

Store an option as an Int16. The option value must be an integer n such that minBound <= n <= maxBound.

optionTypeInt32 :: OptionType Int32Source

Store an option as an Int32. The option value must be an integer n such that minBound <= n <= maxBound.

optionTypeInt64 :: OptionType Int64Source

Store an option as an Int64. The option value must be an integer n such that minBound <= n <= maxBound.

optionTypeWord :: OptionType WordSource

Store an option as a Word. The option value must be a positive integer n such that 0 <= n <= maxBound.

optionTypeWord8 :: OptionType Word8Source

Store an option as a Word8. The option value must be a positive integer n such that 0 <= n <= maxBound.

optionTypeWord16 :: OptionType Word16Source

Store an option as a Word16. The option value must be a positive integer n such that 0 <= n <= maxBound.

optionTypeWord32 :: OptionType Word32Source

Store an option as a Word32. The option value must be a positive integer n such that 0 <= n <= maxBound.

optionTypeWord64 :: OptionType Word64Source

Store an option as a Word64. The option value must be a positive integer n such that 0 <= n <= maxBound.

optionTypeInteger :: OptionType IntegerSource

Store an option as an Integer. The option value must be an integer. There is no minimum or maximum value.

optionTypeFloat :: OptionType FloatSource

Store an option as a Float. The option value must be a number. Due to the imprecision of floating-point math, the stored value might not exactly match the user's input. If the user's input is out of range for the Float type, it will be stored as Infinity or -Infinity.

optionTypeDouble :: OptionType DoubleSource

Store an option as a Double. The option value must be a number. Due to the imprecision of floating-point math, the stored value might not exactly match the user's input. If the user's input is out of range for the Double type, it will be stored as Infinity or -Infinity.

optionTypeMaybe :: OptionType a -> OptionType (Maybe a)Source

Store an option as a Maybe of another type. The value will be Nothing if the option was not provided or is an empty string.

option "optTimeout" (\o -> o
    { optionLongFlags = ["timeout"]
    , optionType = optionTypeMaybe optionTypeInt
    })

optionTypeListSource

Arguments

:: Char

Element separator

-> OptionType a

Element type

-> OptionType [a] 

Store an option as a list, using another option type for the elements. The separator should be a character that will not occur within the values, such as a comma or semicolon.

option "optNames" (\o -> o
    { optionLongFlags = ["names"]
    , optionDefault = "Alice;Bob;Charles"
    , optionType = optionTypeList ';' optionTypeString
    })

optionTypeSetSource

Arguments

:: Ord a 
=> Char

Element separator

-> OptionType a

Element type

-> OptionType (Set a) 

Store an option as a Set, using another option type for the elements. The separator should be a character that will not occur within the values, such as a comma or semicolon.

Duplicate elements in the input are permitted.

option "optNames" (\o -> o
    { optionLongFlags = ["names"]
    , optionDefault = "Alice;Bob;Charles"
    , optionType = optionTypeSet ';' optionTypeString
    })

optionTypeMapSource

Arguments

:: Ord k 
=> Char

Item separator

-> Char

Key/Value separator

-> OptionType k

Key type

-> OptionType v

Value type

-> OptionType (Map k v) 

Store an option as a Map, using other option types for the keys and values.

The item separator is used to separate key/value pairs from eachother. It should be a character that will not occur within either the keys or values.

The value separator is used to separate the key from the value. It should be a character that will not occur within the keys. It may occur within the values.

Duplicate keys in the input are permitted. The final value for each key is stored.

option "optNames" (\o -> o
    { optionLongFlags = ["names"]
    , optionDefault = "name=Alice;hometown=Bucharest"
    , optionType = optionTypeMap ';' '=' optionTypeString optionTypeString
    })

optionTypeEnum :: Enum a => Name -> [(String, a)] -> OptionType aSource

Store an option as one of a set of enumerated values. The option type must be defined in a separate file.

-- MyApp/Types.hs
data Mode = ModeFoo | ModeBar
    deriving (Enum)
 -- Main.hs
import MyApp.Types

defineOptions "MainOptions" $ do
    option "optMode" (\o -> o
        { optionLongFlags = ["mode"]
        , optionDefault = "foo"
        , optionType = optionTypeEnum ''Mode
            [ ("foo", ModeFoo)
            , ("bar", ModeBar)
            ]
        })
$ ./app
Running in mode ModeFoo
$ ./app --mode=bar
Running in mode ModeBar

Option groups

groupSource

Arguments

:: String

Group name

-> (Group -> Group) 
-> Group 

Define an option group.

Option groups are used to make long --help output more readable, by hiding obscure or rarely-used options from the main summary.

If an option is in a group named "examples", it will only be shown in the help output if the user provides the flag --help-examples or --help-all. The flag --help-all will show all options, in all groups.

groupTitle :: Group -> StringSource

A short title for the group, which is used when printing --help output.

groupDescription :: Group -> StringSource

A description of the group, which is used when printing --help output.

Parsing argument lists

parsedError :: Parsed a => a -> Maybe StringSource

Get the error that prevented options from being parsed from argv, or Nothing if no error was detected.

parsedHelp :: Parsed a => a -> StringSource

Get a help message to show the user. If the arguments included a help flag, this will be a message appropriate to that flag. Otherwise, it is a summary (equivalent to --help).

This is always a non-empty string, regardless of whether the parse succeeded or failed. If you need to perform additional validation on the options value, this message can be displayed if validation fails.

Parsing options

parsedOptions :: ParsedOptions opts -> Maybe optsSource

Get the options value that was parsed from argv, or Nothing if the arguments could not be converted into options.

Note: This function return Nothing if the user provided a help flag. To check whether an error occured during parsing, check the value of parsedError.

parsedArguments :: ParsedOptions opts -> [String]Source

Get command-line arguments remaining after parsing options. The arguments are unchanged from the original argument list, and have not been decoded or otherwise transformed.

parseOptions :: Options opts => [String] -> ParsedOptions optsSource

Attempt to convert a list of command-line arguments into an options value. This can be used by application developers who want finer control over error handling, or who want to perform additional validation on the options value.

The argument list must be in the same encoding as the result of getArgs.

Use parsedOptions, parsedArguments, parsedError, and parsedHelp to inspect the result of parseOptions.

Example:

getOptionsOrDie :: Options a => IO a
getOptionsOrDie = do
    argv <- System.Environment.getArgs
    let parsed = parseOptions argv
    case parsedOptions parsed of
        Just opts -> return opts
        Nothing -> case parsedError parsed of
            Just err -> do
                hPutStrLn stderr (parsedHelp parsed)
                hPutStrLn stderr err
                exitFailure
            Nothing -> do
                hPutStr stdout (parsedHelp parsed)
                exitSuccess

Parsing subcommands

parsedSubcommand :: ParsedSubcommand action -> Maybe actionSource

Get the subcommand action that was parsed from argv, or Nothing if the arguments could not be converted into a valid action.

Note: This function return Nothing if the user provided a help flag. To check whether an error occured during parsing, check the value of parsedError.

parseSubcommand :: Options cmdOpts => [Subcommand cmdOpts action] -> [String] -> ParsedSubcommand actionSource

Attempt to convert a list of command-line arguments into a subcommand action. This can be used by application developers who want finer control over error handling, or who want subcommands that run in an unusual monad.

The argument list must be in the same encoding as the result of getArgs.

Use parsedSubcommand, parsedError, and parsedHelp to inspect the result of parseSubcommand.

Example:

runSubcommand :: Options cmdOpts => [Subcommand cmdOpts (IO a)] -> IO a
runSubcommand subcommands = do
    argv <- System.Environment.getArgs
    let parsed = parseSubcommand subcommands argv
    case parsedSubcommand parsed of
        Just cmd -> cmd
        Nothing -> case parsedError parsed of
            Just err -> do
                hPutStrLn stderr (parsedHelp parsed)
                hPutStrLn stderr err
                exitFailure
            Nothing -> do
                hPutStr stdout (parsedHelp parsed)
                exitSuccess