X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FConsole%2FGetOpt.hs;h=92ebd5205585cfbeaa899c81c8ea82880a9db967;hb=685432ac839f249ccd98bdf79fcf0c985872380b;hp=4098c30e78b04da1b0264f20a843b186f9c9e310;hpb=5031aad924a8b70b5fc4fe4bb1321c007afcab21;p=ghc-base.git

diff --git a/System/Console/GetOpt.hs b/System/Console/GetOpt.hs
index 4098c30..92ebd52 100644
--- a/System/Console/GetOpt.hs
+++ b/System/Console/GetOpt.hs
@@ -45,14 +45,24 @@ module System.Console.GetOpt (
    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
@@ -161,7 +171,7 @@ 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,us,[])
+         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,[],[])
@@ -183,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 ]
@@ -197,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     = (UnreqOpt optStr,rest)
+         long _            _        rest     = (UnreqOpt ("--"++ls),rest)
 
 -- handle short option
 shortOpt :: Char -> String -> [String] -> [OptDescr a] -> (OptKind a,[String])
@@ -278,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 )
@@ -314,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.
+
 -}