-----------------------------------------------------------------------------
-- |
-- Module : System.Console.GetOpt
--- Copyright : (c) Sven Panne Oct. 1996 (small changes Feb. 2003)
+-- Copyright : (c) Sven Panne 2002-2005
-- License : BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer : libraries@haskell.org
-}
module System.Console.GetOpt (
- -- * GetOpt
- getOpt,
- usageInfo,
- ArgOrder(..),
- OptDescr(..),
- ArgDescr(..),
+ -- * GetOpt
+ getOpt, getOpt',
+ usageInfo,
+ ArgOrder(..),
+ OptDescr(..),
+ ArgDescr(..),
- -- * Example
-
- -- $example
- ) where
+ -- * Examples
-import Prelude
-import Data.List ( isPrefixOf )
+ -- |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
+) where
+
+import Prelude -- necessary to get dependencies right
+
+import Data.List ( isPrefixOf, find )
-- |What to do with options following non-options
data ArgOrder a
data OptKind 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...
-> [OptDescr a] -- option descriptors
-> String -- nicely formatted decription of options
usageInfo header optDescr = unlines (header:table)
- where (ss,ls,ds) = (unzip3 . map fmtOpt) optDescr
+ where (ss,ls,ds) = (unzip3 . concatMap fmtOpt) optDescr
table = zipWith3 paste (sameLen ss) (sameLen ls) ds
paste x y z = " " ++ x ++ " " ++ y ++ " " ++ z
sameLen xs = flushLeft ((maximum . map length) xs) xs
flushLeft n xs = [ take n (x ++ repeat ' ') | x <- xs ]
-fmtOpt :: OptDescr a -> (String,String,String)
-fmtOpt (Option sos los ad descr) = (sepBy ',' (map (fmtShort ad) sos),
- sepBy ',' (map (fmtLong ad) los),
- descr)
+fmtOpt :: OptDescr a -> [(String,String,String)]
+fmtOpt (Option sos los ad descr) =
+ case lines descr of
+ [] -> [(sosFmt,losFmt,"")]
+ (d:ds) -> (sosFmt,losFmt,d) : [ ("","",d') | d' <- ds ]
where sepBy _ [] = ""
sepBy _ [x] = x
sepBy ch (x:xs) = x ++ ch:' ':sepBy ch xs
+ sosFmt = sepBy ',' (map (fmtShort ad) sos)
+ losFmt = sepBy ',' (map (fmtLong ad) los)
fmtShort :: ArgDescr a -> Char -> String
fmtShort (NoArg _ ) so = "-" ++ [so]
* The option descriptions (see 'OptDescr')
* The actual command line arguments (presumably got from
- 'System.Console.Environment.getArgs').
+ 'System.Environment.getArgs').
-'getOpt' returns a triple, consisting of the argument values, a list
-of options that didn\'t match, and a list of error messages.
+'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 commandline arguments
+ -> [String] -- the command-line arguments
-> ([a],[String],[String]) -- (options,non-options,error messages)
-getOpt _ _ [] = ([],[],[])
-getOpt ordering optDescr (arg:args) = procNextOpt opt ordering
- where procNextOpt (Opt o) _ = (o:os,xs,es)
- procNextOpt (NonOpt x) RequireOrder = ([],x:rest,[])
- procNextOpt (NonOpt x) Permute = (os,x:xs,es)
- procNextOpt (NonOpt x) (ReturnInOrder f) = (f x :os, xs,es)
- procNextOpt EndOfOpts RequireOrder = ([],rest,[])
- procNextOpt EndOfOpts Permute = ([],rest,[])
- procNextOpt EndOfOpts (ReturnInOrder f) = (map f rest,[],[])
- procNextOpt (OptErr e) _ = (os,xs,e:es)
+getOpt ordering optDescr args = (os,xs,es ++ map errUnrec us)
+ where (os,xs,us,es) = getOpt' ordering optDescr 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' _ _ [] = ([],[],[],[])
+getOpt' ordering optDescr (arg:args) = procNextOpt opt ordering
+ where procNextOpt (Opt o) _ = (o:os,xs,us,es)
+ procNextOpt (UnreqOpt u) _ = (os,xs,u:us,es)
+ procNextOpt (NonOpt x) RequireOrder = ([],x:rest,[],[])
+ procNextOpt (NonOpt x) Permute = (os,x:xs,us,es)
+ procNextOpt (NonOpt x) (ReturnInOrder f) = (f x :os, xs,us,es)
+ procNextOpt EndOfOpts RequireOrder = ([],rest,[],[])
+ procNextOpt EndOfOpts Permute = ([],rest,[],[])
+ procNextOpt EndOfOpts (ReturnInOrder f) = (map f rest,[],[],[])
+ procNextOpt (OptErr e) _ = (os,xs,us,e:es)
(opt,rest) = getNext arg args optDescr
- (os,xs,es) = getOpt ordering optDescr rest
+ (os,xs,us,es) = getOpt' ordering optDescr rest
-- take a look at the next cmd line arg and decide what to do with it
getNext :: String -> [String] -> [OptDescr a] -> (OptKind a,[String])
longOpt :: String -> [String] -> [OptDescr a] -> (OptKind a,[String])
longOpt ls rs optDescr = long ads arg rs
where (opt,arg) = break (=='=') ls
- getWith p = [ o | o@(Option _ ls _ _) <- optDescr, l <- ls, opt `p` l ]
+ getWith p = [ o | o@(Option _ xs _ _) <- optDescr
+ , find (p opt) xs /= Nothing ]
exact = getWith (==)
options = if null exact then getWith isPrefixOf else exact
ads = [ ad | Option _ _ ad _ <- options ]
long [ReqArg f _] ('=':xs) rest = (Opt (f xs),rest)
long [OptArg f _] [] rest = (Opt (f Nothing),rest)
long [OptArg f _] ('=':xs) rest = (Opt (f (Just xs)),rest)
- long _ _ rest = (errUnrec optStr,rest)
+ long _ _ rest = (UnreqOpt ("--"++ls),rest)
-- handle short option
shortOpt :: Char -> String -> [String] -> [OptDescr a] -> (OptKind a,[String])
-shortOpt x xs rest optDescr = short ads xs rest
- where options = [ o | o@(Option ss _ _ _) <- optDescr, s <- ss, x == s ]
+shortOpt y ys rs optDescr = short ads ys rs
+ where options = [ o | o@(Option ss _ _ _) <- optDescr, s <- ss, y == s ]
ads = [ ad | Option _ _ ad _ <- options ]
- optStr = '-':[x]
+ optStr = '-':[y]
short (_:_:_) _ rest = (errAmbig options optStr,rest)
short (NoArg a :_) [] rest = (Opt a,rest)
short (ReqArg f _:_) xs rest = (Opt (f xs),rest)
short (OptArg f _:_) [] rest = (Opt (f Nothing),rest)
short (OptArg f _:_) xs rest = (Opt (f (Just xs)),rest)
- short [] [] rest = (errUnrec optStr,rest)
- short [] xs rest = (errUnrec optStr,('-':xs):rest)
+ short [] [] rest = (UnreqOpt optStr,rest)
+ short [] xs rest = (UnreqOpt optStr,('-':xs):rest)
-- miscellaneous error formatting
errReq :: String -> String -> OptKind a
errReq d optStr = OptErr ("option `" ++ optStr ++ "' requires an argument " ++ d ++ "\n")
-errUnrec :: String -> OptKind a
-errUnrec optStr = OptErr ("unrecognized option `" ++ optStr ++ "'\n")
+errUnrec :: String -> String
+errUnrec optStr = "unrecognized option `" ++ optStr ++ "'\n"
errNoArg :: String -> OptKind a
errNoArg optStr = OptErr ("option `" ++ optStr ++ "' doesn't allow an argument\n")
-----------------------------------------------------------------------------------------
-}
-{- $example
+{- $example1
-To hopefully illuminate the role of the different data
-structures, here\'s the command-line options for a (very simple)
-compiler:
+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 Opts where
+> module Opts1 where
>
> import System.Console.GetOpt
> import Data.Maybe ( fromMaybe )
> data Flag
> = Verbose | Version
> | Input String | Output String | LibDir String
-> deriving Show
+> deriving Show
>
> options :: [OptDescr Flag]
> options =
>
> inp,outp :: Maybe String -> Flag
> outp = Output . fromMaybe "stdout"
-> inp = Input . 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))
+> 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 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.
+
-}
projects / ghc-base.git / blobdiff