{-# LANGUAGE Safe #-}------------------------------------------------------------------------------- |-- Module : System.Console.GetOpt-- Copyright : (c) Sven Panne 2002-2005-- License : BSD-style (see the file libraries/base/LICENSE)---- Maintainer : libraries@haskell.org-- Stability : stable-- Portability : portable---- This module provides facilities for parsing the command-line options-- in a standalone program. It is essentially a Haskell port of the GNU-- @getopt@ library.-------------------------------------------------------------------------------{-
Sven Panne <Sven.Panne@informatik.uni-muenchen.de> Oct. 1996 (small
changes Dec. 1997)
Two rather obscure features are missing: The Bash 2.0 non-option hack
(if you don't already know it, you probably don't want to hear about
it...) and the recognition of long options with a single dash
(e.g. '-help' is recognised as '--help', as long as there is no short
option 'h').
Other differences between GNU's getopt and this implementation:
* To enforce a coherent description of options and arguments, there
 are explanation fields in the option/argument descriptor.
* Error messages are now more informative, but no longer POSIX
 compliant... :-(
And a final Haskell advertisement: The GNU C implementation uses well
over 1100 lines, we need only 195 here, including a 46 line example!
:-)
-}moduleSystem.Console.GetOpt (-- * GetOptgetOpt ,getOpt' ,usageInfo ,ArgOrder (..),OptDescr (..),ArgDescr (..),-- * 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' is-- parameterized by the type of values derived from flags.-- ** Interpreting flags as concrete values-- $example1-- ** Interpreting flags as transformations of an options record-- $example2)whereimportPrelude importGHC.Internal.Data.List (isPrefixOf ,find )-- |What to do with options following non-optionsdataArgOrder a =RequireOrder -- ^ no option processing after first non-option|Permute -- ^ freely intersperse options and non-options|ReturnInOrder (String ->a )-- ^ wrap non-options into options{-|
Each 'OptDescr' describes a single option.
The arguments to 'Option' are:
* list of short option characters
* list of long option strings (without \"--\")
* argument descriptor
* explanation of option for user
-}dataOptDescr a =-- description of a single options:Option [Char ]-- list of short option characters[String ]-- list of long option strings (without "--")(ArgDescr a )-- argument descriptorString -- explanation of option for user-- |Describes whether an option takes an argument or not, and if so-- how the argument is injected into a value of type @a@.dataArgDescr a =NoArg a -- ^ no argument expected|ReqArg (String ->a )String -- ^ option requires argument|OptArg (Maybe String ->a )String -- ^ optional argument-- | @since 4.7.0.0instanceFunctor ArgOrder wherefmap :: forall a b. (a -> b) -> ArgOrder a -> ArgOrder b
fmap a -> b
_ArgOrder a
RequireOrder =ArgOrder b
forall a. ArgOrder a
RequireOrder fmap a -> b
_ArgOrder a
Permute =ArgOrder b
forall a. ArgOrder a
Permute fmap a -> b
f (ReturnInOrder String -> a
g )=(String -> b) -> ArgOrder b
forall a. (String -> a) -> ArgOrder a
ReturnInOrder (a -> b
f (a -> b) -> (String -> a) -> String -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a
g )-- | @since 4.7.0.0instanceFunctor OptDescr wherefmap :: forall a b. (a -> b) -> OptDescr a -> OptDescr b
fmap a -> b
f (Option String
a [String]
b ArgDescr a
argDescr String
c )=String -> [String] -> ArgDescr b -> String -> OptDescr b
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
a [String]
b ((a -> b) -> ArgDescr a -> ArgDescr b
forall a b. (a -> b) -> ArgDescr a -> ArgDescr b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f ArgDescr a
argDescr )String
c -- | @since 4.7.0.0instanceFunctor ArgDescr wherefmap :: forall a b. (a -> b) -> ArgDescr a -> ArgDescr b
fmap a -> b
f (NoArg a
a )=b -> ArgDescr b
forall a. a -> ArgDescr a
NoArg (a -> b
f a
a )fmap a -> b
f (ReqArg String -> a
g String
s )=(String -> b) -> String -> ArgDescr b
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (a -> b
f (a -> b) -> (String -> a) -> String -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a
g )String
s fmap a -> b
f (OptArg Maybe String -> a
g String
s )=(Maybe String -> b) -> String -> ArgDescr b
forall a. (Maybe String -> a) -> String -> ArgDescr a
OptArg (a -> b
f (a -> b) -> (Maybe String -> a) -> Maybe String -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> a
g )String
s dataOptKind a -- kind of cmd line arg (internal use only):=Opt a -- an option|UnreqOpt String -- an un-recognized option|NonOpt String -- a non-option|EndOfOpts -- end-of-options marker (i.e. "--")|OptErr String -- something went wrong...-- | Return a string describing the usage of a command, derived from-- the header (first argument) and the options described by the-- second argument.usageInfo ::String -- header->[OptDescr a ]-- option descriptors->String -- nicely formatted description of optionsusageInfo :: forall a. String -> [OptDescr a] -> String
usageInfo String
header [OptDescr a]
optDescr =[String] -> String
unlines (String
header String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
table )where([String]
ss ,[String]
ls ,[String]
ds )=([(String, String, String)] -> ([String], [String], [String])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(String, String, String)] -> ([String], [String], [String]))
-> ([OptDescr a] -> [(String, String, String)])
-> [OptDescr a]
-> ([String], [String], [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OptDescr a -> [(String, String, String)])
-> [OptDescr a] -> [(String, String, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap OptDescr a -> [(String, String, String)]
forall a. OptDescr a -> [(String, String, String)]
fmtOpt )[OptDescr a]
optDescr table :: [String]
table =(String -> String -> String -> String)
-> [String] -> [String] -> [String] -> [String]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 String -> String -> String -> String
paste ([String] -> [String]
sameLen [String]
ss )([String] -> [String]
sameLen [String]
ls )[String]
ds paste :: String -> String -> String -> String
paste String
x String
y String
z =String
" "String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
z sameLen :: [String] -> [String]
sameLen [String]
xs =Int -> [String] -> [String]
flushLeft (([Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> ([String] -> [Int]) -> [String] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length )[String]
xs )[String]
xs flushLeft :: Int -> [String] -> [String]
flushLeft Int
n [String]
xs =[Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
n (String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. a -> [a]
repeat Char
' ')|String
x <-[String]
xs ]fmtOpt ::OptDescr a ->[(String ,String ,String )]fmtOpt :: forall a. OptDescr a -> [(String, String, String)]
fmtOpt (Option String
sos [String]
los ArgDescr a
ad String
descr )=caseString -> [String]
lines String
descr of[]->[(String
sosFmt ,String
losFmt ,String
"")](String
d : [String]
ds )->(String
sosFmt ,String
losFmt ,String
d )(String, String, String)
-> [(String, String, String)] -> [(String, String, String)]
forall a. a -> [a] -> [a]
: [(String
"",String
"",String
d' )|String
d' <-[String]
ds ]wheresepBy :: Char -> [String] -> String
sepBy Char
_[]=String
""sepBy Char
_[String
x ]=String
x sepBy Char
ch (String
x : [String]
xs )=String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
ch Char -> String -> String
forall a. a -> [a] -> [a]
: Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
: Char -> [String] -> String
sepBy Char
ch [String]
xs sosFmt :: String
sosFmt =Char -> [String] -> String
sepBy Char
','((Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ArgDescr a -> Char -> String
forall a. ArgDescr a -> Char -> String
fmtShort ArgDescr a
ad )String
sos )losFmt :: String
losFmt =Char -> [String] -> String
sepBy Char
','((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ArgDescr a -> String -> String
forall a. ArgDescr a -> String -> String
fmtLong ArgDescr a
ad )[String]
los )fmtShort ::ArgDescr a ->Char ->String fmtShort :: forall a. ArgDescr a -> Char -> String
fmtShort (NoArg a
_)Char
so =String
"-"String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
so ]fmtShort (ReqArg String -> a
_String
ad )Char
so =String
"-"String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
so ]String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ad fmtShort (OptArg Maybe String -> a
_String
ad )Char
so =String
"-"String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
so ]String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"["String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ad String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"fmtLong ::ArgDescr a ->String ->String fmtLong :: forall a. ArgDescr a -> String -> String
fmtLong (NoArg a
_)String
lo =String
"--"String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
lo fmtLong (ReqArg String -> a
_String
ad )String
lo =String
"--"String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
lo String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"="String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ad fmtLong (OptArg Maybe String -> a
_String
ad )String
lo =String
"--"String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
lo String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"[="String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ad String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"{-|
Process the command-line, and return the list of values that matched
(and those that didn\'t). The arguments are:
* The order requirements (see 'ArgOrder')
* The option descriptions (see 'OptDescr')
* The actual command line arguments (presumably got from
 'GHC.Internal.System.Environment.getArgs').
'getOpt' returns a triple consisting of the option arguments, a list
of non-options, and a list of error messages.
-}getOpt ::ArgOrder a -- non-option handling->[OptDescr a ]-- option descriptors->[String ]-- the command-line arguments->([a ],[String ],[String ])-- (options,non-options,error messages)getOpt :: forall a.
ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
getOpt ArgOrder a
ordering [OptDescr a]
optDescr [String]
args =([a]
os ,[String]
xs ,[String]
es [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
errUnrec [String]
us )where([a]
os ,[String]
xs ,[String]
us ,[String]
es )=ArgOrder a
-> [OptDescr a] -> [String] -> ([a], [String], [String], [String])
forall a.
ArgOrder a
-> [OptDescr a] -> [String] -> ([a], [String], [String], [String])
getOpt' ArgOrder a
ordering [OptDescr a]
optDescr [String]
args {-|
This is almost the same as 'getOpt', but returns a quadruple
consisting of the option arguments, a list of non-options, a list of
unrecognized options, and a list of error messages.
-}getOpt' ::ArgOrder a -- non-option handling->[OptDescr a ]-- option descriptors->[String ]-- the command-line arguments->([a ],[String ],[String ],[String ])-- (options,non-options,unrecognized,error messages)getOpt' :: forall a.
ArgOrder a
-> [OptDescr a] -> [String] -> ([a], [String], [String], [String])
getOpt' ArgOrder a
_[OptDescr a]
_[]=([],[],[],[])getOpt' ArgOrder a
ordering [OptDescr a]
optDescr (String
arg : [String]
args )=OptKind a -> ArgOrder a -> ([a], [String], [String], [String])
procNextOpt OptKind a
opt ArgOrder a
ordering whereprocNextOpt :: OptKind a -> ArgOrder a -> ([a], [String], [String], [String])
procNextOpt (Opt a
o )ArgOrder a
_=(a
o a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
os ,[String]
xs ,[String]
us ,[String]
es )procNextOpt (UnreqOpt String
u )ArgOrder a
_=([a]
os ,[String]
xs ,String
u String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
us ,[String]
es )procNextOpt (NonOpt String
x )ArgOrder a
RequireOrder =([],String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
rest ,[],[])procNextOpt (NonOpt String
x )ArgOrder a
Permute =([a]
os ,String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
xs ,[String]
us ,[String]
es )procNextOpt (NonOpt String
x )(ReturnInOrder String -> a
f )=(String -> a
f String
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
os ,[String]
xs ,[String]
us ,[String]
es )procNextOpt OptKind a
EndOfOpts ArgOrder a
RequireOrder =([],[String]
rest ,[],[])procNextOpt OptKind a
EndOfOpts ArgOrder a
Permute =([],[String]
rest ,[],[])procNextOpt OptKind a
EndOfOpts (ReturnInOrder String -> a
f )=((String -> a) -> [String] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map String -> a
f [String]
rest ,[],[],[])procNextOpt (OptErr String
e )ArgOrder a
_=([a]
os ,[String]
xs ,[String]
us ,String
e String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
es )(OptKind a
opt ,[String]
rest )=String -> [String] -> [OptDescr a] -> (OptKind a, [String])
forall a.
String -> [String] -> [OptDescr a] -> (OptKind a, [String])
getNext String
arg [String]
args [OptDescr a]
optDescr ([a]
os ,[String]
xs ,[String]
us ,[String]
es )=ArgOrder a
-> [OptDescr a] -> [String] -> ([a], [String], [String], [String])
forall a.
ArgOrder a
-> [OptDescr a] -> [String] -> ([a], [String], [String], [String])
getOpt' ArgOrder a
ordering [OptDescr a]
optDescr [String]
rest -- take a look at the next cmd line arg and decide what to do with itgetNext ::String ->[String ]->[OptDescr a ]->(OptKind a ,[String ])getNext :: forall a.
String -> [String] -> [OptDescr a] -> (OptKind a, [String])
getNext (Char
'-': Char
'-': [])[String]
rest [OptDescr a]
_=(OptKind a
forall a. OptKind a
EndOfOpts ,[String]
rest )getNext (Char
'-': Char
'-': String
xs )[String]
rest [OptDescr a]
optDescr =String -> [String] -> [OptDescr a] -> (OptKind a, [String])
forall a.
String -> [String] -> [OptDescr a] -> (OptKind a, [String])
longOpt String
xs [String]
rest [OptDescr a]
optDescr getNext (Char
'-': Char
x : String
xs )[String]
rest [OptDescr a]
optDescr =Char -> String -> [String] -> [OptDescr a] -> (OptKind a, [String])
forall a.
Char -> String -> [String] -> [OptDescr a] -> (OptKind a, [String])
shortOpt Char
x String
xs [String]
rest [OptDescr a]
optDescr getNext String
a [String]
rest [OptDescr a]
_=(String -> OptKind a
forall a. String -> OptKind a
NonOpt String
a ,[String]
rest )-- handle long optionlongOpt ::String ->[String ]->[OptDescr a ]->(OptKind a ,[String ])longOpt :: forall a.
String -> [String] -> [OptDescr a] -> (OptKind a, [String])
longOpt String
ls [String]
rs [OptDescr a]
optDescr =[ArgDescr a] -> String -> [String] -> (OptKind a, [String])
long [ArgDescr a]
ads String
arg [String]
rs where(String
opt ,String
arg )=(Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=')String
ls getWith :: (String -> String -> Bool) -> [OptDescr a]
getWith String -> String -> Bool
p =[OptDescr a
o |o :: OptDescr a
o @(Option String
_[String]
xs ArgDescr a
_String
_)<-[OptDescr a]
optDescr ,(String -> Bool) -> [String] -> Maybe String
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (String -> String -> Bool
p String
opt )[String]
xs Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe String
forall a. Maybe a
Nothing ]exact :: [OptDescr a]
exact =(String -> String -> Bool) -> [OptDescr a]
getWith String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) options :: [OptDescr a]
options =if[OptDescr a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OptDescr a]
exact then(String -> String -> Bool) -> [OptDescr a]
getWith String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf else[OptDescr a]
exact ads :: [ArgDescr a]
ads =[ArgDescr a
ad |Option String
_[String]
_ArgDescr a
ad String
_<-[OptDescr a]
options ]optStr :: String
optStr =(String
"--"String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
opt )long :: [ArgDescr a] -> String -> [String] -> (OptKind a, [String])
long (ArgDescr a
_: ArgDescr a
_: [ArgDescr a]
_)String
_[String]
rest =([OptDescr a] -> String -> OptKind a
forall a. [OptDescr a] -> String -> OptKind a
errAmbig [OptDescr a]
options String
optStr ,[String]
rest )long [NoArg a
a ][][String]
rest =(a -> OptKind a
forall a. a -> OptKind a
Opt a
a ,[String]
rest )long [NoArg a
_](Char
'=': String
_)[String]
rest =(String -> OptKind a
forall a. String -> OptKind a
errNoArg String
optStr ,[String]
rest )long [ReqArg String -> a
_String
d ][][]=(String -> String -> OptKind a
forall a. String -> String -> OptKind a
errReq String
d String
optStr ,[])long [ReqArg String -> a
f String
_][](String
r : [String]
rest )=(a -> OptKind a
forall a. a -> OptKind a
Opt (String -> a
f String
r ),[String]
rest )long [ReqArg String -> a
f String
_](Char
'=': String
xs )[String]
rest =(a -> OptKind a
forall a. a -> OptKind a
Opt (String -> a
f String
xs ),[String]
rest )long [OptArg Maybe String -> a
f String
_][][String]
rest =(a -> OptKind a
forall a. a -> OptKind a
Opt (Maybe String -> a
f Maybe String
forall a. Maybe a
Nothing ),[String]
rest )long [OptArg Maybe String -> a
f String
_](Char
'=': String
xs )[String]
rest =(a -> OptKind a
forall a. a -> OptKind a
Opt (Maybe String -> a
f (String -> Maybe String
forall a. a -> Maybe a
Just String
xs )),[String]
rest )long [ArgDescr a]
_String
_[String]
rest =(String -> OptKind a
forall a. String -> OptKind a
UnreqOpt (String
"--"String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ls ),[String]
rest )-- handle short optionshortOpt ::Char ->String ->[String ]->[OptDescr a ]->(OptKind a ,[String ])shortOpt :: forall a.
Char -> String -> [String] -> [OptDescr a] -> (OptKind a, [String])
shortOpt Char
y String
ys [String]
rs [OptDescr a]
optDescr =[ArgDescr a] -> String -> [String] -> (OptKind a, [String])
short [ArgDescr a]
ads String
ys [String]
rs whereoptions :: [OptDescr a]
options =[OptDescr a
o |o :: OptDescr a
o @(Option String
ss [String]
_ArgDescr a
_String
_)<-[OptDescr a]
optDescr ,Char
s <-String
ss ,Char
y Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
s ]ads :: [ArgDescr a]
ads =[ArgDescr a
ad |Option String
_[String]
_ArgDescr a
ad String
_<-[OptDescr a]
options ]optStr :: String
optStr =Char
'-'Char -> String -> String
forall a. a -> [a] -> [a]
: [Char
y ]short :: [ArgDescr a] -> String -> [String] -> (OptKind a, [String])
short (ArgDescr a
_: ArgDescr a
_: [ArgDescr a]
_)String
_[String]
rest =([OptDescr a] -> String -> OptKind a
forall a. [OptDescr a] -> String -> OptKind a
errAmbig [OptDescr a]
options String
optStr ,[String]
rest )short (NoArg a
a : [ArgDescr a]
_)[][String]
rest =(a -> OptKind a
forall a. a -> OptKind a
Opt a
a ,[String]
rest )short (NoArg a
a : [ArgDescr a]
_)String
xs [String]
rest =(a -> OptKind a
forall a. a -> OptKind a
Opt a
a ,(Char
'-'Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs )String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
rest )short (ReqArg String -> a
_String
d : [ArgDescr a]
_)[][]=(String -> String -> OptKind a
forall a. String -> String -> OptKind a
errReq String
d String
optStr ,[])short (ReqArg String -> a
f String
_: [ArgDescr a]
_)[](String
r : [String]
rest )=(a -> OptKind a
forall a. a -> OptKind a
Opt (String -> a
f String
r ),[String]
rest )short (ReqArg String -> a
f String
_: [ArgDescr a]
_)String
xs [String]
rest =(a -> OptKind a
forall a. a -> OptKind a
Opt (String -> a
f String
xs ),[String]
rest )short (OptArg Maybe String -> a
f String
_: [ArgDescr a]
_)[][String]
rest =(a -> OptKind a
forall a. a -> OptKind a
Opt (Maybe String -> a
f Maybe String
forall a. Maybe a
Nothing ),[String]
rest )short (OptArg Maybe String -> a
f String
_: [ArgDescr a]
_)String
xs [String]
rest =(a -> OptKind a
forall a. a -> OptKind a
Opt (Maybe String -> a
f (String -> Maybe String
forall a. a -> Maybe a
Just String
xs )),[String]
rest )short [][][String]
rest =(String -> OptKind a
forall a. String -> OptKind a
UnreqOpt String
optStr ,[String]
rest )short []String
xs [String]
rest =(String -> OptKind a
forall a. String -> OptKind a
UnreqOpt String
optStr ,(Char
'-'Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs )String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
rest )-- miscellaneous error formattingerrAmbig ::[OptDescr a ]->String ->OptKind a errAmbig :: forall a. [OptDescr a] -> String -> OptKind a
errAmbig [OptDescr a]
ods String
optStr =String -> OptKind a
forall a. String -> OptKind a
OptErr (String -> [OptDescr a] -> String
forall a. String -> [OptDescr a] -> String
usageInfo String
header [OptDescr a]
ods )whereheader :: String
header =String
"option `"String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
optStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' is ambiguous; could be one of:"errReq ::String ->String ->OptKind a errReq :: forall a. String -> String -> OptKind a
errReq String
d String
optStr =String -> OptKind a
forall a. String -> OptKind a
OptErr (String
"option `"String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
optStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' requires an argument "String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n")errUnrec ::String ->String errUnrec :: String -> String
errUnrec String
optStr =String
"unrecognized option `"String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
optStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'\n"errNoArg ::String ->OptKind a errNoArg :: forall a. String -> OptKind a
errNoArg String
optStr =String -> OptKind a
forall a. String -> OptKind a
OptErr (String
"option `"String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
optStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' doesn't allow an argument\n"){-
-----------------------------------------------------------------------------------------
-- and here a small and hopefully enlightening example:
data Flag = Verbose | Version | Name String | Output String | Arg String deriving Show
options :: [OptDescr Flag]
options =
 [Option ['v'] ["verbose"] (NoArg Verbose) "verbosely list files",
 Option ['V','?'] ["version","release"] (NoArg Version) "show version info",
 Option ['o'] ["output"] (OptArg out "FILE") "use FILE for dump",
 Option ['n'] ["name"] (ReqArg Name "USER") "only dump USER's files"]
out :: Maybe String -> Flag
out Nothing = Output "stdout"
out (Just o) = Output o
test :: ArgOrder Flag -> [String] -> String
test order cmdline = case getOpt order options cmdline of
 (o,n,[] ) -> "options=" ++ show o ++ " args=" ++ show n ++ "\n"
 (_,_,errs) -> concat errs ++ usageInfo header options
 where header = "Usage: foobar [OPTION...] files..."
-- example runs:
-- putStr (test RequireOrder ["foo","-v"])
-- ==> options=[] args=["foo", "-v"]
-- putStr (test Permute ["foo","-v"])
-- ==> options=[Verbose] args=["foo"]
-- putStr (test (ReturnInOrder Arg) ["foo","-v"])
-- ==> options=[Arg "foo", Verbose] args=[]
-- putStr (test Permute ["foo","--","-v"])
-- ==> options=[] args=["foo", "-v"]
-- putStr (test Permute ["-?o","--name","bar","--na=baz"])
-- ==> options=[Version, Output "stdout", Name "bar", Name "baz"] args=[]
-- putStr (test Permute ["--ver","foo"])
-- ==> option `--ver' is ambiguous; could be one of:
-- -v --verbose verbosely list files
-- -V, -? --version, --release show version info
-- Usage: foobar [OPTION...] files...
-- -v --verbose verbosely list files
-- -V, -? --version, --release show version info
-- -o[FILE] --output[=FILE] use FILE for dump
-- -n USER --name=USER only dump USER's files
-----------------------------------------------------------------------------------------
-}{- $example1
A simple choice for the type associated with flags is to define a type
@Flag@ as an algebraic type representing the possible flags and their
arguments:
> module Opts1 where
>
> import System.Console.GetOpt
> import GHC.Internal.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.
-}{- $example2
A different approach is to group the option values in a record of type
@Options@, and have each flag yield a function of type
@Options -> Options@ transforming this record.
> module Opts2 where
>
> import System.Console.GetOpt
> import GHC.Internal.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.
-}