X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FConsole%2FGetOpt.hs;h=fa9f9b20c5968cfc73f7904d15bc38da44c061cf;hb=82ef8f9d52a6f6eee52ac06ec6baf2bcbb73f10c;hp=cc55a70f6fd203e04fbaef61ea8c59cc9182b77a;hpb=7fed02d08be1f19b470e2a79e587064789f0b564;p=ghc-base.git diff --git a/System/Console/GetOpt.hs b/System/Console/GetOpt.hs index cc55a70..fa9f9b2 100644 --- a/System/Console/GetOpt.hs +++ b/System/Console/GetOpt.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- 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 @@ -38,20 +38,21 @@ over 1100 lines, we need only 195 here, including a 46 line example! -} module System.Console.GetOpt ( - -- * GetOpt - getOpt, - usageInfo, - ArgOrder(..), - OptDescr(..), - ArgDescr(..), + -- * GetOpt + getOpt, getOpt', + usageInfo, + ArgOrder(..), + OptDescr(..), + ArgDescr(..), - -- * Example - - -- $example - ) where + -- * Example -import Prelude -import Data.List ( isPrefixOf ) + -- $example +) where + +import Prelude -- necessary to get dependencies right + +import Data.List ( isPrefixOf ) -- |What to do with options following non-options data ArgOrder a @@ -66,7 +67,7 @@ The arguments to 'Option' are: * list of short option characters -* list of long option strings (without "--") +* list of long option strings (without \"--\") * argument descriptor @@ -87,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... @@ -98,19 +100,22 @@ usageInfo :: String -- header -> [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] @@ -131,28 +136,41 @@ Process the command-line, and return the list of values that matched * 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,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]) @@ -165,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 ] @@ -179,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) @@ -196,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 @@ -208,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") @@ -262,7 +280,7 @@ test order cmdline = case getOpt order options cmdline of {- $example -To hopefully illuminate the role of the different "GetOpt" data +To hopefully illuminate the role of the different data structures, here\'s the command-line options for a (very simple) compiler: @@ -274,7 +292,7 @@ compiler: > data Flag > = Verbose | Version > | Input String | Output String | LibDir String -> deriving Show +> deriving Show > > options :: [OptDescr Flag] > options = @@ -287,13 +305,13 @@ 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 -> (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..." -}