add ga_inl, ga_inr
[ghc-base.git] / System / Console / GetOpt.hs
index f7d2485..92ebd52 100644 (file)
@@ -39,20 +39,30 @@ over 1100 lines, we need only 195 here, including a 46 line example!
 
 module System.Console.GetOpt (
    -- * GetOpt
-   getOpt,
+   getOpt, getOpt',
    usageInfo,
    ArgOrder(..),
    OptDescr(..),
    ArgDescr(..),
 
-   -- * Example
+   -- * Examples
 
-   -- $example
+   -- |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 )
+import Data.List ( isPrefixOf, find )
 
 -- |What to do with options following non-options
 data ArgOrder a
@@ -138,27 +148,39 @@ Process the command-line, and return the list of values that matched
 * The actual command line arguments (presumably got from 
   '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)
-         procNextOpt (UnreqOpt _) _               = error "should not happen"
+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])
@@ -171,7 +193,8 @@ getNext a            rest _        = (NonOpt a,rest)
 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 _ xs _ _) <- optDescr, x <- xs, opt `p` x ]
+         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 ]
@@ -185,7 +208,7 @@ longOpt ls rs optDescr = long ads arg rs
          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])
@@ -202,8 +225,8 @@ shortOpt y ys rs optDescr = short ads ys rs
         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
 
@@ -214,8 +237,8 @@ errAmbig ods optStr = OptErr (usageInfo header ods)
 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")
@@ -266,13 +289,13 @@ test order cmdline = case getOpt order options cmdline of
 -----------------------------------------------------------------------------------------
 -}
 
-{- $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 )
@@ -302,4 +325,69 @@ compiler:
 >          (_,_,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.
+
 -}