X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FConsole%2FGetOpt.hs;h=fa9f9b20c5968cfc73f7904d15bc38da44c061cf;hb=82ef8f9d52a6f6eee52ac06ec6baf2bcbb73f10c;hp=72ffea2c5877da1624cc43418cfedf7253d85bf0;hpb=4836cf1053a971fe823ba547a8268431745c5bce;p=ghc-base.git diff --git a/System/Console/GetOpt.hs b/System/Console/GetOpt.hs index 72ffea2..fa9f9b2 100644 --- a/System/Console/GetOpt.hs +++ b/System/Console/GetOpt.hs @@ -1,14 +1,16 @@ ----------------------------------------------------------------------------- -- | -- Module : System.Console.GetOpt --- Copyright : (c) Sven Panne Oct. 1996 (small changes Dec. 1997) --- License : BSD-style (see the file libraries/core/LICENSE) +-- Copyright : (c) Sven Panne 2002-2005 +-- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- --- A Haskell port of the GNU getopt library +-- This library provides facilities for parsing the command-line options +-- in a standalone program. It is essentially a Haskell port of the GNU +-- @getopt@ library. -- ----------------------------------------------------------------------------- @@ -22,66 +24,98 @@ it...) and the recognition of long options with a single dash (e.g. '-help' is recognised as '--help', as long as there is no short option 'h'). -Other differences between GNU's getopt and this implementation: * To -enforce a coherent description of options and arguments, there are -explanation fields in the option/argument descriptor. * Error -messages are now more informative, but no longer POSIX -compliant... :-( And a final Haskell advertisement: The GNU C -implementation uses well over 1100 lines, we need only 195 here, -including a 46 line example! :-) +Other differences between GNU's getopt and this implementation: + +* To enforce a coherent description of options and arguments, there + are explanation fields in the option/argument descriptor. + +* Error messages are now more informative, but no longer POSIX + compliant... :-( + +And a final Haskell advertisement: The GNU C implementation uses well +over 1100 lines, we need only 195 here, including a 46 line example! +:-) -} module System.Console.GetOpt ( - ArgOrder(..), - OptDescr(..), - ArgDescr(..), - usageInfo, -- :: String -> [OptDescr a] -> String - getOpt -- :: ArgOrder a -> [OptDescr a] -> [String] - -- -> ([a],[String],[String]) - ) where - -import Prelude -import Data.List ( isPrefixOf ) - -data ArgOrder a -- what to do with options following non-options: - = RequireOrder -- no option processing after first non-option - | Permute -- freely intersperse options and non-options - | ReturnInOrder (String -> a) -- wrap non-options into options + -- * GetOpt + getOpt, getOpt', + usageInfo, + ArgOrder(..), + OptDescr(..), + ArgDescr(..), + + -- * Example + + -- $example +) where + +import Prelude -- necessary to get dependencies right + +import Data.List ( isPrefixOf ) + +-- |What to do with options following non-options +data ArgOrder a + = RequireOrder -- ^ no option processing after first non-option + | Permute -- ^ freely intersperse options and non-options + | ReturnInOrder (String -> a) -- ^ wrap non-options into options + +{-| +Each 'OptDescr' describes a single option. + +The arguments to 'Option' are: + +* list of short option characters + +* list of long option strings (without \"--\") + +* argument descriptor +* explanation of option for user +-} data OptDescr a = -- description of a single options: Option [Char] -- list of short option characters [String] -- list of long option strings (without "--") (ArgDescr a) -- argument descriptor String -- explanation of option for user -data ArgDescr a -- description of an argument option: - = NoArg a -- no argument expected - | ReqArg (String -> a) String -- option requires argument - | OptArg (Maybe String -> a) String -- optional argument +-- |Describes whether an option takes an argument or not, and if so +-- how the argument is injected into a value of type @a@. +data ArgDescr a + = NoArg a -- ^ no argument expected + | ReqArg (String -> a) String -- ^ option requires argument + | OptArg (Maybe String -> a) String -- ^ optional argument 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... +-- | Return a string describing the usage of a command, derived from +-- the header (first argument) and the options described by the +-- second argument. 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] @@ -93,23 +127,50 @@ fmtLong (NoArg _ ) lo = "--" ++ lo fmtLong (ReqArg _ ad) lo = "--" ++ lo ++ "=" ++ ad fmtLong (OptArg _ ad) lo = "--" ++ lo ++ "[=" ++ ad ++ "]" +{-| +Process the command-line, and return the list of values that matched +(and those that didn\'t). The arguments are: + +* The order requirements (see 'ArgOrder') + +* The option descriptions (see 'OptDescr') + +* The actual command line arguments (presumably got from + 'System.Environment.getArgs'). + +'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]) @@ -122,7 +183,9 @@ 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 - options = [ o | o@(Option _ ls _ _) <- optDescr, l <- ls, opt `isPrefixOf` 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 ] optStr = ("--"++opt) @@ -134,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) @@ -151,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 @@ -163,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") @@ -214,3 +277,41 @@ test order cmdline = case getOpt order options cmdline of -- -n USER --name=USER only dump USER's files ----------------------------------------------------------------------------------------- -} + +{- $example + +To hopefully illuminate the role of the different data +structures, here\'s the command-line options for a (very simple) +compiler: + +> module Opts where +> +> import System.Console.GetOpt +> import Data.Maybe ( fromMaybe ) +> +> data Flag +> = Verbose | Version +> | Input String | Output String | LibDir String +> deriving Show +> +> options :: [OptDescr Flag] +> options = +> [ Option ['v'] ["verbose"] (NoArg Verbose) "chatty output on stderr" +> , Option ['V','?'] ["version"] (NoArg Version) "show version number" +> , Option ['o'] ["output"] (OptArg outp "FILE") "output FILE" +> , Option ['c'] [] (OptArg inp "FILE") "input FILE" +> , Option ['L'] ["libdir"] (ReqArg LibDir "DIR") "library directory" +> ] +> +> inp,outp :: Maybe String -> Flag +> outp = Output . 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)) +> where header = "Usage: ic [OPTION...] files..." + +-}