System.Console.GetOpt (original) (raw)

getOpt :: ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String]) Source #

Process the command-line, and return the list of values that matched (and those that didn't). The arguments are:

[getOpt](System-Console-GetOpt.html#v:getOpt "System.Console.GetOpt") returns a triple consisting of the option arguments, a list of non-options, and a list of error messages.

usageInfo :: String -> [OptDescr a] -> String Source #

Return a string describing the usage of a command, derived from the header (first argument) and the options described by the second argument.

data OptDescr a Source #

Each [OptDescr](System-Console-GetOpt.html#t:OptDescr "System.Console.GetOpt") describes a single option.

The arguments to [Option](System-Console-GetOpt.html#v:Option "System.Console.GetOpt") are:

data ArgDescr a Source #

Describes whether an option takes an argument or not, and if so how the argument is injected into a value of type a.

Examples

To hopefully illuminate the role of the different data structures, here are the command-line options for a (very simple) compiler, done in two different ways. The difference arises because the type of [getOpt](System-Console-GetOpt.html#v:getOpt "System.Console.GetOpt") is parameterized by the type of values derived from flags.

Interpreting flags as concrete values

A simple choice for the type associated with flags is to define a typeFlag as an algebraic type representing the possible flags and their arguments:

module Opts1 where

import System.Console.GetOpt import Data.Maybe ( fromMaybe )

data Flag = Verbose | Version | Input String | Output String | LibDir String deriving Show

options :: [OptDescr Flag] options = [ Option ['v'] ["verbose"] (NoArg Verbose) "chatty output on stderr" , Option ['V','?'] ["version"] (NoArg Version) "show version number" , Option ['o'] ["output"] (OptArg outp "FILE") "output FILE" , Option ['c'] [] (OptArg inp "FILE") "input FILE" , Option ['L'] ["libdir"] (ReqArg LibDir "DIR") "library directory" ]

inp,outp :: Maybe String -> Flag outp = Output . fromMaybe "stdout" inp = Input . fromMaybe "stdin"

compilerOpts :: [String] -> IO ([Flag], [String]) compilerOpts argv = case getOpt Permute options argv of (o,n,[] ) -> return (o,n) (,,errs) -> ioError (userError (concat errs ++ usageInfo header options)) where header = "Usage: ic [OPTION...] files..."

Then the rest of the program will use the constructed list of flags to determine it's behaviour.

Interpreting flags as transformations of an options record

A different approach is to group the option values in a record of typeOptions, and have each flag yield a function of typeOptions -> Options transforming this record.

module Opts2 where

import System.Console.GetOpt import Data.Maybe ( fromMaybe )

data Options = Options { optVerbose :: Bool , optShowVersion :: Bool , optOutput :: Maybe FilePath , optInput :: Maybe FilePath , optLibDirs :: [FilePath] } deriving Show

defaultOptions = Options { optVerbose = False , optShowVersion = False , optOutput = Nothing , optInput = Nothing , optLibDirs = [] }

options :: [OptDescr (Options -> Options)] options = [ Option ['v'] ["verbose"] (NoArg (\ opts -> opts { optVerbose = True })) "chatty output on stderr" , Option ['V','?'] ["version"] (NoArg (\ opts -> opts { optShowVersion = True })) "show version number" , Option ['o'] ["output"] (OptArg ((\ f opts -> opts { optOutput = Just f }) . fromMaybe "output") "FILE") "output FILE" , Option ['c'] [] (OptArg ((\ f opts -> opts { optInput = Just f }) . fromMaybe "input") "FILE") "input FILE" , Option ['L'] ["libdir"] (ReqArg (\ d opts -> opts { optLibDirs = optLibDirs opts ++ [d] }) "DIR") "library directory" ]

compilerOpts :: [String] -> IO (Options, [String]) compilerOpts argv = case getOpt Permute options argv of (o,n,[] ) -> return (foldl (flip id) defaultOptions o, n) (,,errs) -> ioError (userError (concat errs ++ usageInfo header options)) where header = "Usage: ic [OPTION...] files..."

Similarly, each flag could yield a monadic function transforming a record, of type Options -> IO Options (or any other monad), allowing option processing to perform actions of the chosen monad, e.g. printing help or version messages, checking that file arguments exist, etc.