X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FConsole%2FGetOpt.hs;h=fa9f9b20c5968cfc73f7904d15bc38da44c061cf;hb=82ef8f9d52a6f6eee52ac06ec6baf2bcbb73f10c;hp=cfa721f3f4fb7ad7e9c1c48e0c1e4cc1ce30ae5c;hpb=6c90d0330e6954c16a38f8228c875328b3fc1a38;p=ghc-base.git

diff --git a/System/Console/GetOpt.hs b/System/Console/GetOpt.hs
index cfa721f..fa9f9b2 100644
--- a/System/Console/GetOpt.hs
+++ b/System/Console/GetOpt.hs
@@ -1,7 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  System.Console.GetOpt
--- Copyright   :  (c) Sven Panne 2002-2004
+-- Copyright   :  (c) Sven Panne 2002-2005
 -- License     :  BSD-style (see the file libraries/base/LICENSE)
 -- 
 -- Maintainer  :  libraries@haskell.org
@@ -39,7 +39,7 @@ over 1100 lines, we need only 195 here, including a 46 line example!
 
 module System.Console.GetOpt (
    -- * GetOpt
-   getOpt,
+   getOpt, getOpt',
    usageInfo,
    ArgOrder(..),
    OptDescr(..),
@@ -88,6 +88,7 @@ data ArgDescr 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...
@@ -137,26 +138,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)
+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,us,[])
+         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])
@@ -169,7 +183,7 @@ 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 _ ls _ _) <- optDescr, l <- ls, opt `p` l ]
+         getWith p = [ o  | o@(Option _ xs _ _) <- optDescr, x <- xs, opt `p` x ]
          exact     = getWith (==)
          options   = if null exact then getWith isPrefixOf else exact
          ads       = [ ad | Option _ _ ad _ <- options ]
@@ -183,14 +197,14 @@ 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])
-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)
@@ -200,8 +214,8 @@ shortOpt x xs rest optDescr = short ads xs 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
 
@@ -212,8 +226,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")
@@ -291,11 +305,11 @@ compiler:
 >    
 >    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
+>       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..."