Movatterモバイル変換

{-# LANGUAGE Safe #-}------------------------------------------------------------------------------- |-- Module      :  System.Console.GetOpt-- Copyright   :  (c) Sven Panne 2002-2005-- License     :  BSD-style (see the file libraries/base/LICENSE)---- Maintainer  :  libraries@haskell.org-- Stability   :  experimental-- Portability :  portable---- 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.-------------------------------------------------------------------------------{-Sven Panne <Sven.Panne@informatik.uni-muenchen.de> Oct. 1996 (smallchanges Dec. 1997)Two rather obscure features are missing: The Bash 2.0 non-option hack(if you don't already know it, you probably don't want to hear aboutit...) and the recognition of long options with a single dash(e.g. '-help' is recognised as '--help', as long as there is no shortoption '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 wellover 1100 lines, we need only 195 here, including a 46 line example! :-)-}moduleSystem.Console.GetOpt(-- * GetOptgetOpt,getOpt',usageInfo,ArgOrder(..),OptDescr(..),ArgDescr(..),-- * Examples-- |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)whereimportData.List(isPrefixOf,find)-- |What to do with options following non-optionsdataArgOrdera=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-}dataOptDescra=-- description of a single options:Option[Char]--    list of short option characters[String]--    list of long option strings (without "--")(ArgDescra)--    argument descriptorString--    explanation of option for user-- |Describes whether an option takes an argument or not, and if so-- how the argument is injected into a value of type @a@.dataArgDescra=NoArga-- ^   no argument expected|ReqArg(String->a)String-- ^   option requires argument|OptArg(MaybeString->a)String-- ^   optional argument-- | @since 4.6.0.0instanceFunctorArgOrderwherefmap_RequireOrder=RequireOrderfmap_Permute=Permutefmapf(ReturnInOrderg)=ReturnInOrder(f.g)-- | @since 4.6.0.0instanceFunctorOptDescrwherefmapf(OptionabargDescrc)=Optionab(fmapfargDescr)c-- | @since 4.6.0.0instanceFunctorArgDescrwherefmapf(NoArga)=NoArg(fa)fmapf(ReqArggs)=ReqArg(f.g)sfmapf(OptArggs)=OptArg(f.g)sdataOptKinda-- kind of cmd line arg (internal use only):=Opta--    an option|UnreqOptString--    an un-recognized option|NonOptString--    a non-option|EndOfOpts--    end-of-options marker (i.e. "--")|OptErrString--    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->[OptDescra]-- option descriptors->String-- nicely formatted description of optionsusageInfoheaderoptDescr=unlines(header:table)where(ss,ls,ds)=(unzip3.concatMapfmtOpt)optDescrtable=zipWith3paste(sameLenss)(sameLenls)dspastexyz="  "++x++"  "++y++"  "++zsameLenxs=flushLeft((maximum.maplength)xs)xsflushLeftnxs=[taken(x++repeat' ')|x<-xs]fmtOpt::OptDescra->[(String,String,String)]fmtOpt(Optionsoslosaddescr)=caselinesdescrof[]->[(sosFmt,losFmt,"")](d:ds)->(sosFmt,losFmt,d):[("","",d')|d'<-ds]wheresepBy_[]=""sepBy_[x]=xsepBych(x:xs)=x++ch:' ':sepBychxssosFmt=sepBy','(map(fmtShortad)sos)losFmt=sepBy','(map(fmtLongad)los)fmtShort::ArgDescra->Char->StringfmtShort(NoArg_)so="-"++[so]fmtShort(ReqArg_ad)so="-"++[so]++" "++adfmtShort(OptArg_ad)so="-"++[so]++"["++ad++"]"fmtLong::ArgDescra->String->StringfmtLong(NoArg_)lo="--"++lofmtLong(ReqArg_ad)lo="--"++lo++"="++adfmtLong(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 listof non-options, and a list of error messages.-}getOpt::ArgOrdera-- non-option handling->[OptDescra]-- option descriptors->[String]-- the command-line arguments->([a],[String],[String])-- (options,non-options,error messages)getOptorderingoptDescrargs=(os,xs,es++maperrUnrecus)where(os,xs,us,es)=getOpt'orderingoptDescrargs{-|This is almost the same as 'getOpt', but returns a quadrupleconsisting of the option arguments, a list of non-options, a list ofunrecognized options, and a list of error messages.-}getOpt'::ArgOrdera-- non-option handling->[OptDescra]-- option descriptors->[String]-- the command-line arguments->([a],[String],[String],[String])-- (options,non-options,unrecognized,error messages)getOpt'__[]=([],[],[],[])getOpt'orderingoptDescr(arg:args)=procNextOptoptorderingwhereprocNextOpt(Opto)_=(o:os,xs,us,es)procNextOpt(UnreqOptu)_=(os,xs,u:us,es)procNextOpt(NonOptx)RequireOrder=([],x:rest,[],[])procNextOpt(NonOptx)Permute=(os,x:xs,us,es)procNextOpt(NonOptx)(ReturnInOrderf)=(fx:os,xs,us,es)procNextOptEndOfOptsRequireOrder=([],rest,[],[])procNextOptEndOfOptsPermute=([],rest,[],[])procNextOptEndOfOpts(ReturnInOrderf)=(mapfrest,[],[],[])procNextOpt(OptErre)_=(os,xs,us,e:es)(opt,rest)=getNextargargsoptDescr(os,xs,us,es)=getOpt'orderingoptDescrrest-- take a look at the next cmd line arg and decide what to do with itgetNext::String->[String]->[OptDescra]->(OptKinda,[String])getNext('-':'-':[])rest_=(EndOfOpts,rest)getNext('-':'-':xs)restoptDescr=longOptxsrestoptDescrgetNext('-':x:xs)restoptDescr=shortOptxxsrestoptDescrgetNextarest_=(NonOpta,rest)-- handle long optionlongOpt::String->[String]->[OptDescra]->(OptKinda,[String])longOptlsrsoptDescr=longadsargrswhere(opt,arg)=break(=='=')lsgetWithp=[o|o@(Option_xs__)<-optDescr,find(popt)xs/=Nothing]exact=getWith(==)options=ifnullexactthengetWithisPrefixOfelseexactads=[ad|Option__ad_<-options]optStr=("--"++opt)long(_:_:_)_rest=(errAmbigoptionsoptStr,rest)long[NoArga][]rest=(Opta,rest)long[NoArg_]('=':_)rest=(errNoArgoptStr,rest)long[ReqArg_d][][]=(errReqdoptStr,[])long[ReqArgf_][](r:rest)=(Opt(fr),rest)long[ReqArgf_]('=':xs)rest=(Opt(fxs),rest)long[OptArgf_][]rest=(Opt(fNothing),rest)long[OptArgf_]('=':xs)rest=(Opt(f(Justxs)),rest)long__rest=(UnreqOpt("--"++ls),rest)-- handle short optionshortOpt::Char->String->[String]->[OptDescra]->(OptKinda,[String])shortOptyysrsoptDescr=shortadsysrswhereoptions=[o|o@(Optionss___)<-optDescr,s<-ss,y==s]ads=[ad|Option__ad_<-options]optStr='-':[y]short(_:_:_)_rest=(errAmbigoptionsoptStr,rest)short(NoArga:_)[]rest=(Opta,rest)short(NoArga:_)xsrest=(Opta,('-':xs):rest)short(ReqArg_d:_)[][]=(errReqdoptStr,[])short(ReqArgf_:_)[](r:rest)=(Opt(fr),rest)short(ReqArgf_:_)xsrest=(Opt(fxs),rest)short(OptArgf_:_)[]rest=(Opt(fNothing),rest)short(OptArgf_:_)xsrest=(Opt(f(Justxs)),rest)short[][]rest=(UnreqOptoptStr,rest)short[]xsrest=(UnreqOptoptStr,('-':xs):rest)-- miscellaneous error formattingerrAmbig::[OptDescra]->String->OptKindaerrAmbigodsoptStr=OptErr(usageInfoheaderods)whereheader="option `"++optStr++"' is ambiguous; could be one of:"errReq::String->String->OptKindaerrReqdoptStr=OptErr("option `"++optStr++"' requires an argument "++d++"\n")errUnrec::String->StringerrUnrecoptStr="unrecognized option `"++optStr++"'\n"errNoArg::String->OptKindaerrNoArgoptStr=OptErr("option `"++optStr++"' doesn't allow an argument\n"){-------------------------------------------------------------------------------------------- and here a small and hopefully enlightening example:data Flag = Verbose | Version | Name String | Output String | Arg String   deriving Showoptions :: [OptDescr Flag]options =   [Option ['v']     ["verbose"]           (NoArg Verbose)      "verbosely list files",    Option ['V','?'] ["version","release"] (NoArg Version)      "show version info",    Option ['o']     ["output"]            (OptArg out "FILE")  "use FILE for dump",    Option ['n']     ["name"]              (ReqArg Name "USER") "only dump USER's files"]out :: Maybe String -> Flagout Nothing  = Output "stdout"out (Just o) = Output otest :: ArgOrder Flag -> [String] -> Stringtest order cmdline = case getOpt order options cmdline of                        (o,n,[]  ) -> "options=" ++ show o ++ "  args=" ++ show n ++ "\n"                        (_,_,errs) -> concat errs ++ usageInfo header options   where header = "Usage: foobar [OPTION...] files..."-- example runs:-- putStr (test RequireOrder ["foo","-v"])--    ==> options=[]  args=["foo", "-v"]-- putStr (test Permute ["foo","-v"])--    ==> options=[Verbose]  args=["foo"]-- putStr (test (ReturnInOrder Arg) ["foo","-v"])--    ==> options=[Arg "foo", Verbose]  args=[]-- putStr (test Permute ["foo","--","-v"])--    ==> options=[]  args=["foo", "-v"]-- putStr (test Permute ["-?o","--name","bar","--na=baz"])--    ==> options=[Version, Output "stdout", Name "bar", Name "baz"]  args=[]-- putStr (test Permute ["--ver","foo"])--    ==> option `--ver' is ambiguous; could be one of:--          -v      --verbose             verbosely list files--          -V, -?  --version, --release  show version info   --        Usage: foobar [OPTION...] files...--          -v        --verbose             verbosely list files  --          -V, -?    --version, --release  show version info     --          -o[FILE]  --output[=FILE]       use FILE for dump     --          -n USER   --name=USER           only dump USER's files------------------------------------------------------------------------------------------}{- $example1A simple choice for the type associated with flags is to define a type@Flag@ as an algebraic type representing the possible flags and theirarguments:>    module Opts1 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..."Then the rest of the program will use the constructed list of flagsto determine it\'s behaviour.-}{- $example2A 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 optionprocessing to perform actions of the chosen monad, e.g. printing help orversion messages, checking that file arguments exist, etc.-}