packages feed

multiarg 0.26.0.0 → 0.28.0.0

raw patch · 14 files changed

+2019/−1987 lines, 14 files

Files

ChangeLog view
@@ -1,3 +1,10 @@+Release 0.28.0.0++* Renamed everything from System.Console.MultiArg to Multiarg+  (shorter; note also case change from MultiArg to Multiarg)++* Removed existentials from Multiarg.CommandLine+ Release 0.24.0.4, February 24, 2014  * Changed lower bound on base down to 4.5.0.0
+ lib/Multiarg.hs view
@@ -0,0 +1,167 @@+-- | A combinator library for building command-line parsers.++module Multiarg (++  -- | To say this library is inspired by Parsec would probably insult the+  -- creators of Parsec, as this library could not possibly be as+  -- elegant or throughly considered as Parsec is. Nevertheless this+  -- library can be used in a similar style as Parsec, but is+  -- specialized for parsing command lines.+  --+  -- This parser was built because I could not find anything that would+  -- readily parse command lines where the options took more than one+  -- argument. For example, for the @tail@ command on GNU systems, the+  -- --lines option takes one argument to specify how many lines you+  -- want to see. Well, what if you want to build a program with an+  -- option that takes /two/ arguments, like @--foo bar baz@? I found no+  -- such library so I built this one. Nevertheless, using this library+  -- you can build parsers to parse a variety of command line+  -- vocabularies, from simple to complex.++  -- * Terminology++  -- | Some terms are used throughout multiarg:+  --+  -- [@word@] When you run your program from the Unix shell prompt,+  -- your shell is responsible for splitting the command line into+  -- words. Typically you separate words with spaces, although quoting+  -- can affect this. multiarg parses lists of words. Each word can+  -- consist of a single long option, a single long option and an+  -- accompanying option argument, a single short option, multiple+  -- short options, and even one or more multiple short options and an+  -- accompanying short option argument. Or, a word can be a+  -- positional argument or a stopper. All these are described below.+  --+  -- [@option@] Options allow a user to specify ways to tune the+  -- operation of a program. Typically options are indeed optional,+  -- although some programs do sport \"required options\" (a bit of an+  -- oxymoron). Options can be either short options or long+  -- options. Also, options can take arguments.+  --+  -- [@short option@] An option that is specified with a single hyphen+  -- and a single letter. For example, for the program @tail(1)@,+  -- possible short options include @n@ and @v@. With multiarg it is+  -- possible to easily parse short options that are specified in+  -- different words or in the same word. For example, if a user wants+  -- to run @tail@ with two options, he might type @tail -v -f@ or he+  -- might type @tail -vf@.+  --+  -- [@long option@] An option that is specified using two hyphens and+  -- what is usually a mnemonic word, though it could be as short as a+  -- single letter. For example, @tail(1)@ has long options including+  -- @follow@ and @verbose@. The user would specify these on the+  -- command line by typing @tail --follow --verbose@.+  --+  -- [@option argument@] Some options take additional arguments that+  -- are specific to the option and change what the option does. For+  -- instance, the @lines@ option to @tail(1)@ takes a single,+  -- optional argument, which is the number of lines to show. Option+  -- arguments can be optional or required, and a single option can+  -- take a mulitple, fixed number of arguments and it can take a+  -- variable number of arguments. Option arguments can be given in+  -- various ways. They can be specified in the same word as a long+  -- option by using an equals sign; they can also be specified in the+  -- same word as a short option simply by placing them in the same+  -- word, or they can be specified in the following word. For+  -- example, these different command lines all mean the same thing;+  -- @tail --verbose --lines=20@, @tail --verbose --lines 20@, @tail+  -- -vn 20@, @tail -v -n20@, @tail -vn20@, and @tail -v -n 20@, and+  -- numerous other combinations also have the same meaning.+  --+  -- [@GNU-style option argument@] A long option with an argument+  -- given with an equal sign, such as [@lines=20@].+  --+  -- [@positional argument@] A word on the command line that is not an+  -- option or an argument to an option. For instance, with @tail(1)@,+  -- you specify the files you want to see by using positional+  -- arguments. In the command @tail -n 10 myfile@, @myfile@ is a+  -- positional argument. For some programs, such as @git@ or @darcs@,+  -- a positional argument might be a \"command\" or a \"mode\", such+  -- as the @commit@ in @git commit@ or the @whatsnew@ in @darcs+  -- whatsnew@. multiarg has no primitive parsers that treat these+  -- positional arguments specially but it is trivial to build a+  -- parser for command lines such as this, too.+  --+  -- [@stopper@] A single word consisting solely of two hyphens,+  -- @--@. The user types this to indicate that all subsequent words+  -- on the command line are positional arguments, even if they begin+  -- with hyphens and therefore look like they might be options.+  --+  -- [@pending@] The user might specify more than one short option, or+  -- a short option and a short option argument, in a single word. For+  -- example, she might type @tail -vl20@. After parsing the @v@+  -- option, the Parser makes @l20@ into a \"pending\". The next+  -- parser can then treat @l20@ as an option argument to the @v@+  -- option (which is probably not what was wanted) or the next parser+  -- can parse @l@ as a short option. This would result in a+  -- \"pending\" of @20@. Then, the next parser can treat @20@ as an+  -- option argument. After that parse there will be no pendings.++  -- * Getting started++  -- |If your needs are simple to moderately complicated just look at the+  -- "Multiarg.CommandLine" module, which uses the+  -- underlying combinators to build a simple parser for you. That+  -- module is already exported from this module for easy usage.+  --+  -- "Multiarg.CommandLine" also has a parser that can+  -- handle multi-mode commands (examples include @git@, @darcs@, and+  -- @cvs@.)+  --+  -- For maximum flexibility you will want to start with the+  -- "Multiarg.Prim" module. Using those parsers you+  -- can easily build parsers that are quite complicated. The parsers+  -- can check for errors along the way, simplifying the sometimes+  -- complex task of ensuring that data a user supplied on the command+  -- line is good. You can easily build parsers for programs that take+  -- no options, take dozens of options, require that options be given+  -- in a particular order, require that some options be given, or bar+  -- some combinations of options. You might also require particular+  -- positional arguments. Other helpful functions are in+  -- "Multiarg.Combinator". You will also want to+  -- examine the source code for "Multiarg.Combinator"+  -- and "Multiarg.CommandLine" as these show some+  -- ways to use the primitive parsers and combinators.++  -- * Non-features and shortcomings+  --+  -- | multiarg isn't perfect; no software is. multiarg does not+  -- automatically make online help for your command line+  -- parsers. Getting this right would be tricky given the nature of+  -- the code and I don't even want to bother trying, as I just write+  -- my own online help in a text editor.+  --+  -- multiarg partially embraces \"The Tao of Option Parsing\" that+  -- Python's Optik (<http://optik.sourceforge.net/>) follows. Read+  -- \"The Tao of Option Parsing\" here:+  --+  -- <http://optik.sourceforge.net/doc/1.5/tao.html>+  --+  -- multiarg's philosophy is similar to that of Optik, which+  -- means you won't be able to use multiarg to (easily) build a clone+  -- to the UNIX @find(1)@ command. (You could do it, but multiarg won't+  -- help you very much.)+  --+  -- multiarg can be complicated, although I'd like to believe this is+  -- because it addresses a complicated problem in a flexible way.++  -- * Projects usings multiarg++  -- | * Penny, an extensible double-entry accounting+  -- system. <http://hackage.haskell.org/package/penny-lib> The code+  -- using multiarg is woven throughout the system; for example, see+  -- the Penny.Liberty module.+++    module Multiarg.Combinator+  , module Multiarg.CommandLine+  , module Multiarg.Option+  , module Multiarg.Prim+  , module System.Environment+  ) where++import Multiarg.Combinator+import Multiarg.CommandLine+import Multiarg.Option+import Multiarg.Prim+import System.Environment
+ lib/Multiarg/Combinator.hs view
@@ -0,0 +1,478 @@+-- | Combinators that are useful for building command-line+-- parsers. These build off the functions in+-- "Multiarg.Prim". Unlike those functions, these+-- functions have no access to the internals of the parser.+module Multiarg.Combinator (+  -- * Parser combinators+  notFollowedBy,++  -- * Combined long and short option parser+  OptSpec(OptSpec, longOpts, shortOpts, argSpec),+  InputError(..),+  reader,+  optReader,+  ArgSpec(..),+  parseOption,++  -- * Formatting errors+  formatError+  ) where++import Data.List (isPrefixOf, intersperse, nubBy)+import Data.Set ( Set )+import qualified Data.Set as Set+import Control.Applicative+       ((<*>), optional, (<$), (*>), (<|>), many)++import Multiarg.Prim+  ( Parser, try, approxLongOpt,+    nextWord, pendingShortOptArg, nonOptionPosArg,+    pendingShortOpt, nonPendingShortOpt, nextWord, (<?>),+    Error(..), Description(..))+import Multiarg.Option+  ( LongOpt, ShortOpt, unLongOpt,+    makeLongOpt, makeShortOpt, unShortOpt )+import qualified Data.Map as M+import Data.Map ((!))+import Data.Maybe (fromMaybe, mapMaybe)+import Data.Monoid ( mconcat )+++-- | @notFollowedBy p@ succeeds only if parser p fails. If p fails,+-- notFollowedBy succeeds without consuming any input. If p succeeds+-- and consumes input, notFollowedBy fails and consumes input. If p+-- succeeds and does not consume any input, notFollowedBy fails and+-- does not consume any input.+notFollowedBy :: Parser a -> Parser ()+notFollowedBy p =+  () <$ ((try p >> fail "notFollowedBy failed")+         <|> return ())+++unsafeShortOpt :: Char -> ShortOpt+unsafeShortOpt c =+  fromMaybe (error $ "invalid short option: " ++ [c])+            (makeShortOpt c)++unsafeLongOpt :: String -> LongOpt+unsafeLongOpt c =+  fromMaybe (error $ "invalid long option: " ++ c)+            (makeLongOpt c)+++-- |Specifies options for the 'parseOption' function. Each OptSpec+-- represents one command-line option.+data OptSpec a = OptSpec {+  longOpts :: [String]+  -- ^ Each String is a single long option, such as @version@. When+  -- the user specifies long options on the command line, she must+  -- type two dashes; however, do not include the dashes when you+  -- specify the long option here. Strings you specify as long options+  -- cannot include a dash as either the first or the second+  -- character, and they cannot include an equal sign anywhere. If+  -- your long option does not meet these conditions, a runtime error+  -- will occur.+++  , shortOpts :: [Char]+    -- ^ Each Char is a single short option, such as @v@. The+    -- character cannot be a dash; if it is, a runtime error will occur.++  , argSpec :: ArgSpec a+    -- ^ What to do each time one of the given long options or+    -- short options appears on the command line.+  }++instance Functor OptSpec where+  fmap f (OptSpec ls ss as) = OptSpec ls ss (fmap f as)++-- | Reads in values that are members of Read. Provides a generic+-- error message if the read fails.+reader :: Read a => String -> Either InputError a+reader s = case reads s of+  (x, ""):[] -> return x+  _ -> Left . ErrorMsg $ "could not parse option argument"++-- | Reads in values that are members of Read, but the value does not+-- have to appear on the command line. Provides a generic error+-- message if the read fails. If the argument is Nothing, returns+-- Nothing.+optReader+  :: Read a+  => Maybe String+  -> Either InputError (Maybe a)+optReader ms = case ms of+  Nothing -> return Nothing+  Just s -> case reads s of+    (x, ""):[] -> return (Just x)+    _ -> Left . ErrorMsg $ "could not parse option argument"++-- | Indicates errors when parsing options to arguments.+data InputError+  = NoMsg+  -- ^ No error message accompanies this failure. multiarg will create+  -- a generic error message for you.++  | ErrorMsg String+  -- ^ Parsing the argument failed with this error message. An example+  -- might be @option argument is not an integer@ or @option argument+  -- is too large@. The text of the options the user provided is+  -- automatically prepended to the error message, so do not replicate+  -- this in your message.++  deriving (Eq, Show)++-- | Create an error message from an InputError.+errorMsg+  :: Either LongOpt ShortOpt+  -- ^ The option with the faulty argument++  -> [String]+  -- ^ The faulty command line arguments++  -> InputError+  -> String+errorMsg badOpt ss err = arg ++ opt ++ msg+  where+    arg = let aw = if length ss > 1 then "arguments " else "argument "+              ws = concat . intersperse " " . map quote $ ss+              quote s = "\"" ++ s ++ "\""+          in aw ++ ws+    opt = " to option " ++ optDesc+    optDesc = case badOpt of+      Left lo -> "--" ++ unLongOpt lo+      Right so -> "-" ++ [unShortOpt so]+    msg = " invalid" ++ detail+    detail = case err of+      NoMsg -> ""+      ErrorMsg s -> ": " ++ s++++-- | Specifies how many arguments each option takes. As with+-- 'System.Console.GetOpt.ArgDescr', there are (at least) two ways to+-- use this type. You can simply represent each possible option using+-- different data constructors in an algebraic data type. Or you can+-- have each ArgSpec yield a function that transforms a record. For an+-- example that uses an algebraic data type, see+-- "Multiarg.SampleParser".+--+-- Most of these value constructors take as an argument a function+-- that returns an Either.  The function should return a @Left+-- InputError@ if the parsing of the arguments failed--if, for+-- example, the user needs to enter an integer but she instead input a+-- letter.  The functions should return a Right if parsing of the+-- arguments was successful.+data ArgSpec a =+  NoArg a+  -- ^ This option takes no arguments++  | OptionalArg (Maybe String -> Either InputError a)+    -- ^ This option takes an optional argument. As noted in \"The Tao+    -- of Option Parsing\", optional arguments can result in some+    -- ambiguity. (Read it here:+    -- <http://optik.sourceforge.net/doc/1.5/tao.html>) If option @a@+    -- takes an optional argument, and @b@ is also an option, what+    -- does @-ab@ mean? SimpleParser resolves this ambiguity by+    -- assuming that @b@ is an argument to @a@. If the user does not+    -- like this, she can specify @-a -b@ (in such an instance @-b@ is+    -- not parsed as an option to @-a@, because @-b@ begins with a+    -- hyphen and therefore \"looks like\" an option.) Certainly+    -- though, optional arguments lead to ambiguity, so if you don't+    -- like it, don't use them :)++  | OneArg (String -> Either InputError a)+    -- ^ This option takes one argument. Here, if option @a@ takes one+    -- argument, @-a -b@ will be parsed with @-b@ being an argument to+    -- option @a@, even though @-b@ starts with a hyphen and therefore+    -- \"looks like\" an option.++  | TwoArg (String -> String -> Either InputError a)+    -- ^ This option takes two arguments. Parsed similarly to+    -- 'OneArg'.++  | ThreeArg (String -> String -> String -> Either InputError a)+    -- ^ This option takes three arguments. Parsed similarly to+    -- 'OneArg'.++  | VariableArg ([String] -> Either InputError a)+    -- ^ This option takes a variable number of arguments--zero or+    -- more. Option arguments continue until the command line contains+    -- a word that begins with a hyphen. For example, if option @a@+    -- takes a variable number of arguments, then @-a one two three+    -- -b@ will be parsed as @a@ taking three arguments, and @-a -b@+    -- will be parsed as @a@ taking no arguments. If the user enters+    -- @-a@ as the last option on the command line, then the only way+    -- to indicate the end of arguments for @a@ and the beginning of+    -- positional argments is with a stopper.++  | ChoiceArg [(String, a)]+    -- ^ This option takes a single argument, which must match one of+    -- the strings given in the list. The user may supply the shortest+    -- unambiguous string. If the argument list to ChoiceArg has+    -- duplicate strings, only the first string is used. For instance,+    -- ChoiceArg could be useful if you were parsing the @--color@+    -- option to GNU grep, which requires the user to supply one of+    -- three arguments: @always@, @never@, or @auto@.+++instance Functor ArgSpec where+  fmap f a = case a of+    NoArg i -> NoArg $ f i+    ChoiceArg gs ->+      ChoiceArg . map (\(s, r) -> (s, f r)) $ gs++    OptionalArg g -> OptionalArg $ \ms -> fmap f (g ms)++    OneArg g ->+      OneArg $ \s1 -> fmap f (g s1)++    TwoArg g ->+      TwoArg $ \s1 s2 -> fmap f (g s1 s2)++    ThreeArg g ->+      ThreeArg $ \s1 s2 s3 -> fmap f (g s1 s2 s3)++    VariableArg g ->+      VariableArg $ \ls -> fmap f (g ls)+++-- | Parses a single command line option. Examines all the options+-- specified using multiple OptSpec and parses one option on the+-- command line accordingly. Fails without consuming any input if the+-- next word on the command line is not a recognized option. Allows+-- the user to specify the shortest unambiguous match for long+-- options; for example, the user could type @--verb@ for @--verbose@+-- and @--vers@ for @--version@.+--+-- This function is applied to a list of OptSpec, rather than to a+-- single OptSpec, because in order to correctly handle the parsing of+-- shortened long options (e.g. @--verb@ rather than @--verbose@) it+-- is necessary for one function to have access to all of the+-- OptSpec. Applying this function multiple times to different lists+-- of OptSpec and then using the @<|>@ function to combine them will+-- break the proper parsing of shortened long options.+--+-- For an example that uses this function, see+-- "Multiarg.SimpleParser".+parseOption :: [OptSpec a] -> Parser a+parseOption os =+  let longs = longOptParser os+  in case mconcat ([shortOpt] <*> os) of+    Nothing -> longs+    Just shorts -> longs <|> shorts++longOptParser :: [OptSpec a] -> Parser a+longOptParser os = longOpt (longOptSet os) (longOptMap os)+++longOptSet :: [OptSpec a] -> Set LongOpt+longOptSet = Set.fromList . concatMap toOpts where+  toOpts = map unsafeLongOpt . longOpts++longOptMap :: [OptSpec a] -> M.Map LongOpt (ArgSpec a)+longOptMap = M.fromList . concatMap toPairs where+  toPairs (OptSpec los _ as) = map (toPair as) los where+    toPair a s = (unsafeLongOpt s, a)++longOpt ::+  Set LongOpt+  -> M.Map LongOpt (ArgSpec a)+  -> Parser a+longOpt set mp = do+  (_, lo, maybeArg) <- approxLongOpt set+  let spec = mp ! lo+      maybeNextArg = maybe nextWord return maybeArg+  case spec of+    NoArg a -> case maybeArg of+      Nothing -> return a+      Just _ -> fail $ "option " ++ unLongOpt lo+                  ++ " does not take argument"+    ChoiceArg ls -> do+      s <- maybeNextArg+      case matchAbbrev ls s of+        Nothing -> fail $ "option " ++ unLongOpt lo+                   ++ " requires an argument: "+                   ++ (concat . intersperse ", " . map fst $ ls)+        Just g -> return g++    OptionalArg f -> case maybeArg of+      Nothing -> either (fail . errorMsg (Left lo) []) return+                 $ f Nothing+      Just s -> either (fail . errorMsg (Left lo) [s]) return+                $ f (Just s)+++    OneArg f -> maybeNextArg >>= g+      where+        g a = either (fail . errorMsg (Left lo) [a]) return+              $ f a++    TwoArg f -> do+      a1 <- maybeNextArg+      a2 <- nextWord+      either (fail . errorMsg (Left lo) [a1, a2]) return+        $ f a1 a2++    ThreeArg f -> do+      a1 <- maybeNextArg+      a2 <- nextWord+      a3 <- nextWord+      either (fail . errorMsg (Left lo) [a1, a2, a3]) return+        $ f a1 a2 a3++    VariableArg f -> do+      as <- many nonOptionPosArg+      let args = case maybeArg of+            Nothing -> as+            Just a -> a:as+      either (fail . errorMsg (Left lo) args) return+        $ f args+++shortOpt :: OptSpec a -> Maybe (Parser a)+shortOpt o = mconcat parsers where+  parsers = map mkParser . shortOpts $ o+  mkParser c =+    let opt = unsafeShortOpt c+    in Just $ nextShort opt *> case argSpec o of+      NoArg a -> return a+      ChoiceArg ls -> shortChoiceArg opt ls+      OptionalArg f -> shortOptionalArg opt f+      OneArg f -> shortOneArg opt f+      TwoArg f -> shortTwoArg opt f+      ThreeArg f -> shortThreeArg opt f+      VariableArg f -> shortVariableArg opt f++-- | Parses a short option without an argument, either pending or+-- non-pending. Fails with a single error message rather than two.+nextShort :: ShortOpt -> Parser ()+nextShort o = p <?> ("short option: -" ++ [unShortOpt o])+  where+    p = do+      r1 <- optional $ pendingShortOpt o+      case r1 of+        Just () -> return ()+        Nothing -> nonPendingShortOpt o+++shortVariableArg+  :: ShortOpt+  -> ([String] -> Either InputError a)+  -> Parser a+shortVariableArg so f = do+  maybeSameWordArg <- optional pendingShortOptArg+  args <- many nonOptionPosArg+  let as = case maybeSameWordArg of+        Nothing -> args+        Just a -> a:args+  either (fail . errorMsg (Right so) as) return $ f as+++shortOneArg+  :: ShortOpt+  -> (String -> Either InputError a)+  -> Parser a+shortOneArg so f = do+  a <- firstShortArg+  either (fail . errorMsg (Right so) [a]) return $ f a++firstShortArg :: Parser String+firstShortArg =+  optional pendingShortOptArg >>= maybe nextWord return+++shortChoiceArg :: ShortOpt -> [(String, a)] -> Parser a+shortChoiceArg opt ls =+  firstShortArg+  >>= maybe err return . matchAbbrev ls+  where+    err = fail $ "option " ++ [unShortOpt opt] ++ " requires "+          ++ "one argument: "+          ++ (concat . intersperse " " . map fst $ ls)+++shortTwoArg+  :: ShortOpt+  -> (String -> String -> Either InputError a)+  -> Parser a+shortTwoArg so f = do+  a1 <- firstShortArg+  a2 <- nextWord+  either (fail . errorMsg (Right so) [a1, a2]) return+    $ f a1 a2+++shortThreeArg+  :: ShortOpt+  -> (String -> String -> String -> Either InputError a)+  -> Parser a+shortThreeArg so f = do+  a1 <- firstShortArg+  a2 <- nextWord+  a3 <- nextWord+  either (fail . errorMsg (Right so) [a1, a2, a3]) return+    $ f a1 a2 a3++shortOptionalArg+  :: ShortOpt+  -> (Maybe String -> Either InputError a)+  -> Parser a+shortOptionalArg so f = do+  maybeSameWordArg <- optional pendingShortOptArg+  case maybeSameWordArg of+    Nothing -> do+      maybeArg <- optional nonOptionPosArg+      case maybeArg of+        Nothing -> either (fail . errorMsg (Right so) []) return+                   $ f Nothing+        Just a -> either (fail . errorMsg (Right so) [a]) return+                  $ f (Just a)+    Just a -> either (fail . errorMsg (Right so) [a]) return+              $ f (Just a)++++-- | Finds the unambiguous short match for a string, if there is+-- one. Returns a string describing the error condition if there is+-- one, or the matching result if successful.+matchAbbrev :: [(String, a)] -> String -> Maybe a+matchAbbrev ls s =+  let ls' = nubBy (\x y -> fst x == fst y) ls+  in case lookup s ls' of+    Just a -> return a+    Nothing ->+      let pdct (t, _) = s `isPrefixOf` t+      in case filter pdct ls of+        (_, a):[] -> return a+        _ -> Nothing++-- | Formats error messages for nice display. Returns a multi-line+-- string (there is no need to append a newline to the end of the+-- string returned).+formatError+  :: String+  -- ^ Pass the name of your program here. Displayed at the beginning+  -- of the error message.++  -> Error+  -> String+formatError p (Error loc ls) =+  p ++ ": error: could not parse command line.\n"+  ++ "Error at: " ++ loc ++ "\n"+  ++ expError+  ++ genError+  ++ unk+  where+    toExp m = case m of { Expected s -> Just s; _ -> Nothing }+    expc = unlines . mapMaybe toExp $ ls+    expError = if null expc then "" else "Expecting:\n" ++ expc+    toGeneral m = case m of { General s -> Just s; _ -> Nothing }+    gen = unlines . mapMaybe toGeneral $ ls+    genError = if null gen+               then ""+               else let sep = if null expError+                              then "" else "\n"+                        in sep ++ gen+    unk = if any (== Unknown) ls then "Unknown error\n" else ""+
+ lib/Multiarg/CommandLine.hs view
@@ -0,0 +1,563 @@+-- | Some pre-built command line parsers. One is a simple command line+-- parser that can parse options that take an optional argument, one+-- or two arguments, or a variable number of arguments. For sample+-- code that uses this parser, see+-- "Multiarg.SampleParser".+--+-- Another parser is provided for multi-mode programs that are similar+-- to @git@ or @darcs@.+--+-- Previously there was a bug in System.Environment.getArgs that would+-- not properly encode Unicode command line arguments.  multiarg used+-- to provide its own GetArgs module to deal with this.  This bug was+-- in base 4.3.1.0, which was bundled with ghc 7.0.4.  This bug was+-- fixed in base 4.4.0.0, which came with ghc 7.2.  Since this bug has+-- been fixed for awhile, multiarg no longer has its own GetArgs+-- module.+module Multiarg.CommandLine (+  -- * Interspersion control+  Intersperse (Intersperse, StopOptions)++  -- * Types+  , ProgName+  , Opts(..)+  , OptsWithPosArgs(..)++  -- ** Modes+  , Mode+  , mode+  , mModeName+  , renameMode++  -- * Simple parsers+  , simplePure+  , simpleIO+  , simpleHelp+  , simpleHelpVersion++  -- * Mode parsers+  , modesPure+  , modesIO++  -- * Helpers to create various options and modes+  , optsHelp+  , optsHelpVersion+  , modeHelp++  ) where++import qualified Multiarg.Combinator as C+import qualified Multiarg.Prim as P+import System.Environment (getArgs, getProgName)+import System.Exit (exitFailure, exitSuccess)+import qualified System.IO as IO+import Control.Applicative ( many, (<|>), optional,+                             (<$), (<*>), (<*), (<$>))+import Data.Bifunctor+import Data.List (find)+import Data.Maybe (catMaybes, fromJust)+import qualified Data.Set as Set+++-- | What to do after encountering the first non-option,+-- non-option-argument word on the command line? In either case, no+-- more options are parsed after a stopper.+data Intersperse =+  Intersperse+  -- ^ Additional options are allowed on the command line after+  -- encountering the first positional argument. For example, if @a@+  -- and @b@ are options, in the command line @-a posarg -b@, @b@ will+  -- be parsed as an option. If @b@ is /not/ an option and the same+  -- command line is entered, then @-b@ will result in an error+  -- because @-b@ starts with a hyphen and therefore \"looks like\" an+  -- option.++  | StopOptions+    -- ^ No additional options will be parsed after encountering the+    -- first positional argument. For example, if @a@ and @b@ are+    -- options, in the command line @-a posarg -b@, @b@ will be parsed+    -- as a positional argument rather than as an option.+++-- | Specifies a set of options.+data Opts s a = Opts+  { oShortcuts :: [C.OptSpec s]+  -- ^ Shortcut options are commonly options such as @--help@ or+  -- @--version@. Such options must be specified alone on the command+  -- line.  The parser looks for one of these options first.  If it+  -- finds one and it is the only option on the command line, only+  -- this option is processed and returned.  If the option is not+  -- alone on the command line, an error occurs.  If no shortcut+  -- option is found, the parser processes non-shortcut options+  -- instead.++  , oOptions :: [C.OptSpec a]+  -- ^ If the user does not specify any shortcut options, she may+  -- specify any number of these options.++  }++instance Bifunctor Opts where+  bimap fa fc o = Opts+    { oShortcuts = map (fmap fa) . oShortcuts $ o+    , oOptions = map (fmap fc) . oOptions $ o+    }++instance Functor (Opts a) where+  fmap f o = o { oOptions = fmap (fmap f) . oOptions $ o }++-- | Creates an Opts with a help shortcut option.+optsHelp+  :: h+  -- ^ Whatever type you wish to use for help+  -> [C.OptSpec a]+  -> Opts h a+optsHelp h = Opts [C.OptSpec ["help"] "h" (C.NoArg h)]++-- | Creates an Opts with help and version shortcut options.+optsHelpVersion+  :: h+  -- ^ What you wish to use for help++  -> h+  -- ^ What you wish to use for version++  -> [C.OptSpec a]+  -> Opts h a+optsHelpVersion h v = Opts [ C.OptSpec ["help"] "h" (C.NoArg h)+                            , C.OptSpec ["version"] "v" (C.NoArg v) ]++-- | Specification for both options and positional arguments.+data OptsWithPosArgs s a = OptsWithPosArgs+  { opOpts :: Opts s a+  , opIntersperse :: Intersperse+  , opPosArg :: String -> Either C.InputError a+  }++instance Bifunctor OptsWithPosArgs where+  bimap fa fc o = OptsWithPosArgs+    { opOpts = bimap fa fc . opOpts $ o+    , opIntersperse = opIntersperse o+    , opPosArg = fmap (fmap fc) . opPosArg $ o+    }++instance Functor (OptsWithPosArgs s) where+  fmap f o = o+    { opOpts = fmap f . opOpts $ o+    , opPosArg = fmap (fmap f) . opPosArg $ o+    }++-- | Creates a mode.+mode+  :: String+  -- ^ How the user specifies the mode on the command line.  For @git@+  -- for example this might be @commit@ or @log@.+++  -> OptsWithPosArgs s a+  -- ^ Options and positional arguments that are specific to this+  -- mode.  For example, in the command line @git commit -a -m 'this+  -- is a log message'@, @commit@ is the mode name and everything+  -- after that is specified here as an option or positional argument+  -- that is specific to this mode.++  -> ([a] -> r)+  -- ^ This function is applied to a list of the results of parsing the+  -- options that are specific to this mode.  The function returns a+  -- type of your choosing (though all modes in the same parser will+  -- have to return the same type.)++  -> Mode s r+mode n os f = Mode n (processMode f os)++++-- | Specifies a mode.+data Mode s r = Mode+  { mModeName :: String+  -- ^ How the user specifies the mode on the command line.  For @git@+  -- for example this might be @commit@ or @log@.++  , mParser :: P.Parser (Either s r)+  }++instance Bifunctor Mode where+  bimap fa fc (Mode n p) = Mode n (fmap (bimap fa fc) p)++instance Functor (Mode s) where+  fmap f (Mode n p) = Mode n (fmap (fmap f) p)++-- | Changes the mode name that a user specifies on the command line.+renameMode+  :: (String -> String)+  -- ^ This function is applied to the existing name of the mode.+  -> Mode s r+  -> Mode s r++renameMode f (Mode n p) = Mode (f n) p++-- | Creates a Mode with a help option (help specific to the mode.)+modeHelp+  :: String+  -- ^ Mode name++  -> h+  -- ^ Whatever you want to use for the help (perhaps a string, or a+  -- function, or an IO action).  Its type will have to match up with+  -- the type of the global shortcut options and with the shortcut+  -- type of the other modes.++  -> ([a] -> r)+  -- ^ When applied to the the mode options, returns the result.++  -> [C.OptSpec a]+  -- ^ Options for this mode++  -> Intersperse+  -- ^ Allow interspersion of mode options and positional arguments?++  -> (String -> Either C.InputError a)+  -- ^ Parses positional arguments++  -> Mode h r++modeHelp n h getR os i p = mode n (OptsWithPosArgs (Opts ss os) i p) getR+  where+    ss = [C.OptSpec ["help"] "h" (C.NoArg h)]++parseOpts :: Opts s a -> P.Parser (Either s [a])+parseOpts os = do+  let specials = oShortcuts os+  maySpecial <- optional (C.parseOption specials <* P.end)+  case maySpecial of+    Nothing -> fmap Right+      $ P.manyTill (C.parseOption (oOptions os)) endOrNonOpt+    Just spec -> return . Left $ spec++parseOptsWithPosArgs+  :: OptsWithPosArgs s a+  -> P.Parser (Either s [a])+parseOptsWithPosArgs os = do+  let specials = oShortcuts . opOpts $ os+  maySpecial <- optional (C.parseOption specials <* P.end)+  case maySpecial of+    Nothing ->+      let f = case opIntersperse os of+            Intersperse -> parseIntersperse+            StopOptions -> parseStopOpts+          parser = C.parseOption (oOptions . opOpts $ os)+      in fmap Right $ f parser (opPosArg os)+    Just spec -> return . Left $ spec++processMode+  :: ([a] -> r)+  -> OptsWithPosArgs s a+  -> P.Parser (Either s r)+processMode gr os = do+  eiOpts <- parseOptsWithPosArgs os+  return $ case eiOpts of+    Left x -> Left x+    Right opts -> Right (gr opts)+++parseModes+  :: [Mode s r]+  -> P.Parser (Either s r)+parseModes ms = do+  let modeWords = Set.fromList . map mModeName $ ms+  (_, w) <- P.matchApproxWord modeWords+  mParser . fromJust . find (\c -> mModeName c == w) $ ms+++-- | A pure (non-IO) parser for simple command lines--that is, command+-- lines that do not have modes.+simplePure+  :: OptsWithPosArgs s a+  -- ^ Specifies allowed regular options, allowed shortcut options,+  -- and how to parse positional arguments.  Also specifies whether+  -- the user may intersperse options with positional arguments.++  -> [String]+  -- ^ The command line arguments to parse++  -> Either P.Error (Either s [a])+  -- ^ Returns an error if the command line arguments could not be+  -- parsed. If the parse was successful, returns an Either.  A Left+  -- indicates that the user selected a shortcut option.  A Right+  -- indicates that the user did not specify a shortcut option, and+  -- will contain a list of the options and positional arguments.+simplePure os ss = P.parse ss (parseOptsWithPosArgs os)++-- | A pure (non-IO) parser for command lines that contain modes.+modesPure+  :: Opts s g+  -- ^ Global options.  These are specified before any mode.  For+  -- instance, in the command @git --no-pager commit -a@, the option+  -- @--no-pager@ is a global option.  Global options can contain+  -- shortcut options.  For instance, @git --help@ contains a single+  -- shortcut option.++  -> ([g] -> Either String (Either r [Mode s r]))+  -- ^ This function processes the global options.  If there are no+  -- shortcut options specified in the global options, it is applied+  -- to the result of processing the global options.  This function+  -- may return a Left if there is something wrong with the+  -- global options (a nonsensical combination, perhaps.)  Otherwise,+  -- it returns a @Right Either@.  Return a Left if there is no need to+  -- process any modes at all after seeing the global options.+  -- Otherwise, return a Right with a list of modes.++  -> [String]+  -- ^ Command line arguments to parse++  -> Either P.Error (Either s r)+  -- ^ If the command line arguments fail to parse, this will be a+  -- Left with the error.  If the parser is successful, this+  -- returns a @Right Either@. A Left indicates that the user entered a+  -- shortcut option, either in the global options or in one of the+  -- mode-specific options.  A Right indicates that the user selected+  -- a mode.+modesPure os process ss = P.parse ss p+  where+    p = do+      eiGs <- parseOpts os+      case eiGs of+        Left spec -> return . Left $ spec+        Right gs -> case process gs of+          Left s -> fail s+          Right eiModes -> case eiModes of+            Left r -> return (Right r)+            Right modes -> parseModes modes++-- | A parser for simple command lines that do not contain modes.+-- Runs in the IO monad.+simpleIO+  :: [C.OptSpec a]+  -- ^ Options to parse++  -> Intersperse+  -- ^ Allow interspersion of options and arguments?++  -> (String -> Either C.InputError a)+  -- ^ How to parse positional arguments++  -> IO [a]+  -- ^ If there is an error parsing the command line, the program will+  -- exit with an error message.  If successful the results are+  -- returned here.+simpleIO os i getArg = do+  let optsWithArgs = OptsWithPosArgs (Opts os []) i getArg+  ss <- getArgs+  case simplePure optsWithArgs ss of+    Left e -> errorAct e+    Right g -> case g of+      Left _ ->+        error "simpleIO: should never happen: no shortcut options"+      Right gs -> return gs++simpleIOCustomError+  :: (P.Error -> IO ())+  -> OptsWithPosArgs s a+  -> IO (Either s [a])+simpleIOCustomError showErr os = do+  ss <- getArgs+  case simplePure os ss of+    Left e -> showErr e >> exitFailure+    Right g -> return g+  ++-- | A command line parser for multi-mode command lines.  Runs in the+-- IO monad.+modesIO+  :: Opts s g+  -- ^ Specifies global options and global shortcut options++  -> ([g] -> Either String (Either r [Mode s r]))+  -- ^ This function processes the global options.  If there are no+  -- shortcut options specified in the global options, it is applied+  -- to the result of processing the global options.  This function+  -- may return a Left if there is something wrong with the+  -- global options (a nonsensical combination, perhaps.)  Otherwise,+  -- it returns a @Right Either@.  Return a Left if there is no need to+  -- process any modes at all after seeing the global options.+  -- Otherwise, return a Right with a list of modes.++  -> IO (Either s r)+  -- ^ If parsing fails, the program will exit with a failure. If+  -- successful, the result is returned here.  A Left indicates a+  -- shortcut option, either from the global options or from the+  -- mode-specific options; a Right indicates the mode a user+  -- selected.+modesIO os ms = do+  ss <- getArgs+  case modesPure os ms ss of+    Left e -> errorAct e+    Right g -> return g+++-- | The name of the program that was entered on the command line,+-- obtained from System.Environment.getProgName.+type ProgName = String++displayAct :: (ProgName -> String) -> IO a+displayAct getHelp = do+  pn <- getProgName+  putStr $ getHelp pn+  exitSuccess++errorAct :: P.Error -> IO a+errorAct e = do+  pn <- getProgName+  IO.hPutStr IO.stderr $ C.formatError pn e+  exitFailure++errorActDisplayHelp :: P.Error -> IO a+errorActDisplayHelp e = do+  pn <- getProgName+  IO.hPutStr IO.stderr $ C.formatError pn e+  IO.hPutStrLn IO.stderr $ "enter \"" ++ pn ++ " -h\" for help."+  exitFailure++-- | A parser for simple command lines. Adds a @--help@ option for+-- you.+simpleHelp+  :: (ProgName -> String)+  -- ^ Indicate the help here. This function, when applied to the name+  -- of the program, returns help.  simpleHelp automatically adds+  -- options for @--help@ and @-h@ for you.++  -> [C.OptSpec a]+  -- ^ Options to parse++  -> Intersperse+  -- ^ Allow interspersion of options and positional arguments?++  -> (String -> Either C.InputError a)+  -- ^ How to parse positional arguments++  -> IO [a]+  -- ^ If the parser fails, the program will exit with an error.  If+  -- the user requested help, it will be displayed and the program+  -- exits successfully.  Otherwise, the options and positional+  -- arguments are returned here.+simpleHelp getHelp os ir getArg = do+  let shortcuts = [C.OptSpec ["help"] "h" (C.NoArg (displayAct getHelp))]+      opts = OptsWithPosArgs (Opts shortcuts os) ir getArg+  ei <- simpleIOCustomError errorActDisplayHelp opts+  case ei of+    Left act -> act+    Right as -> return as++-- | A parser for simple command lines without modes.  Adds options+-- for @--help@ and @--version@ for you.+simpleHelpVersion+  :: (ProgName -> String)+  -- ^ Indicate the help here. This function, when applied to the name+  -- of the program, returns help.  simpleHelpVersion automatically adds+  -- options for @--help@ and @-h@ for you.++  -> (ProgName -> String)+  -- ^ Indicate the version here. This function, when applied to the+  -- name of the program, returns a version string.  simpleHelpVersion+  -- automatically adds an option for @--version@ for you.++  -> [C.OptSpec a]+  -- ^ Options to parse++  -> Intersperse+  -- ^ Allow interspersion of options and positional arguments?++  -> (String -> Either C.InputError a)+  -- ^ How to parse positional arguments++  -> IO [a]+  -- ^ If the parser fails, the program will exit with an error.  If+  -- the user requested help or version information, it will be+  -- displayed and the program exits successfully.  Otherwise, the+  -- options and positional arguments are returned here.++simpleHelpVersion getHelp getVer os ir getArg = do+  let shortcuts = [ C.OptSpec ["help"] "h"+                      (C.NoArg (displayAct getHelp))+                  , C.OptSpec ["version"] ""+                      (C.NoArg (displayAct getVer)) ]+      opts = OptsWithPosArgs (Opts shortcuts os) ir getArg+  ei <- simpleIOCustomError errorActDisplayHelp opts+  case ei of+    Left act -> act+    Right as -> return as++-- # Helpers++-- | Handles positional arguments and errors with them.  The parser for+-- the positional argument must be passed in (this way it can+-- be parsed with nonOptionPosArg or nextWord, as appropriate; when+-- parsing interpsersed command lines, you will want nonOptionPosArg;+-- when parsing non-interspersed command lines, you will need+-- nextWord.)+parsePosArg+  :: P.Parser String+  -- ^ Parser for Word for next positional argument+  -> (String -> Either C.InputError a)+  -- ^ Function to handle positional arguments+  -> P.Parser a+parsePosArg pa f = do+  a <- pa+  case f a of+    Left e ->+      let msg = "invalid positional argument: \"" ++ a ++ "\""+      in case e of+          C.NoMsg -> fail msg+          C.ErrorMsg s -> fail $ msg ++ ": " ++ s+    Right g -> return g++-- | Parses options only, where they are not interspersed with+-- positional arguments.  Stops parsing only where it encouters a word+-- that does not begin with a dash.  This way if the user enters a bad+-- option, it shows in the error message as a bad option rather than+-- simply not getting parsed.+parseOptsNoIntersperse :: P.Parser a -> P.Parser [a]+parseOptsNoIntersperse p = P.manyTill p e where+  e = P.end <|> nonOpt+  nonOpt = P.lookAhead next+  next = (() <$ P.nonOptionPosArg) <|> P.stopper++-- | Parses options and positional arguments where the two are not+-- interspersed. Stops parsing options when a stopper is encountered+-- or at the first word that does not look like an option.+parseStopOpts+  :: P.Parser a+  -> (String -> Either C.InputError a)+  -> P.Parser [a]+parseStopOpts optParser p =+  (++)+  <$> parseOptsNoIntersperse optParser+  <* optional P.stopper+  <*> many (parsePosArg P.nextWord p)+++-- | @parseIntersperse o p@ parses options and positional arguments,+-- where o is a parser that parses options, and p is a function that,+-- when applied to a string, returns the appropriate type.+--+-- If a stopper has not yet been seen, any word that begins with a+-- hyphen will not be parsed as a positional argument.  Therefore, if+-- there is a word before a stopper and it begins with a hyphen, if it+-- is not a valid option then the parse will fail with an error.+parseIntersperse+  :: P.Parser a+  -> (String -> Either C.InputError a)+  -> P.Parser [a]+parseIntersperse optParser p =+  let pa = Just <$> parsePosArg P.nonOptionPosArg p+      po = Just <$> optParser+      ps = Nothing <$ P.stopper+      parser = po <|> ps <|> pa+  in catMaybes <$> P.manyTill parser P.end++-- | Looks at the next word. Succeeds if it is a non-option, or if we+-- are at the end of input. Fails otherwise.+endOrNonOpt :: P.Parser ()+endOrNonOpt = (P.lookAhead P.nonOptionPosArg >> return ())+              <|> P.end+
+ lib/Multiarg/Option.hs view
@@ -0,0 +1,45 @@+-- | These types represent options. Option names cannot have a dash as+-- their first or second character, and long option names cannot have+-- an equals sign anywhere in the name.+module Multiarg.Option (+  ShortOpt,+  unShortOpt,+  makeShortOpt,+  LongOpt,+  unLongOpt,+  makeLongOpt )+  where++-- | Short options. Options that are preceded with a single dash on+-- the command line and consist of a single letter. That single letter+-- cannot be a dash. Any other Unicode character is good (including+-- pathological ones like newlines).+newtype ShortOpt = ShortOpt { unShortOpt :: Char } deriving (Show, Eq, Ord)++-- | Creates a short option. Returns Nothing if the character is not+-- valid for a short option.+makeShortOpt :: Char -> Maybe ShortOpt+makeShortOpt c = case c of+  '-' -> Nothing+  x -> Just $ ShortOpt x++-- | Long options. Options that are preceded with two dashes on the+-- command line and typically consist of an entire mnemonic word, such+-- as @lines@. However, anything that is at least one letter long is+-- fine for a long option name. The name must be at least one+-- character long. It cannot have an equal sign anywhere in its+-- name. Otherwise any Unicode character is good (including+-- pathological ones like newlines).+data LongOpt = LongOpt { unLongOpt :: String } deriving (Show, Eq, Ord)++-- | Makes a long option. Returns Nothing if the string is not a valid+-- long option.+makeLongOpt :: String -> Maybe LongOpt+makeLongOpt t =+  if isValidLongOptText t then Just $ LongOpt t else Nothing+++isValidLongOptText :: String -> Bool+isValidLongOptText s = case s of+  [] -> False+  xs -> not $ '=' `elem` xs
+ lib/Multiarg/Prim.hs view
@@ -0,0 +1,681 @@+-- | Parser primitives. These are the only functions that have access+-- to the internals of the parser. Use these functions if you want to+-- build your own parser from scratch. If your needs are simpler, you+-- will want to look at "Multiarg.SimpleParser" or+-- "Multiarg.Combinator", which do a lot of grunt work+-- for you.+--+-- Internal design, especially the error handling, is based in large+-- part on Parsec, as described in the paper at+-- <http://legacy.cs.uu.nl/daan/pubs.html#parsec>.+module Multiarg.Prim (+    -- * Parser types+  Parser,++  -- * Running a parser++  -- | Each parser runner is applied to a list of Strings, which are the+  -- command line arguments to parse.+  parse,++  -- * Higher-level parser combinators+  good,+  choice,+  bind,+  lookAhead,++  -- ** Running parsers multiple times+  several,+  several1,+  manyTill,++  -- ** Failure and errors+  failString,+  genericThrow,+  (<?>),+  try,++  -- * Parsers+  -- ** Short options and arguments+  pendingShortOpt,+  nonPendingShortOpt,+  pendingShortOptArg,++  -- ** Long options and arguments+  exactLongOpt,+  approxLongOpt,++  -- ** Stoppers+  stopper,+  resetStopper,++  -- ** Positional (non-option) arguments+  nextWord,+  nextWordIs,+  nonOptionPosArg,+  matchApproxWord,++  -- ** Miscellaneous+  end,++  -- * Errors+  Description(..),+  Error(Error),+  InputDesc++  ) where+++import Multiarg.Option+  (ShortOpt,+    unShortOpt,+    LongOpt,+    unLongOpt,+    makeLongOpt )+import Control.Applicative ( Applicative, Alternative, optional )+import qualified Control.Applicative as A+import qualified Data.Set as Set+import Data.Set ( Set )+import qualified Control.Monad+import Control.Monad ( when, MonadPlus(mzero, mplus), guard, liftM )+import Data.Maybe (mapMaybe)+import Data.Monoid ( Monoid ( mempty, mappend ) )+import qualified Data.List as L+import Data.List (isPrefixOf)++-- | Parsers. Internally the parser tracks what input remains to be+-- parsed, whether there are any pending short options, and whether a+-- stopper has been seen. A parser can return a value of any type.+--+-- The parser also includes the notion of failure. Any parser can+-- fail; a failed parser affects the behavior of combinators such as+-- choice.+newtype Parser a = Parser { runParser :: State -> Consumed a }++instance Monad Parser where+  (>>=) = bind+  return = good+  fail = failString++instance Functor Parser where+  fmap = liftM++instance Applicative Parser where+  (<*>) = Control.Monad.ap+  pure = return++instance Alternative Parser where+  empty = genericThrow+  (<|>) = choice+  some = several1+  many = several++instance Monoid (Parser a) where+  mempty = genericThrow+  mappend = choice++instance MonadPlus Parser where+  mzero = genericThrow+  mplus = choice++type PendingShort = String+type Remaining = [String]+type SawStopper = Bool+data State = State PendingShort Remaining SawStopper++type InputDesc = String+data Description = Unknown | General String | Expected String+  deriving (Eq, Show, Ord)++-- | Error messages. To format error messages for nice display, see+-- 'Multiarg.Combinator.formatError'.+data Error = Error InputDesc [Description]+  deriving (Eq, Show, Ord)++data Reply a = Ok a State Error+             | Fail Error++data Consumed a = Consumed (Reply a)+                | Empty (Reply a)++-- | @good a@ always succeeds without consuming any input and has+-- result a. This provides the implementation for+-- 'Control.Monad.Monad.return' and+-- 'Control.Applicative.Applicative.pure'.+good :: a -> Parser a+good x = Parser $ \st -> Empty (Ok x st (Error (descLocation st) []))++-- | Combines two parsers into a single parser. The second parser can+-- optionally depend upon the result from the first parser.+--+-- This applies the first parser. If the first parser succeeds,+-- combine then takes the result from the first parser, applies the+-- function given to the result from the first parser, and then+-- applies the resulting parser.+--+-- If the first parser fails, combine will not apply the second+-- function but instead will bypass the second parser.+--+-- This provides the implementation for '>>=' in+-- 'Control.Monad.Monad'.+bind :: Parser a -> (a -> Parser b) -> Parser b+bind (Parser p) f = Parser $ \s ->+  case p s of+    Empty r1 -> case r1 of+      Ok x s' _ -> runParser (f x) s'+      Fail m -> Empty (Fail m)+    Consumed r1 -> Consumed $+      case r1 of+        Ok x s' _ -> case runParser (f x) s' of+          Consumed r -> r+          Empty r -> r+        Fail e -> Fail e++descLocation :: State -> InputDesc+descLocation (State ps rm st) = pending ++ next ++ stop+  where+    pending+      | null ps = ""+      | otherwise = "short option or short option argument: "+                  ++ ps ++ " "+    next = case rm of+      [] -> "no words remaining"+      x:_ -> "next word: " ++ x+    stop = if st then " (stopper already seen)" else ""+++-- | @failString s@ always fails without consuming any input. The+-- failure contains a record of the string passed in by s. This+-- provides the implementation for 'Control.Monad.Monad.fail'.+failString :: String -> Parser a+failString str = Parser $ \s ->+  Empty (Fail (Error (descLocation s) [General str]))+++-- | Fail with an unhelpful error message. Usually 'throwString' is+-- more useful, but this is handy to implement some typeclass+-- instances.+genericThrow :: Parser a+genericThrow = Parser $ \s ->+  Empty (Fail (Error (descLocation s) [Unknown]))++-- | Runs the first parser. If it fails without consuming any input,+-- then runs the second parser. If the first parser succeeds, then+-- returns the result of the first parser. If the first parser fails+-- and consumes input, then returns the result of the first+-- parser. This provides the implementation for+-- '<|>' in 'Control.Applicative.Alternative'.+choice :: Parser a -> Parser a -> Parser a+choice p q = Parser $ \s ->+  case runParser p s of+    Empty (Fail msg1) ->+      case runParser q s of+        Empty (Fail msg2) -> mergeError msg1 msg2+        Empty (Ok x s' msg2) -> mergeOk x s' msg1 msg2+        c -> c+    Empty (Ok x s' msg1) ->+      case runParser q s of+        Empty (Fail msg2) -> mergeOk x s' msg1 msg2+        Empty (Ok _ _ msg2) -> mergeOk x s' msg1 msg2+        c -> c+    c -> c+  where+    mergeOk x s msg1 msg2 = Empty (Ok x s (merge msg1 msg2))+    mergeError msg1 msg2 = Empty (Fail (merge msg1 msg2))+    merge (Error loc exp1) (Error _ exp2) =+      Error loc (exp1 ++ exp2)++-- | Applies 'error' if a parser would succeed without consuming any+-- input. Useful for preventing infinite loops on parsers like+-- 'several1'.+crashOnEmptyOk+  :: String+  -- ^ Use this label when applying 'error'++  -> Parser a+  -> Parser a+crashOnEmptyOk str p = Parser $ \s ->+  case runParser p s of+    Empty r -> case r of+      Ok _ _ _ ->+         error $ "multiarg: error: " ++ str+               ++ " applied to parser that succeeds without "+               ++ "consuming any input. Aborted to prevent "+               ++ "an infinite loop."+      e -> Empty e+    o -> o+               ++-- | Runs a parser one or more times. Runs the parser once and then+-- applies 'several'.+several1 :: Parser a -> Parser [a]+several1 p = do+  r1 <- p+  rs <- several p+  return $ r1:rs+++-- | Runs a parser zero or more times. If the last run of the parser+-- fails without consuming any input, this parser succeeds without+-- consuming any input. If the last run of the parser fails while+-- consuming input, this parser fails while consuming input. This+-- provides the implementation for 'many' in Control.Applicative.+several :: Parser a -> Parser [a]+several unwrapped =+  let p = crashOnEmptyOk "several" unwrapped+  in do+    maybeA <- optional p+    case maybeA of+      Nothing -> return []+      Just a -> do+        rest <- several unwrapped+        return $ a:rest+  ++-- | Runs the parser given. If it fails without consuming any input,+-- replaces all Expected messages with the one given. Otherwise,+-- returns the result of the parser unchanged.+(<?>) :: Parser a -> String -> Parser a+p <?> str = Parser $ \s ->+  case runParser p s of+    Empty (Fail m) -> Empty (Fail (expect m str))+    Empty (Ok x s' m) -> Empty (Ok x s' (expect m str))+    x -> x+  where+    expect (Error pos ls) s =+      let ls' = mapMaybe notExpected ls+          notExpected d = case d of+            Expected _ -> Nothing+            x -> Just x+      in Error pos ((Expected s) : ls')++infix 0 <?>++-- | Runs a parser. This is the only way to change a value of type+-- @Parser a@ into a value of type @a@ (that is, it is the only way to+-- \"get out of the Parser monad\" or to \"escape the Parser monad\".)+parse+  :: [String]+  -- ^ Command line arguments to parse. Presumably you got these from+  -- 'getArgs'. If there is any chance that you will be parsing+  -- Unicode strings, see the documentation in+  -- "Multiarg.GetArgs" before you use+  -- 'System.Environment.getArgs'.++  -> Parser a+  -- ^ Parser to run++  -> Either Error a+  -- ^ Success or failure. Any parser might fail; for example, the+  -- command line might not have any values left to parse. Use of the+  -- 'choice' combinator can lead to a list of failures.++parse ss p =+  let s = State "" ss False+      procReply r = case r of+        Ok x _ _ -> Right x+        Fail m -> Left m+  in case runParser p s of+      Consumed r -> procReply r+      Empty r -> procReply r++-- | Parses only pending short options. Fails without consuming any+-- input if there has already been a stopper or if there are no+-- pending short options. Fails without consuming any input if there+-- is a pending short option, but it does not match the short option+-- given. Succeeds and consumes a pending short option if it matches+-- the short option given.+pendingShortOpt :: ShortOpt -> Parser ()+pendingShortOpt so = Parser $ \s@(State pends rm stop) ->+  let msg = Error (descLocation s)+        [Expected ("pending short option: -" ++ [unShortOpt so])]+      gd s' = Consumed (Ok () s' msg)+      err = Empty (Fail msg)+  in maybe err gd $ do+    guard $ not stop+    (first, rest) <- case pends of+      [] -> mzero+      x:xs -> return (x, xs)+    when (unShortOpt so /= first) mzero+    return $ State rest rm stop++-- | @lookAhead p@ runs parser p. If p succeeds, lookAhead p succeeds+-- without consuming any input. If p fails without consuming any+-- input, so does lookAhead. If p fails and consumes input, lookAhead+-- also fails and consumes input. If this is undesirable, combine with+-- "try".+lookAhead :: Parser a -> Parser a+lookAhead p = Parser $ \s ->+  case runParser p s of+    Consumed r -> case r of+      Ok x _ e -> Empty (Ok x s e)+      e -> Consumed e+    e -> e++nextW :: Remaining -> Maybe (String, Remaining)+nextW rm = case rm of+  [] -> Nothing+  x:xs -> Just (x, xs)++-- | Parses only non-pending short options. Fails without consuming+-- any input if:+--+-- * there are pending short options+--+-- * there has already been a stopper+--+-- * there are no arguments left to parse+--+-- * the next argument is an empty string+--+-- * the next argument does not begin with a dash+--+-- * the next argument is a single dash+--+-- * the next argument is a short option but it does not match+--   the one given+--+-- * the next argument is a stopper+--+-- Otherwise, consumes the next argument, puts any remaining letters+-- from the argument into a pending short, and removes the first word+-- from remaining arguments to be parsed.+nonPendingShortOpt :: ShortOpt -> Parser ()+nonPendingShortOpt so = Parser $ \s@(State ps rm stop) ->+  let dsc = [Expected+            $ "non pending short option: -" ++ [unShortOpt so]]+      err = Error (descLocation s) dsc+      errRet = Empty (Fail err)+      gd (ps'', rm'') = Consumed (Ok () (State ps'' rm'' stop) err)+  in maybe errRet gd $ do+    guard $ null ps+    guard $ not stop+    (a, rm') <- nextW rm+    (maybeDash, word) <- case a of+      [] -> mzero+      x:xs -> return (x, xs)+    guard (maybeDash == '-')+    (letter, arg) <- case word of+      [] -> mzero+      x:xs -> return (x, xs)+    guard (letter == unShortOpt so)+    return (arg, rm')+++-- | Parses an exact long option. That is, the text of the+-- command-line option must exactly match the text of the+-- option. Returns any argument that is attached to+-- the same word of the option with an equal sign (for example,+-- @--follow=\/dev\/random@ will return @Just \"\/dev\/random\"@ for the+-- argument.) If there is no equal sign, returns Nothing for the+-- argument. If there is an equal sign but there is nothing after it,+-- returns @Just \"\"@ for the argument.+--+-- If you do not want your long option to have equal signs and+-- GNU-style option arguments, wrap this parser in something that will+-- fail if there is an option argument.+--+-- Fails without consuming any input if:+--+-- * there are pending short options+--+-- * a stopper has been parsed+--+-- * there are no arguments left on the command line+--+-- * the next argument on the command line does not begin with+--   two dashes+--+-- * the next argument on the command line is @--@ (a stopper)+--+-- * the next argument on the command line does begin with two+--   dashes but its text does not match the argument we're looking for++exactLongOpt :: LongOpt -> Parser (Maybe String)+exactLongOpt lo = Parser $ \s@(State ps rm sp) ->+  let msg = Error (descLocation s)+            [Expected ("long option: --" ++ unLongOpt lo)]+      gd (arg, newRm) = Consumed (Ok arg (State ps newRm sp) msg)+      err = Empty (Fail msg)+  in maybe err gd $ do+    guard $ null ps+    guard $ not sp+    (x, rm') <- nextW rm+    (word, afterEq) <- getLongOption x+    guard (word == unLongOpt lo)+    return (afterEq, rm')+    ++getLongOption :: String -> Maybe (String, Maybe String)+getLongOption str = do+  guard (str /= "--")+  let (pre, word, afterEq) = splitLongWord str+  guard (pre == "--")+  return (word, afterEq)++-- | Takes a single String and returns a tuple, where the first element+-- is the first two letters, the second element is everything from the+-- third letter to the equal sign, and the third element is Nothing if+-- there is no equal sign, or Just String with everything after the+-- equal sign if there is one.+splitLongWord :: String -> (String, String, Maybe String)+splitLongWord t = (f, s, r) where+  (f, rest) = L.splitAt 2 t+  (s, withEq) = L.break (== '=') rest+  r = case withEq of+    [] -> Nothing+    _:xs -> Just xs++approxLongOptError :: [LongOpt] -> [Description]+approxLongOptError =+  map (Expected . ("long option: --" ++) . unLongOpt)+++assert :: e -> Bool -> Either e ()+assert e b = if b then Right () else Left e++fromMaybe :: e -> Maybe a -> Either e a+fromMaybe e = maybe (Left e) Right++-- | Examines the next word. If it matches a LongOpt in the set+-- unambiguously, returns a tuple of the word actually found and the+-- matching word in the set and the accompanying text after the equal+-- sign (if any). If the Set is empty, this parser will always fail.+approxLongOpt ::+  Set LongOpt+  -> Parser (String, LongOpt, Maybe String)+approxLongOpt ts = Parser $ \s@(State ps rm stop) ->+  let err ls = Error (descLocation s) (approxLongOptError ls)+      ert ls = Empty (Fail $ err ls)+      gd (found, opt, arg, rm'') =+        Consumed (Ok (found, opt, arg) (State ps rm'' stop)+                     (err allOpts))+      allOpts = Set.toList ts+  in either ert gd $ do+    assert allOpts $ null ps+    assert allOpts $ not stop+    (x, rm') <- fromMaybe allOpts $ nextW rm+    (word, afterEq) <- fromMaybe allOpts $ getLongOption x+    opt <- fromMaybe allOpts $ makeLongOpt word+    if Set.member opt ts+      then return (word, opt, afterEq, rm')+      else do+      let p t = word `isPrefixOf` unLongOpt t+          matches = Set.filter p ts+      case Set.toList matches of+        [] -> Left allOpts+        (m:[]) -> return (word, m, afterEq, rm')+        ls -> Left ls+++-- | Parses only pending short option arguments. For example, for the+-- @tail@ command, if you enter the option @-c25@, then after parsing+-- the @-c@ option the @25@ becomes a pending short option argument+-- because it was in the same command line argument as the @-c@.+--+-- Fails without consuming any input if:+--+-- * a stopper has already been parsed+--+-- * there are no pending short option arguments+--+-- On success, returns the String of the pending short option argument+-- (this String will never be empty).+pendingShortOptArg :: Parser String+pendingShortOptArg = Parser $ \st@(State ps rm sp) ->+  let msg = [Expected "pending short option argument"]+      err = Error (descLocation st) msg+      ert = Empty (Fail err)+      gd str = Consumed (Ok str (State "" rm sp) err)+  in maybe ert gd $ do+     guard $ not sp+     case ps of+      [] -> mzero+      xs -> return xs+++-- | Parses a \"stopper\" - that is, a double dash. Changes the internal+-- state of the parser to reflect that a stopper has been seen.+stopper :: Parser ()+stopper = Parser $ \s@(State ps rm sp) ->+  let err = Error (descLocation s)+        [Expected "stopper, \"--\""]+      ert = Empty (Fail err)+      gd rm'' = Consumed (Ok () (State ps rm'' True) err)+  in maybe ert gd $ do+     guard $ not sp+     guard . null $ ps+     (x, rm') <- nextW rm+     guard $ x == "--"+     return rm'+++-- | If a stopper has already been seen, change the internal state+-- back to indicating that no stopper has been seen.+resetStopper :: Parser ()+resetStopper = Parser $ \s@(State ps rm _) ->+  Empty (Ok () (State ps rm False) (Error (descLocation s) []))+++-- | try p behaves just like p, but if p fails, try p will not consume+-- any input.+try :: Parser a -> Parser a+try a = Parser $ \s ->+  case runParser a s of+    Consumed r -> case r of+      Fail e -> Empty (Fail e)+      o -> Consumed o+    o -> o+++-- | Returns the next string on the command line as long as there are+-- no pendings. Succeeds even if a stopper is present. Be careful -+-- this will return the next string even if it looks like an option+-- (that is, it starts with a dash.) Consider whether you should be+-- using nonOptionPosArg instead. However this can be useful when+-- parsing command line options after a stopper.+nextWord :: Parser String+nextWord = Parser $ \s@(State ps rm sp) ->+  let err = Error (descLocation s) [dsc]+      dsc = Expected "next word"+      ert = Empty (Fail err)+      gd (str, rm'') = Consumed $ Ok str (State ps rm'' sp) err+  in maybe ert gd $ do+      guard $ null ps+      nextW rm+      ++-- | Parses the next word on the command line, but only if it exactly+-- matches the word given. Otherwise, fails without consuming any+-- input. Also fails without consuming any input if there are pending+-- short options or if a stopper has already been parsed. Does not pay+-- any attention to whether a stopper is present.+nextWordIs :: String -> Parser ()+nextWordIs str = Parser $ \s@(State ps rm sp) ->+  let err = Error (descLocation s) [dsc]+      dsc = Expected $ "next argument \"" ++ str ++ "\""+      ert = Empty $ Fail err+      gd rm'' = Consumed $ Ok () (State ps rm'' sp) err+  in maybe ert gd $ do+      guard $ null ps+      (a, rm') <- nextW rm+      guard (a == str)+      return rm'+++-- | If there are pending short options, fails without consuming any input.+--+-- Otherwise, if a stopper has NOT already been parsed, then returns+-- the next word if it is either a single dash or any other word that+-- does not begin with a dash. If the next word does not meet these+-- criteria, fails without consuming any input.+--+-- Otherwise, if a stopper has already been parsed, then returns the+-- next word, regardless of whether it begins with a dash or not.+nonOptionPosArg :: Parser String+nonOptionPosArg = Parser $ \s@(State ps rm sp) ->+  let err = Error (descLocation s) [dsc]+      dsc = Expected "non option positional argument"+      ert = Empty $ Fail err+      gd (str, rm'') = Consumed $ Ok str (State ps rm'' sp) err+  in maybe ert gd $ do+    guard $ null ps+    (x, rm') <- nextW rm+    result <- if sp+              then return x+              else case x of+                [] -> return x+                '-':[] -> return "-"+                f:_ -> if f == '-' then mzero else return x+    return (result, rm')+++-- | Succeeds if there is no more input left.+end :: Parser ()+end = Parser $ \s@(State ps rm _) ->+  let err = Error (descLocation s) [dsc]+      dsc = Expected "end of input"+      ert = Empty $ Fail err+      gd = Empty $ Ok () s err+  in if null ps && null rm then gd else ert+++-- | Examines the possible words in Set. If there are no pendings,+-- then get the next word and see if it matches one of the words in+-- Set. If so, returns the word actually parsed and the matching word+-- from Set. If there is no match, fails without consuming any+-- input. Pays no attention to whether a stopper has been seen.+matchApproxWord :: Set String -> Parser (String, String)+matchApproxWord set = Parser $ \s@(State ps rm sp) ->+  let err = Error (descLocation s) . lsDsc+      lsDsc = map (Expected . ("next word: " ++))+      ert = Empty . Fail . err+      gd (act, mtch, rm'') =+        Consumed $ Ok (act, mtch) (State ps rm'' sp) (err allWords)+      allWords = Set.toList set+  in either ert gd $ do+      assert allWords $ null ps+      (x, rm') <- fromMaybe allWords $ nextW rm+      let matches = Set.filter p set+          p t = x `isPrefixOf` t+      case Set.toList matches of+        [] -> Left allWords+        r:[] -> return (x, r, rm')+        xs -> Left xs+      +-- | @manyTill p end@ runs parser p zero or more times until parser+-- @end@ succeeds. If @end@ succeeds and consumes input, that input is+-- also consumed. in the result of @manyTill@. If that is a problem,+-- wrap it in @lookAhead@. Also, if @end@ fails and consumes input,+-- @manyTill@ fails and consumes input. If that is a problem, wrap+-- @end@ in @try@.+manyTill :: Parser a -> Parser end -> Parser [a]+manyTill p e = do+  maybeEnd <- optional e+  case maybeEnd of+    Just _ -> return []+    Nothing -> do+      a <- crashOnEmptyOk "manyTill" p+      rs <- manyTill p e+      return $ a:rs+
+ lib/Multiarg/SampleParser.hs view
@@ -0,0 +1,70 @@+-- | This is sample code using "Multiarg". This could+-- be a command-line parser for the version of the Unix command @tail@+-- that is included with GNU coreutils version 8.5. "main" simply gets+-- the command line arguments, parses them, and prints out what was+-- parsed. To test it out, simply compile an executable that looks+-- like this and then feed it different options:+--+-- > import Multiarg.SampleParser+-- > main = sampleMain Intersperse+--+-- or:+--+-- > import Multiarg.SampleParser+-- > main = sampleMain StopOptions+--+-- The code in the module is the sample code; the sample code is not+-- in the Haddock documentation! If you're reading this in Haddock,+-- you will want to also take a look at the actual source code.+module Multiarg.SampleParser where++import qualified Multiarg.Combinator as C+import qualified Multiarg.CommandLine as P++data Flag =+  Bytes String+  | Follow (Maybe String)+  | Retry+  | Lines String+  | Stats String+  | Pid String+  | Quiet+  | Sleep String+  | Verbose+  | Help+  | Version+  | Filename String+  deriving Show++specs :: [C.OptSpec Flag]++specs =+  [ C.OptSpec ["bytes"]                     ['c']+              (C.OneArg (return . Bytes))++  , C.OptSpec ["follow"]                    ['f']+              (C.OptionalArg (return . Follow))++  , C.OptSpec ["follow-retry"]              ['F']     (C.NoArg Retry)++  , C.OptSpec ["lines"]                     ['n']+              (C.OneArg (return . Lines))++  , C.OptSpec ["max-unchanged-stats"]       []+              (C.OneArg (return . Stats))++  , C.OptSpec ["pid"]                       []+              (C.OneArg (return . Pid))+  , C.OptSpec ["quiet"]                     ['q']     (C.NoArg Quiet)++  , C.OptSpec ["sleep-interval"]            ['s']+              (C.OneArg (return . Sleep))+  , C.OptSpec ["verbose"]                   ['v']     (C.NoArg Verbose)+  , C.OptSpec ["help"]                      []        (C.NoArg Help)+  , C.OptSpec ["version"]                   []        (C.NoArg Version)+  ]++sampleMain :: P.Intersperse -> IO ()+sampleMain i = do+  r <- P.simpleIO specs i (return . Filename)+  print r
− lib/System/Console/MultiArg.hs 
@@ -1,167 +0,0 @@--- | A combinator library for building command-line parsers.--module System.Console.MultiArg (--  -- | To say this library is inspired by Parsec would probably insult the-  -- creators of Parsec, as this library could not possibly be as-  -- elegant or throughly considered as Parsec is. Nevertheless this-  -- library can be used in a similar style as Parsec, but is-  -- specialized for parsing command lines.-  ---  -- This parser was built because I could not find anything that would-  -- readily parse command lines where the options took more than one-  -- argument. For example, for the @tail@ command on GNU systems, the-  -- --lines option takes one argument to specify how many lines you-  -- want to see. Well, what if you want to build a program with an-  -- option that takes /two/ arguments, like @--foo bar baz@? I found no-  -- such library so I built this one. Nevertheless, using this library-  -- you can build parsers to parse a variety of command line-  -- vocabularies, from simple to complex.--  -- * Terminology--  -- | Some terms are used throughout multiarg:-  ---  -- [@word@] When you run your program from the Unix shell prompt,-  -- your shell is responsible for splitting the command line into-  -- words. Typically you separate words with spaces, although quoting-  -- can affect this. multiarg parses lists of words. Each word can-  -- consist of a single long option, a single long option and an-  -- accompanying option argument, a single short option, multiple-  -- short options, and even one or more multiple short options and an-  -- accompanying short option argument. Or, a word can be a-  -- positional argument or a stopper. All these are described below.-  ---  -- [@option@] Options allow a user to specify ways to tune the-  -- operation of a program. Typically options are indeed optional,-  -- although some programs do sport \"required options\" (a bit of an-  -- oxymoron). Options can be either short options or long-  -- options. Also, options can take arguments.-  ---  -- [@short option@] An option that is specified with a single hyphen-  -- and a single letter. For example, for the program @tail(1)@,-  -- possible short options include @n@ and @v@. With multiarg it is-  -- possible to easily parse short options that are specified in-  -- different words or in the same word. For example, if a user wants-  -- to run @tail@ with two options, he might type @tail -v -f@ or he-  -- might type @tail -vf@.-  ---  -- [@long option@] An option that is specified using two hyphens and-  -- what is usually a mnemonic word, though it could be as short as a-  -- single letter. For example, @tail(1)@ has long options including-  -- @follow@ and @verbose@. The user would specify these on the-  -- command line by typing @tail --follow --verbose@.-  ---  -- [@option argument@] Some options take additional arguments that-  -- are specific to the option and change what the option does. For-  -- instance, the @lines@ option to @tail(1)@ takes a single,-  -- optional argument, which is the number of lines to show. Option-  -- arguments can be optional or required, and a single option can-  -- take a mulitple, fixed number of arguments and it can take a-  -- variable number of arguments. Option arguments can be given in-  -- various ways. They can be specified in the same word as a long-  -- option by using an equals sign; they can also be specified in the-  -- same word as a short option simply by placing them in the same-  -- word, or they can be specified in the following word. For-  -- example, these different command lines all mean the same thing;-  -- @tail --verbose --lines=20@, @tail --verbose --lines 20@, @tail-  -- -vn 20@, @tail -v -n20@, @tail -vn20@, and @tail -v -n 20@, and-  -- numerous other combinations also have the same meaning.-  ---  -- [@GNU-style option argument@] A long option with an argument-  -- given with an equal sign, such as [@lines=20@].-  ---  -- [@positional argument@] A word on the command line that is not an-  -- option or an argument to an option. For instance, with @tail(1)@,-  -- you specify the files you want to see by using positional-  -- arguments. In the command @tail -n 10 myfile@, @myfile@ is a-  -- positional argument. For some programs, such as @git@ or @darcs@,-  -- a positional argument might be a \"command\" or a \"mode\", such-  -- as the @commit@ in @git commit@ or the @whatsnew@ in @darcs-  -- whatsnew@. multiarg has no primitive parsers that treat these-  -- positional arguments specially but it is trivial to build a-  -- parser for command lines such as this, too.-  ---  -- [@stopper@] A single word consisting solely of two hyphens,-  -- @--@. The user types this to indicate that all subsequent words-  -- on the command line are positional arguments, even if they begin-  -- with hyphens and therefore look like they might be options.-  ---  -- [@pending@] The user might specify more than one short option, or-  -- a short option and a short option argument, in a single word. For-  -- example, she might type @tail -vl20@. After parsing the @v@-  -- option, the Parser makes @l20@ into a \"pending\". The next-  -- parser can then treat @l20@ as an option argument to the @v@-  -- option (which is probably not what was wanted) or the next parser-  -- can parse @l@ as a short option. This would result in a-  -- \"pending\" of @20@. Then, the next parser can treat @20@ as an-  -- option argument. After that parse there will be no pendings.--  -- * Getting started--  -- |If your needs are simple to moderately complicated just look at the-  -- "System.Console.MultiArg.CommandLine" module, which uses the-  -- underlying combinators to build a simple parser for you. That-  -- module is already exported from this module for easy usage.-  ---  -- "System.Console.MultiArg.CommandLine" also has a parser that can-  -- handle multi-mode commands (examples include @git@, @darcs@, and-  -- @cvs@.)-  ---  -- For maximum flexibility you will want to start with the-  -- "System.Console.MultiArg.Prim" module. Using those parsers you-  -- can easily build parsers that are quite complicated. The parsers-  -- can check for errors along the way, simplifying the sometimes-  -- complex task of ensuring that data a user supplied on the command-  -- line is good. You can easily build parsers for programs that take-  -- no options, take dozens of options, require that options be given-  -- in a particular order, require that some options be given, or bar-  -- some combinations of options. You might also require particular-  -- positional arguments. Other helpful functions are in-  -- "System.Console.MultiArg.Combinator". You will also want to-  -- examine the source code for "System.Console.MultiArg.Combinator"-  -- and "System.Console.MultiArg.CommandLine" as these show some-  -- ways to use the primitive parsers and combinators.--  -- * Non-features and shortcomings-  ---  -- | multiarg isn't perfect; no software is. multiarg does not-  -- automatically make online help for your command line-  -- parsers. Getting this right would be tricky given the nature of-  -- the code and I don't even want to bother trying, as I just write-  -- my own online help in a text editor.-  ---  -- multiarg partially embraces \"The Tao of Option Parsing\" that-  -- Python's Optik (<http://optik.sourceforge.net/>) follows. Read-  -- \"The Tao of Option Parsing\" here:-  ---  -- <http://optik.sourceforge.net/doc/1.5/tao.html>-  ---  -- multiarg's philosophy is similar to that of Optik, which-  -- means you won't be able to use multiarg to (easily) build a clone-  -- to the UNIX @find(1)@ command. (You could do it, but multiarg won't-  -- help you very much.)-  ---  -- multiarg can be complicated, although I'd like to believe this is-  -- because it addresses a complicated problem in a flexible way.--  -- * Projects usings multiarg--  -- | * Penny, an extensible double-entry accounting-  -- system. <http://hackage.haskell.org/package/penny-lib> The code-  -- using multiarg is woven throughout the system; for example, see-  -- the Penny.Liberty module.---    module System.Console.MultiArg.Combinator-  , module System.Console.MultiArg.CommandLine-  , module System.Console.MultiArg.Option-  , module System.Console.MultiArg.Prim-  , module System.Environment-  ) where--import System.Console.MultiArg.Combinator-import System.Console.MultiArg.CommandLine-import System.Console.MultiArg.Option-import System.Console.MultiArg.Prim-import System.Environment
− lib/System/Console/MultiArg/Combinator.hs 
@@ -1,478 +0,0 @@--- | Combinators that are useful for building command-line--- parsers. These build off the functions in--- "System.Console.MultiArg.Prim". Unlike those functions, these--- functions have no access to the internals of the parser.-module System.Console.MultiArg.Combinator (-  -- * Parser combinators-  notFollowedBy,--  -- * Combined long and short option parser-  OptSpec(OptSpec, longOpts, shortOpts, argSpec),-  InputError(..),-  reader,-  optReader,-  ArgSpec(..),-  parseOption,--  -- * Formatting errors-  formatError-  ) where--import Data.List (isPrefixOf, intersperse, nubBy)-import Data.Set ( Set )-import qualified Data.Set as Set-import Control.Applicative-       ((<*>), optional, (<$), (*>), (<|>), many)--import System.Console.MultiArg.Prim-  ( Parser, try, approxLongOpt,-    nextWord, pendingShortOptArg, nonOptionPosArg,-    pendingShortOpt, nonPendingShortOpt, nextWord, (<?>),-    Error(..), Description(..))-import System.Console.MultiArg.Option-  ( LongOpt, ShortOpt, unLongOpt,-    makeLongOpt, makeShortOpt, unShortOpt )-import qualified Data.Map as M-import Data.Map ((!))-import Data.Maybe (fromMaybe, mapMaybe)-import Data.Monoid ( mconcat )----- | @notFollowedBy p@ succeeds only if parser p fails. If p fails,--- notFollowedBy succeeds without consuming any input. If p succeeds--- and consumes input, notFollowedBy fails and consumes input. If p--- succeeds and does not consume any input, notFollowedBy fails and--- does not consume any input.-notFollowedBy :: Parser a -> Parser ()-notFollowedBy p =-  () <$ ((try p >> fail "notFollowedBy failed")-         <|> return ())---unsafeShortOpt :: Char -> ShortOpt-unsafeShortOpt c =-  fromMaybe (error $ "invalid short option: " ++ [c])-            (makeShortOpt c)--unsafeLongOpt :: String -> LongOpt-unsafeLongOpt c =-  fromMaybe (error $ "invalid long option: " ++ c)-            (makeLongOpt c)----- |Specifies options for the 'parseOption' function. Each OptSpec--- represents one command-line option.-data OptSpec a = OptSpec {-  longOpts :: [String]-  -- ^ Each String is a single long option, such as @version@. When-  -- the user specifies long options on the command line, she must-  -- type two dashes; however, do not include the dashes when you-  -- specify the long option here. Strings you specify as long options-  -- cannot include a dash as either the first or the second-  -- character, and they cannot include an equal sign anywhere. If-  -- your long option does not meet these conditions, a runtime error-  -- will occur.---  , shortOpts :: [Char]-    -- ^ Each Char is a single short option, such as @v@. The-    -- character cannot be a dash; if it is, a runtime error will occur.--  , argSpec :: ArgSpec a-    -- ^ What to do each time one of the given long options or-    -- short options appears on the command line.-  }--instance Functor OptSpec where-  fmap f (OptSpec ls ss as) = OptSpec ls ss (fmap f as)---- | Reads in values that are members of Read. Provides a generic--- error message if the read fails.-reader :: Read a => String -> Either InputError a-reader s = case reads s of-  (x, ""):[] -> return x-  _ -> Left . ErrorMsg $ "could not parse option argument"---- | Reads in values that are members of Read, but the value does not--- have to appear on the command line. Provides a generic error--- message if the read fails. If the argument is Nothing, returns--- Nothing.-optReader-  :: Read a-  => Maybe String-  -> Either InputError (Maybe a)-optReader ms = case ms of-  Nothing -> return Nothing-  Just s -> case reads s of-    (x, ""):[] -> return (Just x)-    _ -> Left . ErrorMsg $ "could not parse option argument"---- | Indicates errors when parsing options to arguments.-data InputError-  = NoMsg-  -- ^ No error message accompanies this failure. multiarg will create-  -- a generic error message for you.--  | ErrorMsg String-  -- ^ Parsing the argument failed with this error message. An example-  -- might be @option argument is not an integer@ or @option argument-  -- is too large@. The text of the options the user provided is-  -- automatically prepended to the error message, so do not replicate-  -- this in your message.--  deriving (Eq, Show)---- | Create an error message from an InputError.-errorMsg-  :: Either LongOpt ShortOpt-  -- ^ The option with the faulty argument--  -> [String]-  -- ^ The faulty command line arguments--  -> InputError-  -> String-errorMsg badOpt ss err = arg ++ opt ++ msg-  where-    arg = let aw = if length ss > 1 then "arguments " else "argument "-              ws = concat . intersperse " " . map quote $ ss-              quote s = "\"" ++ s ++ "\""-          in aw ++ ws-    opt = " to option " ++ optDesc-    optDesc = case badOpt of-      Left lo -> "--" ++ unLongOpt lo-      Right so -> "-" ++ [unShortOpt so]-    msg = " invalid" ++ detail-    detail = case err of-      NoMsg -> ""-      ErrorMsg s -> ": " ++ s------ | Specifies how many arguments each option takes. As with--- 'System.Console.GetOpt.ArgDescr', there are (at least) two ways to--- use this type. You can simply represent each possible option using--- different data constructors in an algebraic data type. Or you can--- have each ArgSpec yield a function that transforms a record. For an--- example that uses an algebraic data type, see--- "System.Console.MultiArg.SampleParser".------ Most of these value constructors take as an argument a function--- that returns an Either.  The function should return a @Left--- InputError@ if the parsing of the arguments failed--if, for--- example, the user needs to enter an integer but she instead input a--- letter.  The functions should return a Right if parsing of the--- arguments was successful.-data ArgSpec a =-  NoArg a-  -- ^ This option takes no arguments--  | OptionalArg (Maybe String -> Either InputError a)-    -- ^ This option takes an optional argument. As noted in \"The Tao-    -- of Option Parsing\", optional arguments can result in some-    -- ambiguity. (Read it here:-    -- <http://optik.sourceforge.net/doc/1.5/tao.html>) If option @a@-    -- takes an optional argument, and @b@ is also an option, what-    -- does @-ab@ mean? SimpleParser resolves this ambiguity by-    -- assuming that @b@ is an argument to @a@. If the user does not-    -- like this, she can specify @-a -b@ (in such an instance @-b@ is-    -- not parsed as an option to @-a@, because @-b@ begins with a-    -- hyphen and therefore \"looks like\" an option.) Certainly-    -- though, optional arguments lead to ambiguity, so if you don't-    -- like it, don't use them :)--  | OneArg (String -> Either InputError a)-    -- ^ This option takes one argument. Here, if option @a@ takes one-    -- argument, @-a -b@ will be parsed with @-b@ being an argument to-    -- option @a@, even though @-b@ starts with a hyphen and therefore-    -- \"looks like\" an option.--  | TwoArg (String -> String -> Either InputError a)-    -- ^ This option takes two arguments. Parsed similarly to-    -- 'OneArg'.--  | ThreeArg (String -> String -> String -> Either InputError a)-    -- ^ This option takes three arguments. Parsed similarly to-    -- 'OneArg'.--  | VariableArg ([String] -> Either InputError a)-    -- ^ This option takes a variable number of arguments--zero or-    -- more. Option arguments continue until the command line contains-    -- a word that begins with a hyphen. For example, if option @a@-    -- takes a variable number of arguments, then @-a one two three-    -- -b@ will be parsed as @a@ taking three arguments, and @-a -b@-    -- will be parsed as @a@ taking no arguments. If the user enters-    -- @-a@ as the last option on the command line, then the only way-    -- to indicate the end of arguments for @a@ and the beginning of-    -- positional argments is with a stopper.--  | ChoiceArg [(String, a)]-    -- ^ This option takes a single argument, which must match one of-    -- the strings given in the list. The user may supply the shortest-    -- unambiguous string. If the argument list to ChoiceArg has-    -- duplicate strings, only the first string is used. For instance,-    -- ChoiceArg could be useful if you were parsing the @--color@-    -- option to GNU grep, which requires the user to supply one of-    -- three arguments: @always@, @never@, or @auto@.---instance Functor ArgSpec where-  fmap f a = case a of-    NoArg i -> NoArg $ f i-    ChoiceArg gs ->-      ChoiceArg . map (\(s, r) -> (s, f r)) $ gs--    OptionalArg g -> OptionalArg $ \ms -> fmap f (g ms)--    OneArg g ->-      OneArg $ \s1 -> fmap f (g s1)--    TwoArg g ->-      TwoArg $ \s1 s2 -> fmap f (g s1 s2)--    ThreeArg g ->-      ThreeArg $ \s1 s2 s3 -> fmap f (g s1 s2 s3)--    VariableArg g ->-      VariableArg $ \ls -> fmap f (g ls)----- | Parses a single command line option. Examines all the options--- specified using multiple OptSpec and parses one option on the--- command line accordingly. Fails without consuming any input if the--- next word on the command line is not a recognized option. Allows--- the user to specify the shortest unambiguous match for long--- options; for example, the user could type @--verb@ for @--verbose@--- and @--vers@ for @--version@.------ This function is applied to a list of OptSpec, rather than to a--- single OptSpec, because in order to correctly handle the parsing of--- shortened long options (e.g. @--verb@ rather than @--verbose@) it--- is necessary for one function to have access to all of the--- OptSpec. Applying this function multiple times to different lists--- of OptSpec and then using the @<|>@ function to combine them will--- break the proper parsing of shortened long options.------ For an example that uses this function, see--- "System.Console.MultiArg.SimpleParser".-parseOption :: [OptSpec a] -> Parser a-parseOption os =-  let longs = longOptParser os-  in case mconcat ([shortOpt] <*> os) of-    Nothing -> longs-    Just shorts -> longs <|> shorts--longOptParser :: [OptSpec a] -> Parser a-longOptParser os = longOpt (longOptSet os) (longOptMap os)---longOptSet :: [OptSpec a] -> Set LongOpt-longOptSet = Set.fromList . concatMap toOpts where-  toOpts = map unsafeLongOpt . longOpts--longOptMap :: [OptSpec a] -> M.Map LongOpt (ArgSpec a)-longOptMap = M.fromList . concatMap toPairs where-  toPairs (OptSpec los _ as) = map (toPair as) los where-    toPair a s = (unsafeLongOpt s, a)--longOpt ::-  Set LongOpt-  -> M.Map LongOpt (ArgSpec a)-  -> Parser a-longOpt set mp = do-  (_, lo, maybeArg) <- approxLongOpt set-  let spec = mp ! lo-      maybeNextArg = maybe nextWord return maybeArg-  case spec of-    NoArg a -> case maybeArg of-      Nothing -> return a-      Just _ -> fail $ "option " ++ unLongOpt lo-                  ++ " does not take argument"-    ChoiceArg ls -> do-      s <- maybeNextArg-      case matchAbbrev ls s of-        Nothing -> fail $ "option " ++ unLongOpt lo-                   ++ " requires an argument: "-                   ++ (concat . intersperse ", " . map fst $ ls)-        Just g -> return g--    OptionalArg f -> case maybeArg of-      Nothing -> either (fail . errorMsg (Left lo) []) return-                 $ f Nothing-      Just s -> either (fail . errorMsg (Left lo) [s]) return-                $ f (Just s)---    OneArg f -> maybeNextArg >>= g-      where-        g a = either (fail . errorMsg (Left lo) [a]) return-              $ f a--    TwoArg f -> do-      a1 <- maybeNextArg-      a2 <- nextWord-      either (fail . errorMsg (Left lo) [a1, a2]) return-        $ f a1 a2--    ThreeArg f -> do-      a1 <- maybeNextArg-      a2 <- nextWord-      a3 <- nextWord-      either (fail . errorMsg (Left lo) [a1, a2, a3]) return-        $ f a1 a2 a3--    VariableArg f -> do-      as <- many nonOptionPosArg-      let args = case maybeArg of-            Nothing -> as-            Just a -> a:as-      either (fail . errorMsg (Left lo) args) return-        $ f args---shortOpt :: OptSpec a -> Maybe (Parser a)-shortOpt o = mconcat parsers where-  parsers = map mkParser . shortOpts $ o-  mkParser c =-    let opt = unsafeShortOpt c-    in Just $ nextShort opt *> case argSpec o of-      NoArg a -> return a-      ChoiceArg ls -> shortChoiceArg opt ls-      OptionalArg f -> shortOptionalArg opt f-      OneArg f -> shortOneArg opt f-      TwoArg f -> shortTwoArg opt f-      ThreeArg f -> shortThreeArg opt f-      VariableArg f -> shortVariableArg opt f---- | Parses a short option without an argument, either pending or--- non-pending. Fails with a single error message rather than two.-nextShort :: ShortOpt -> Parser ()-nextShort o = p <?> ("short option: -" ++ [unShortOpt o])-  where-    p = do-      r1 <- optional $ pendingShortOpt o-      case r1 of-        Just () -> return ()-        Nothing -> nonPendingShortOpt o---shortVariableArg-  :: ShortOpt-  -> ([String] -> Either InputError a)-  -> Parser a-shortVariableArg so f = do-  maybeSameWordArg <- optional pendingShortOptArg-  args <- many nonOptionPosArg-  let as = case maybeSameWordArg of-        Nothing -> args-        Just a -> a:args-  either (fail . errorMsg (Right so) as) return $ f as---shortOneArg-  :: ShortOpt-  -> (String -> Either InputError a)-  -> Parser a-shortOneArg so f = do-  a <- firstShortArg-  either (fail . errorMsg (Right so) [a]) return $ f a--firstShortArg :: Parser String-firstShortArg =-  optional pendingShortOptArg >>= maybe nextWord return---shortChoiceArg :: ShortOpt -> [(String, a)] -> Parser a-shortChoiceArg opt ls =-  firstShortArg-  >>= maybe err return . matchAbbrev ls-  where-    err = fail $ "option " ++ [unShortOpt opt] ++ " requires "-          ++ "one argument: "-          ++ (concat . intersperse " " . map fst $ ls)---shortTwoArg-  :: ShortOpt-  -> (String -> String -> Either InputError a)-  -> Parser a-shortTwoArg so f = do-  a1 <- firstShortArg-  a2 <- nextWord-  either (fail . errorMsg (Right so) [a1, a2]) return-    $ f a1 a2---shortThreeArg-  :: ShortOpt-  -> (String -> String -> String -> Either InputError a)-  -> Parser a-shortThreeArg so f = do-  a1 <- firstShortArg-  a2 <- nextWord-  a3 <- nextWord-  either (fail . errorMsg (Right so) [a1, a2, a3]) return-    $ f a1 a2 a3--shortOptionalArg-  :: ShortOpt-  -> (Maybe String -> Either InputError a)-  -> Parser a-shortOptionalArg so f = do-  maybeSameWordArg <- optional pendingShortOptArg-  case maybeSameWordArg of-    Nothing -> do-      maybeArg <- optional nonOptionPosArg-      case maybeArg of-        Nothing -> either (fail . errorMsg (Right so) []) return-                   $ f Nothing-        Just a -> either (fail . errorMsg (Right so) [a]) return-                  $ f (Just a)-    Just a -> either (fail . errorMsg (Right so) [a]) return-              $ f (Just a)------ | Finds the unambiguous short match for a string, if there is--- one. Returns a string describing the error condition if there is--- one, or the matching result if successful.-matchAbbrev :: [(String, a)] -> String -> Maybe a-matchAbbrev ls s =-  let ls' = nubBy (\x y -> fst x == fst y) ls-  in case lookup s ls' of-    Just a -> return a-    Nothing ->-      let pdct (t, _) = s `isPrefixOf` t-      in case filter pdct ls of-        (_, a):[] -> return a-        _ -> Nothing---- | Formats error messages for nice display. Returns a multi-line--- string (there is no need to append a newline to the end of the--- string returned).-formatError-  :: String-  -- ^ Pass the name of your program here. Displayed at the beginning-  -- of the error message.--  -> Error-  -> String-formatError p (Error loc ls) =-  p ++ ": error: could not parse command line.\n"-  ++ "Error at: " ++ loc ++ "\n"-  ++ expError-  ++ genError-  ++ unk-  where-    toExp m = case m of { Expected s -> Just s; _ -> Nothing }-    expc = unlines . mapMaybe toExp $ ls-    expError = if null expc then "" else "Expecting:\n" ++ expc-    toGeneral m = case m of { General s -> Just s; _ -> Nothing }-    gen = unlines . mapMaybe toGeneral $ ls-    genError = if null gen-               then ""-               else let sep = if null expError-                              then "" else "\n"-                        in sep ++ gen-    unk = if any (== Unknown) ls then "Unknown error\n" else ""-
− lib/System/Console/MultiArg/CommandLine.hs 
@@ -1,536 +0,0 @@-{-# LANGUAGE ExistentialQuantification #-}--- | Some pre-built command line parsers. One is a simple command line--- parser that can parse options that take an optional argument, one--- or two arguments, or a variable number of arguments. For sample--- code that uses this parser, see--- "System.Console.MultiArg.SampleParser".------ Another parser is provided for multi-mode programs that are similar--- to @git@ or @darcs@.------ Previously there was a bug in System.Environment.getArgs that would--- not properly encode Unicode command line arguments.  multiarg used--- to provide its own GetArgs module to deal with this.  This bug was--- in base 4.3.1.0, which was bundled with ghc 7.0.4.  This bug was--- fixed in base 4.4.0.0, which came with ghc 7.2.  Since this bug has--- been fixed for awhile, multiarg no longer has its own GetArgs--- module.-module System.Console.MultiArg.CommandLine (-  -- * Interspersion control-  Intersperse (Intersperse, StopOptions)--  -- * Types-  , ProgName-  , Opts(..)-  , OptsWithPosArgs(..)-  , Mode(..)--  -- * Simple parsers-  , simplePure-  , simpleIO-  , simpleHelp-  , simpleHelpVersion--  -- * Mode parsers-  , modesPure-  , modesIO--  -- * Helpers to create various options and modes-  , optsHelp-  , optsHelpVersion-  , modeHelp--  ) where--import qualified System.Console.MultiArg.Combinator as C-import qualified System.Console.MultiArg.Prim as P-import System.Environment (getArgs, getProgName)-import System.Exit (exitFailure, exitSuccess)-import qualified System.IO as IO-import Control.Applicative ( many, (<|>), optional,-                             (<$), (<*>), (<*), (<$>))-import Data.Bifunctor-import Data.List (find)-import Data.Maybe (catMaybes, fromJust)-import qualified Data.Set as Set----- | What to do after encountering the first non-option,--- non-option-argument word on the command line? In either case, no--- more options are parsed after a stopper.-data Intersperse =-  Intersperse-  -- ^ Additional options are allowed on the command line after-  -- encountering the first positional argument. For example, if @a@-  -- and @b@ are options, in the command line @-a posarg -b@, @b@ will-  -- be parsed as an option. If @b@ is /not/ an option and the same-  -- command line is entered, then @-b@ will result in an error-  -- because @-b@ starts with a hyphen and therefore \"looks like\" an-  -- option.--  | StopOptions-    -- ^ No additional options will be parsed after encountering the-    -- first positional argument. For example, if @a@ and @b@ are-    -- options, in the command line @-a posarg -b@, @b@ will be parsed-    -- as a positional argument rather than as an option.----- | Specifies a set of options.-data Opts s a = Opts-  { oShortcuts :: [C.OptSpec s]-  -- ^ Shortcut options are commonly options such as @--help@ or-  -- @--version@. Such options must be specified alone on the command-  -- line.  The parser looks for one of these options first.  If it-  -- finds one and it is the only option on the command line, only-  -- this option is processed and returned.  If the option is not-  -- alone on the command line, an error occurs.  If no shortcut-  -- option is found, the parser processes non-shortcut options-  -- instead.--  , oOptions :: [C.OptSpec a]-  -- ^ If the user does not specify any shortcut options, she may-  -- specify any number of these options.--  }--instance Bifunctor Opts where-  bimap fa fc o = Opts-    { oShortcuts = map (fmap fa) . oShortcuts $ o-    , oOptions = map (fmap fc) . oOptions $ o-    }--instance Functor (Opts a) where-  fmap f o = o { oOptions = fmap (fmap f) . oOptions $ o }---- | Creates an Opts with a help shortcut option.-optsHelp-  :: h-  -- ^ Whatever type you wish to use for help-  -> [C.OptSpec a]-  -> Opts h a-optsHelp h = Opts [C.OptSpec ["help"] "h" (C.NoArg h)]---- | Creates an Opts with help and version shortcut options.-optsHelpVersion-  :: h-  -- ^ What you wish to use for help--  -> h-  -- ^ What you wish to use for version--  -> [C.OptSpec a]-  -> Opts h a-optsHelpVersion h v = Opts [ C.OptSpec ["help"] "h" (C.NoArg h)-                            , C.OptSpec ["version"] "v" (C.NoArg v) ]---- | Specification for both options and positional arguments.-data OptsWithPosArgs s a = OptsWithPosArgs-  { opOpts :: Opts s a-  , opIntersperse :: Intersperse-  , opPosArg :: String -> Either C.InputError a-  }--instance Bifunctor OptsWithPosArgs where-  bimap fa fc o = OptsWithPosArgs-    { opOpts = bimap fa fc . opOpts $ o-    , opIntersperse = opIntersperse o-    , opPosArg = fmap (fmap fc) . opPosArg $ o-    }--instance Functor (OptsWithPosArgs s) where-  fmap f o = o-    { opOpts = fmap f . opOpts $ o-    , opPosArg = fmap (fmap f) . opPosArg $ o-    }---- | Specifies a mode.-data Mode s r = forall a. Mode-  { mModeName :: String-  -- ^ How the user specifies the mode on the command line.  For @git@-  -- for example this might be @commit@ or @log@.--  , mGetResult :: [a] -> r-  -- ^ This function is applied to a list of the results of parsing the-  -- options that are specific to this mode.  The function returns a-  -- type of your choosing (though all modes in the same parser will-  -- have to return the same type.)--  , mOpts :: OptsWithPosArgs s a-  -- ^ Options and positional arguments that are specific to this-  -- mode.  For example, in the command line @git commit -a -m 'this-  -- is a log message'@, @commit@ is the mode name and everything-  -- after that is specified here as an option or positional argument-  -- that is specific to this mode.-  }--instance Bifunctor Mode where-  bimap fa fc (Mode n r o) = Mode-    { mModeName = n-    , mGetResult = fmap fc r-    , mOpts = first fa o-    }--instance Functor (Mode s) where-  fmap f (Mode n gr os) = Mode n (fmap f gr) os---- | Creates a Mode with a help option (help specific to the mode.)-modeHelp-  :: String-  -- ^ Mode name--  -> h-  -- ^ Whatever you want to use for the help (perhaps a string, or a-  -- function, or an IO action).  Its type will have to match up with-  -- the type of the global shortcut options and with the shortcut-  -- type of the other modes.--  -> ([a] -> r)-  -- ^ When applied to the the mode options, returns the result.--  -> [C.OptSpec a]-  -- ^ Options for this mode--  -> Intersperse-  -- ^ Allow interspersion of mode options and positional arguments?--  -> (String -> Either C.InputError a)-  -- ^ Parses positional arguments--  -> Mode h r--modeHelp n h getR os i p =-  Mode n getR (OptsWithPosArgs (Opts ss os) i p)-  where-    ss = [C.OptSpec ["help"] "h" (C.NoArg h)]--parseOpts :: Opts s a -> P.Parser (Either s [a])-parseOpts os = do-  let specials = oShortcuts os-  maySpecial <- optional (C.parseOption specials <* P.end)-  case maySpecial of-    Nothing -> fmap Right-      $ P.manyTill (C.parseOption (oOptions os)) endOrNonOpt-    Just spec -> return . Left $ spec--parseOptsWithPosArgs-  :: OptsWithPosArgs s a-  -> P.Parser (Either s [a])-parseOptsWithPosArgs os = do-  let specials = oShortcuts . opOpts $ os-  maySpecial <- optional (C.parseOption specials <* P.end)-  case maySpecial of-    Nothing ->-      let f = case opIntersperse os of-            Intersperse -> parseIntersperse-            StopOptions -> parseStopOpts-          parser = C.parseOption (oOptions . opOpts $ os)-      in fmap Right $ f parser (opPosArg os)-    Just spec -> return . Left $ spec--parseModes-  :: [Mode s r]-  -> P.Parser (Either s r)-parseModes ms = do-  let modeWords = Set.fromList . map mModeName $ ms-  (_, w) <- P.matchApproxWord modeWords-  processMode (fromJust . find (\c -> mModeName c == w) $ ms)-  where-    processMode (Mode _ gr os) = do-      eiOpts <- parseOptsWithPosArgs os-      return $ case eiOpts of-        Left x -> Left x-        Right opts -> Right (gr opts)----- | A pure (non-IO) parser for simple command lines--that is, command--- lines that do not have modes.-simplePure-  :: OptsWithPosArgs s a-  -- ^ Specifies allowed regular options, allowed shortcut options,-  -- and how to parse positional arguments.  Also specifies whether-  -- the user may intersperse options with positional arguments.--  -> [String]-  -- ^ The command line arguments to parse--  -> Either P.Error (Either s [a])-  -- ^ Returns an error if the command line arguments could not be-  -- parsed. If the parse was successful, returns an Either.  A Left-  -- indicates that the user selected a shortcut option.  A Right-  -- indicates that the user did not specify a shortcut option, and-  -- will contain a list of the options and positional arguments.-simplePure os ss = P.parse ss (parseOptsWithPosArgs os)---- | A pure (non-IO) parser for command lines that contain modes.-modesPure-  :: Opts s g-  -- ^ Global options.  These are specified before any mode.  For-  -- instance, in the command @git --no-pager commit -a@, the option-  -- @--no-pager@ is a global option.  Global options can contain-  -- shortcut options.  For instance, @git --help@ contains a single-  -- shortcut option.--  -> ([g] -> Either String (Either r [Mode s r]))-  -- ^ This function processes the global options.  If there are no-  -- shortcut options specified in the global options, it is applied-  -- to the result of processing the global options.  This function-  -- may return a Left if there is something wrong with the-  -- global options (a nonsensical combination, perhaps.)  Otherwise,-  -- it returns a @Right Either@.  Return a Left if there is no need to-  -- process any modes at all after seeing the global options.-  -- Otherwise, return a Right with a list of modes.--  -> [String]-  -- ^ Command line arguments to parse--  -> Either P.Error (Either s r)-  -- ^ If the command line arguments fail to parse, this will be a-  -- Left with the error.  If the parser is successful, this-  -- returns a @Right Either@. A Left indicates that the user entered a-  -- shortcut option, either in the global options or in one of the-  -- mode-specific options.  A Right indicates that the user selected-  -- a mode.-modesPure os process ss = P.parse ss p-  where-    p = do-      eiGs <- parseOpts os-      case eiGs of-        Left spec -> return . Left $ spec-        Right gs -> case process gs of-          Left s -> fail s-          Right eiModes -> case eiModes of-            Left r -> return (Right r)-            Right modes -> parseModes modes---- | A parser for simple command lines that do not contain modes.--- Runs in the IO monad.-simpleIO-  :: [C.OptSpec a]-  -- ^ Options to parse--  -> Intersperse-  -- ^ Allow interspersion of options and arguments?--  -> (String -> Either C.InputError a)-  -- ^ How to parse positional arguments--  -> IO [a]-  -- ^ If there is an error parsing the command line, the program will-  -- exit with an error message.  If successful the results are-  -- returned here.-simpleIO os i getArg = do-  let optsWithArgs = OptsWithPosArgs (Opts os []) i getArg-  ss <- getArgs-  case simplePure optsWithArgs ss of-    Left e -> errorAct e-    Right g -> case g of-      Left _ ->-        error "simpleIO: should never happen: no shortcut options"-      Right gs -> return gs--simpleIOCustomError-  :: (P.Error -> IO ())-  -> OptsWithPosArgs s a-  -> IO (Either s [a])-simpleIOCustomError showErr os = do-  ss <- getArgs-  case simplePure os ss of-    Left e -> showErr e >> exitFailure-    Right g -> return g-  ---- | A command line parser for multi-mode command lines.  Runs in the--- IO monad.-modesIO-  :: Opts s g-  -- ^ Specifies global options and global shortcut options--  -> ([g] -> Either String (Either r [Mode s r]))-  -- ^ This function processes the global options.  If there are no-  -- shortcut options specified in the global options, it is applied-  -- to the result of processing the global options.  This function-  -- may return a Left if there is something wrong with the-  -- global options (a nonsensical combination, perhaps.)  Otherwise,-  -- it returns a @Right Either@.  Return a Left if there is no need to-  -- process any modes at all after seeing the global options.-  -- Otherwise, return a Right with a list of modes.--  -> IO (Either s r)-  -- ^ If parsing fails, the program will exit with a failure. If-  -- successful, the result is returned here.  A Left indicates a-  -- shortcut option, either from the global options or from the-  -- mode-specific options; a Right indicates the mode a user-  -- selected.-modesIO os ms = do-  ss <- getArgs-  case modesPure os ms ss of-    Left e -> errorAct e-    Right g -> return g----- | The name of the program that was entered on the command line,--- obtained from System.Environment.getProgName.-type ProgName = String--displayAct :: (ProgName -> String) -> IO a-displayAct getHelp = do-  pn <- getProgName-  putStr $ getHelp pn-  exitSuccess--errorAct :: P.Error -> IO a-errorAct e = do-  pn <- getProgName-  IO.hPutStr IO.stderr $ C.formatError pn e-  exitFailure--errorActDisplayHelp :: P.Error -> IO a-errorActDisplayHelp e = do-  pn <- getProgName-  IO.hPutStr IO.stderr $ C.formatError pn e-  IO.hPutStrLn IO.stderr $ "enter \"" ++ pn ++ " -h\" for help."-  exitFailure---- | A parser for simple command lines. Adds a @--help@ option for--- you.-simpleHelp-  :: (ProgName -> String)-  -- ^ Indicate the help here. This function, when applied to the name-  -- of the program, returns help.  simpleHelp automatically adds-  -- options for @--help@ and @-h@ for you.--  -> [C.OptSpec a]-  -- ^ Options to parse--  -> Intersperse-  -- ^ Allow interspersion of options and positional arguments?--  -> (String -> Either C.InputError a)-  -- ^ How to parse positional arguments--  -> IO [a]-  -- ^ If the parser fails, the program will exit with an error.  If-  -- the user requested help, it will be displayed and the program-  -- exits successfully.  Otherwise, the options and positional-  -- arguments are returned here.-simpleHelp getHelp os ir getArg = do-  let shortcuts = [C.OptSpec ["help"] "h" (C.NoArg (displayAct getHelp))]-      opts = OptsWithPosArgs (Opts shortcuts os) ir getArg-  ei <- simpleIOCustomError errorActDisplayHelp opts-  case ei of-    Left act -> act-    Right as -> return as---- | A parser for simple command lines without modes.  Adds options--- for @--help@ and @--version@ for you.-simpleHelpVersion-  :: (ProgName -> String)-  -- ^ Indicate the help here. This function, when applied to the name-  -- of the program, returns help.  simpleHelpVersion automatically adds-  -- options for @--help@ and @-h@ for you.--  -> (ProgName -> String)-  -- ^ Indicate the version here. This function, when applied to the-  -- name of the program, returns a version string.  simpleHelpVersion-  -- automatically adds an option for @--version@ for you.--  -> [C.OptSpec a]-  -- ^ Options to parse--  -> Intersperse-  -- ^ Allow interspersion of options and positional arguments?--  -> (String -> Either C.InputError a)-  -- ^ How to parse positional arguments--  -> IO [a]-  -- ^ If the parser fails, the program will exit with an error.  If-  -- the user requested help or version information, it will be-  -- displayed and the program exits successfully.  Otherwise, the-  -- options and positional arguments are returned here.--simpleHelpVersion getHelp getVer os ir getArg = do-  let shortcuts = [ C.OptSpec ["help"] "h"-                      (C.NoArg (displayAct getHelp))-                  , C.OptSpec ["version"] ""-                      (C.NoArg (displayAct getVer)) ]-      opts = OptsWithPosArgs (Opts shortcuts os) ir getArg-  ei <- simpleIOCustomError errorActDisplayHelp opts-  case ei of-    Left act -> act-    Right as -> return as---- # Helpers---- | Handles positional arguments and errors with them.  The parser for--- the positional argument must be passed in (this way it can--- be parsed with nonOptionPosArg or nextWord, as appropriate; when--- parsing interpsersed command lines, you will want nonOptionPosArg;--- when parsing non-interspersed command lines, you will need--- nextWord.)-parsePosArg-  :: P.Parser String-  -- ^ Parser for Word for next positional argument-  -> (String -> Either C.InputError a)-  -- ^ Function to handle positional arguments-  -> P.Parser a-parsePosArg pa f = do-  a <- pa-  case f a of-    Left e ->-      let msg = "invalid positional argument: \"" ++ a ++ "\""-      in case e of-          C.NoMsg -> fail msg-          C.ErrorMsg s -> fail $ msg ++ ": " ++ s-    Right g -> return g---- | Parses options only, where they are not interspersed with--- positional arguments.  Stops parsing only where it encouters a word--- that does not begin with a dash.  This way if the user enters a bad--- option, it shows in the error message as a bad option rather than--- simply not getting parsed.-parseOptsNoIntersperse :: P.Parser a -> P.Parser [a]-parseOptsNoIntersperse p = P.manyTill p e where-  e = P.end <|> nonOpt-  nonOpt = P.lookAhead next-  next = (() <$ P.nonOptionPosArg) <|> P.stopper---- | Parses options and positional arguments where the two are not--- interspersed. Stops parsing options when a stopper is encountered--- or at the first word that does not look like an option.-parseStopOpts-  :: P.Parser a-  -> (String -> Either C.InputError a)-  -> P.Parser [a]-parseStopOpts optParser p =-  (++)-  <$> parseOptsNoIntersperse optParser-  <* optional P.stopper-  <*> many (parsePosArg P.nextWord p)----- | @parseIntersperse o p@ parses options and positional arguments,--- where o is a parser that parses options, and p is a function that,--- when applied to a string, returns the appropriate type.------ If a stopper has not yet been seen, any word that begins with a--- hyphen will not be parsed as a positional argument.  Therefore, if--- there is a word before a stopper and it begins with a hyphen, if it--- is not a valid option then the parse will fail with an error.-parseIntersperse-  :: P.Parser a-  -> (String -> Either C.InputError a)-  -> P.Parser [a]-parseIntersperse optParser p =-  let pa = Just <$> parsePosArg P.nonOptionPosArg p-      po = Just <$> optParser-      ps = Nothing <$ P.stopper-      parser = po <|> ps <|> pa-  in catMaybes <$> P.manyTill parser P.end---- | Looks at the next word. Succeeds if it is a non-option, or if we--- are at the end of input. Fails otherwise.-endOrNonOpt :: P.Parser ()-endOrNonOpt = (P.lookAhead P.nonOptionPosArg >> return ())-              <|> P.end-
− lib/System/Console/MultiArg/Option.hs 
@@ -1,45 +0,0 @@--- | These types represent options. Option names cannot have a dash as--- their first or second character, and long option names cannot have--- an equals sign anywhere in the name.-module System.Console.MultiArg.Option (-  ShortOpt,-  unShortOpt,-  makeShortOpt,-  LongOpt,-  unLongOpt,-  makeLongOpt )-  where---- | Short options. Options that are preceded with a single dash on--- the command line and consist of a single letter. That single letter--- cannot be a dash. Any other Unicode character is good (including--- pathological ones like newlines).-newtype ShortOpt = ShortOpt { unShortOpt :: Char } deriving (Show, Eq, Ord)---- | Creates a short option. Returns Nothing if the character is not--- valid for a short option.-makeShortOpt :: Char -> Maybe ShortOpt-makeShortOpt c = case c of-  '-' -> Nothing-  x -> Just $ ShortOpt x---- | Long options. Options that are preceded with two dashes on the--- command line and typically consist of an entire mnemonic word, such--- as @lines@. However, anything that is at least one letter long is--- fine for a long option name. The name must be at least one--- character long. It cannot have an equal sign anywhere in its--- name. Otherwise any Unicode character is good (including--- pathological ones like newlines).-data LongOpt = LongOpt { unLongOpt :: String } deriving (Show, Eq, Ord)---- | Makes a long option. Returns Nothing if the string is not a valid--- long option.-makeLongOpt :: String -> Maybe LongOpt-makeLongOpt t =-  if isValidLongOptText t then Just $ LongOpt t else Nothing---isValidLongOptText :: String -> Bool-isValidLongOptText s = case s of-  [] -> False-  xs -> not $ '=' `elem` xs
− lib/System/Console/MultiArg/Prim.hs 
@@ -1,681 +0,0 @@--- | Parser primitives. These are the only functions that have access--- to the internals of the parser. Use these functions if you want to--- build your own parser from scratch. If your needs are simpler, you--- will want to look at "System.Console.MultiArg.SimpleParser" or--- "System.Console.MultiArg.Combinator", which do a lot of grunt work--- for you.------ Internal design, especially the error handling, is based in large--- part on Parsec, as described in the paper at--- <http://legacy.cs.uu.nl/daan/pubs.html#parsec>.-module System.Console.MultiArg.Prim (-    -- * Parser types-  Parser,--  -- * Running a parser--  -- | Each parser runner is applied to a list of Strings, which are the-  -- command line arguments to parse.-  parse,--  -- * Higher-level parser combinators-  good,-  choice,-  bind,-  lookAhead,--  -- ** Running parsers multiple times-  several,-  several1,-  manyTill,--  -- ** Failure and errors-  failString,-  genericThrow,-  (<?>),-  try,--  -- * Parsers-  -- ** Short options and arguments-  pendingShortOpt,-  nonPendingShortOpt,-  pendingShortOptArg,--  -- ** Long options and arguments-  exactLongOpt,-  approxLongOpt,--  -- ** Stoppers-  stopper,-  resetStopper,--  -- ** Positional (non-option) arguments-  nextWord,-  nextWordIs,-  nonOptionPosArg,-  matchApproxWord,--  -- ** Miscellaneous-  end,--  -- * Errors-  Description(..),-  Error(Error),-  InputDesc--  ) where---import System.Console.MultiArg.Option-  (ShortOpt,-    unShortOpt,-    LongOpt,-    unLongOpt,-    makeLongOpt )-import Control.Applicative ( Applicative, Alternative, optional )-import qualified Control.Applicative as A-import qualified Data.Set as Set-import Data.Set ( Set )-import qualified Control.Monad-import Control.Monad ( when, MonadPlus(mzero, mplus), guard, liftM )-import Data.Maybe (mapMaybe)-import Data.Monoid ( Monoid ( mempty, mappend ) )-import qualified Data.List as L-import Data.List (isPrefixOf)---- | Parsers. Internally the parser tracks what input remains to be--- parsed, whether there are any pending short options, and whether a--- stopper has been seen. A parser can return a value of any type.------ The parser also includes the notion of failure. Any parser can--- fail; a failed parser affects the behavior of combinators such as--- choice.-newtype Parser a = Parser { runParser :: State -> Consumed a }--instance Monad Parser where-  (>>=) = bind-  return = good-  fail = failString--instance Functor Parser where-  fmap = liftM--instance Applicative Parser where-  (<*>) = Control.Monad.ap-  pure = return--instance Alternative Parser where-  empty = genericThrow-  (<|>) = choice-  some = several1-  many = several--instance Monoid (Parser a) where-  mempty = genericThrow-  mappend = choice--instance MonadPlus Parser where-  mzero = genericThrow-  mplus = choice--type PendingShort = String-type Remaining = [String]-type SawStopper = Bool-data State = State PendingShort Remaining SawStopper--type InputDesc = String-data Description = Unknown | General String | Expected String-  deriving (Eq, Show, Ord)---- | Error messages. To format error messages for nice display, see--- 'System.Console.MultiArg.Combinator.formatError'.-data Error = Error InputDesc [Description]-  deriving (Eq, Show, Ord)--data Reply a = Ok a State Error-             | Fail Error--data Consumed a = Consumed (Reply a)-                | Empty (Reply a)---- | @good a@ always succeeds without consuming any input and has--- result a. This provides the implementation for--- 'Control.Monad.Monad.return' and--- 'Control.Applicative.Applicative.pure'.-good :: a -> Parser a-good x = Parser $ \st -> Empty (Ok x st (Error (descLocation st) []))---- | Combines two parsers into a single parser. The second parser can--- optionally depend upon the result from the first parser.------ This applies the first parser. If the first parser succeeds,--- combine then takes the result from the first parser, applies the--- function given to the result from the first parser, and then--- applies the resulting parser.------ If the first parser fails, combine will not apply the second--- function but instead will bypass the second parser.------ This provides the implementation for '>>=' in--- 'Control.Monad.Monad'.-bind :: Parser a -> (a -> Parser b) -> Parser b-bind (Parser p) f = Parser $ \s ->-  case p s of-    Empty r1 -> case r1 of-      Ok x s' _ -> runParser (f x) s'-      Fail m -> Empty (Fail m)-    Consumed r1 -> Consumed $-      case r1 of-        Ok x s' _ -> case runParser (f x) s' of-          Consumed r -> r-          Empty r -> r-        Fail e -> Fail e--descLocation :: State -> InputDesc-descLocation (State ps rm st) = pending ++ next ++ stop-  where-    pending-      | null ps = ""-      | otherwise = "short option or short option argument: "-                  ++ ps ++ " "-    next = case rm of-      [] -> "no words remaining"-      x:_ -> "next word: " ++ x-    stop = if st then " (stopper already seen)" else ""----- | @failString s@ always fails without consuming any input. The--- failure contains a record of the string passed in by s. This--- provides the implementation for 'Control.Monad.Monad.fail'.-failString :: String -> Parser a-failString str = Parser $ \s ->-  Empty (Fail (Error (descLocation s) [General str]))----- | Fail with an unhelpful error message. Usually 'throwString' is--- more useful, but this is handy to implement some typeclass--- instances.-genericThrow :: Parser a-genericThrow = Parser $ \s ->-  Empty (Fail (Error (descLocation s) [Unknown]))---- | Runs the first parser. If it fails without consuming any input,--- then runs the second parser. If the first parser succeeds, then--- returns the result of the first parser. If the first parser fails--- and consumes input, then returns the result of the first--- parser. This provides the implementation for--- '<|>' in 'Control.Applicative.Alternative'.-choice :: Parser a -> Parser a -> Parser a-choice p q = Parser $ \s ->-  case runParser p s of-    Empty (Fail msg1) ->-      case runParser q s of-        Empty (Fail msg2) -> mergeError msg1 msg2-        Empty (Ok x s' msg2) -> mergeOk x s' msg1 msg2-        c -> c-    Empty (Ok x s' msg1) ->-      case runParser q s of-        Empty (Fail msg2) -> mergeOk x s' msg1 msg2-        Empty (Ok _ _ msg2) -> mergeOk x s' msg1 msg2-        c -> c-    c -> c-  where-    mergeOk x s msg1 msg2 = Empty (Ok x s (merge msg1 msg2))-    mergeError msg1 msg2 = Empty (Fail (merge msg1 msg2))-    merge (Error loc exp1) (Error _ exp2) =-      Error loc (exp1 ++ exp2)---- | Applies 'error' if a parser would succeed without consuming any--- input. Useful for preventing infinite loops on parsers like--- 'several1'.-crashOnEmptyOk-  :: String-  -- ^ Use this label when applying 'error'--  -> Parser a-  -> Parser a-crashOnEmptyOk str p = Parser $ \s ->-  case runParser p s of-    Empty r -> case r of-      Ok _ _ _ ->-         error $ "multiarg: error: " ++ str-               ++ " applied to parser that succeeds without "-               ++ "consuming any input. Aborted to prevent "-               ++ "an infinite loop."-      e -> Empty e-    o -> o-               ---- | Runs a parser one or more times. Runs the parser once and then--- applies 'several'.-several1 :: Parser a -> Parser [a]-several1 p = do-  r1 <- p-  rs <- several p-  return $ r1:rs----- | Runs a parser zero or more times. If the last run of the parser--- fails without consuming any input, this parser succeeds without--- consuming any input. If the last run of the parser fails while--- consuming input, this parser fails while consuming input. This--- provides the implementation for 'many' in Control.Applicative.-several :: Parser a -> Parser [a]-several unwrapped =-  let p = crashOnEmptyOk "several" unwrapped-  in do-    maybeA <- optional p-    case maybeA of-      Nothing -> return []-      Just a -> do-        rest <- several unwrapped-        return $ a:rest-  ---- | Runs the parser given. If it fails without consuming any input,--- replaces all Expected messages with the one given. Otherwise,--- returns the result of the parser unchanged.-(<?>) :: Parser a -> String -> Parser a-p <?> str = Parser $ \s ->-  case runParser p s of-    Empty (Fail m) -> Empty (Fail (expect m str))-    Empty (Ok x s' m) -> Empty (Ok x s' (expect m str))-    x -> x-  where-    expect (Error pos ls) s =-      let ls' = mapMaybe notExpected ls-          notExpected d = case d of-            Expected _ -> Nothing-            x -> Just x-      in Error pos ((Expected s) : ls')--infix 0 <?>---- | Runs a parser. This is the only way to change a value of type--- @Parser a@ into a value of type @a@ (that is, it is the only way to--- \"get out of the Parser monad\" or to \"escape the Parser monad\".)-parse-  :: [String]-  -- ^ Command line arguments to parse. Presumably you got these from-  -- 'getArgs'. If there is any chance that you will be parsing-  -- Unicode strings, see the documentation in-  -- "System.Console.MultiArg.GetArgs" before you use-  -- 'System.Environment.getArgs'.--  -> Parser a-  -- ^ Parser to run--  -> Either Error a-  -- ^ Success or failure. Any parser might fail; for example, the-  -- command line might not have any values left to parse. Use of the-  -- 'choice' combinator can lead to a list of failures.--parse ss p =-  let s = State "" ss False-      procReply r = case r of-        Ok x _ _ -> Right x-        Fail m -> Left m-  in case runParser p s of-      Consumed r -> procReply r-      Empty r -> procReply r---- | Parses only pending short options. Fails without consuming any--- input if there has already been a stopper or if there are no--- pending short options. Fails without consuming any input if there--- is a pending short option, but it does not match the short option--- given. Succeeds and consumes a pending short option if it matches--- the short option given.-pendingShortOpt :: ShortOpt -> Parser ()-pendingShortOpt so = Parser $ \s@(State pends rm stop) ->-  let msg = Error (descLocation s)-        [Expected ("pending short option: -" ++ [unShortOpt so])]-      gd s' = Consumed (Ok () s' msg)-      err = Empty (Fail msg)-  in maybe err gd $ do-    guard $ not stop-    (first, rest) <- case pends of-      [] -> mzero-      x:xs -> return (x, xs)-    when (unShortOpt so /= first) mzero-    return $ State rest rm stop---- | @lookAhead p@ runs parser p. If p succeeds, lookAhead p succeeds--- without consuming any input. If p fails without consuming any--- input, so does lookAhead. If p fails and consumes input, lookAhead--- also fails and consumes input. If this is undesirable, combine with--- "try".-lookAhead :: Parser a -> Parser a-lookAhead p = Parser $ \s ->-  case runParser p s of-    Consumed r -> case r of-      Ok x _ e -> Empty (Ok x s e)-      e -> Consumed e-    e -> e--nextW :: Remaining -> Maybe (String, Remaining)-nextW rm = case rm of-  [] -> Nothing-  x:xs -> Just (x, xs)---- | Parses only non-pending short options. Fails without consuming--- any input if:------ * there are pending short options------ * there has already been a stopper------ * there are no arguments left to parse------ * the next argument is an empty string------ * the next argument does not begin with a dash------ * the next argument is a single dash------ * the next argument is a short option but it does not match---   the one given------ * the next argument is a stopper------ Otherwise, consumes the next argument, puts any remaining letters--- from the argument into a pending short, and removes the first word--- from remaining arguments to be parsed.-nonPendingShortOpt :: ShortOpt -> Parser ()-nonPendingShortOpt so = Parser $ \s@(State ps rm stop) ->-  let dsc = [Expected-            $ "non pending short option: -" ++ [unShortOpt so]]-      err = Error (descLocation s) dsc-      errRet = Empty (Fail err)-      gd (ps'', rm'') = Consumed (Ok () (State ps'' rm'' stop) err)-  in maybe errRet gd $ do-    guard $ null ps-    guard $ not stop-    (a, rm') <- nextW rm-    (maybeDash, word) <- case a of-      [] -> mzero-      x:xs -> return (x, xs)-    guard (maybeDash == '-')-    (letter, arg) <- case word of-      [] -> mzero-      x:xs -> return (x, xs)-    guard (letter == unShortOpt so)-    return (arg, rm')----- | Parses an exact long option. That is, the text of the--- command-line option must exactly match the text of the--- option. Returns any argument that is attached to--- the same word of the option with an equal sign (for example,--- @--follow=\/dev\/random@ will return @Just \"\/dev\/random\"@ for the--- argument.) If there is no equal sign, returns Nothing for the--- argument. If there is an equal sign but there is nothing after it,--- returns @Just \"\"@ for the argument.------ If you do not want your long option to have equal signs and--- GNU-style option arguments, wrap this parser in something that will--- fail if there is an option argument.------ Fails without consuming any input if:------ * there are pending short options------ * a stopper has been parsed------ * there are no arguments left on the command line------ * the next argument on the command line does not begin with---   two dashes------ * the next argument on the command line is @--@ (a stopper)------ * the next argument on the command line does begin with two---   dashes but its text does not match the argument we're looking for--exactLongOpt :: LongOpt -> Parser (Maybe String)-exactLongOpt lo = Parser $ \s@(State ps rm sp) ->-  let msg = Error (descLocation s)-            [Expected ("long option: --" ++ unLongOpt lo)]-      gd (arg, newRm) = Consumed (Ok arg (State ps newRm sp) msg)-      err = Empty (Fail msg)-  in maybe err gd $ do-    guard $ null ps-    guard $ not sp-    (x, rm') <- nextW rm-    (word, afterEq) <- getLongOption x-    guard (word == unLongOpt lo)-    return (afterEq, rm')-    --getLongOption :: String -> Maybe (String, Maybe String)-getLongOption str = do-  guard (str /= "--")-  let (pre, word, afterEq) = splitLongWord str-  guard (pre == "--")-  return (word, afterEq)---- | Takes a single String and returns a tuple, where the first element--- is the first two letters, the second element is everything from the--- third letter to the equal sign, and the third element is Nothing if--- there is no equal sign, or Just String with everything after the--- equal sign if there is one.-splitLongWord :: String -> (String, String, Maybe String)-splitLongWord t = (f, s, r) where-  (f, rest) = L.splitAt 2 t-  (s, withEq) = L.break (== '=') rest-  r = case withEq of-    [] -> Nothing-    _:xs -> Just xs--approxLongOptError :: [LongOpt] -> [Description]-approxLongOptError =-  map (Expected . ("long option: --" ++) . unLongOpt)---assert :: e -> Bool -> Either e ()-assert e b = if b then Right () else Left e--fromMaybe :: e -> Maybe a -> Either e a-fromMaybe e = maybe (Left e) Right---- | Examines the next word. If it matches a LongOpt in the set--- unambiguously, returns a tuple of the word actually found and the--- matching word in the set and the accompanying text after the equal--- sign (if any). If the Set is empty, this parser will always fail.-approxLongOpt ::-  Set LongOpt-  -> Parser (String, LongOpt, Maybe String)-approxLongOpt ts = Parser $ \s@(State ps rm stop) ->-  let err ls = Error (descLocation s) (approxLongOptError ls)-      ert ls = Empty (Fail $ err ls)-      gd (found, opt, arg, rm'') =-        Consumed (Ok (found, opt, arg) (State ps rm'' stop)-                     (err allOpts))-      allOpts = Set.toList ts-  in either ert gd $ do-    assert allOpts $ null ps-    assert allOpts $ not stop-    (x, rm') <- fromMaybe allOpts $ nextW rm-    (word, afterEq) <- fromMaybe allOpts $ getLongOption x-    opt <- fromMaybe allOpts $ makeLongOpt word-    if Set.member opt ts-      then return (word, opt, afterEq, rm')-      else do-      let p t = word `isPrefixOf` unLongOpt t-          matches = Set.filter p ts-      case Set.toList matches of-        [] -> Left allOpts-        (m:[]) -> return (word, m, afterEq, rm')-        ls -> Left ls----- | Parses only pending short option arguments. For example, for the--- @tail@ command, if you enter the option @-c25@, then after parsing--- the @-c@ option the @25@ becomes a pending short option argument--- because it was in the same command line argument as the @-c@.------ Fails without consuming any input if:------ * a stopper has already been parsed------ * there are no pending short option arguments------ On success, returns the String of the pending short option argument--- (this String will never be empty).-pendingShortOptArg :: Parser String-pendingShortOptArg = Parser $ \st@(State ps rm sp) ->-  let msg = [Expected "pending short option argument"]-      err = Error (descLocation st) msg-      ert = Empty (Fail err)-      gd str = Consumed (Ok str (State "" rm sp) err)-  in maybe ert gd $ do-     guard $ not sp-     case ps of-      [] -> mzero-      xs -> return xs----- | Parses a \"stopper\" - that is, a double dash. Changes the internal--- state of the parser to reflect that a stopper has been seen.-stopper :: Parser ()-stopper = Parser $ \s@(State ps rm sp) ->-  let err = Error (descLocation s)-        [Expected "stopper, \"--\""]-      ert = Empty (Fail err)-      gd rm'' = Consumed (Ok () (State ps rm'' True) err)-  in maybe ert gd $ do-     guard $ not sp-     guard . null $ ps-     (x, rm') <- nextW rm-     guard $ x == "--"-     return rm'----- | If a stopper has already been seen, change the internal state--- back to indicating that no stopper has been seen.-resetStopper :: Parser ()-resetStopper = Parser $ \s@(State ps rm _) ->-  Empty (Ok () (State ps rm False) (Error (descLocation s) []))----- | try p behaves just like p, but if p fails, try p will not consume--- any input.-try :: Parser a -> Parser a-try a = Parser $ \s ->-  case runParser a s of-    Consumed r -> case r of-      Fail e -> Empty (Fail e)-      o -> Consumed o-    o -> o----- | Returns the next string on the command line as long as there are--- no pendings. Succeeds even if a stopper is present. Be careful ---- this will return the next string even if it looks like an option--- (that is, it starts with a dash.) Consider whether you should be--- using nonOptionPosArg instead. However this can be useful when--- parsing command line options after a stopper.-nextWord :: Parser String-nextWord = Parser $ \s@(State ps rm sp) ->-  let err = Error (descLocation s) [dsc]-      dsc = Expected "next word"-      ert = Empty (Fail err)-      gd (str, rm'') = Consumed $ Ok str (State ps rm'' sp) err-  in maybe ert gd $ do-      guard $ null ps-      nextW rm-      ---- | Parses the next word on the command line, but only if it exactly--- matches the word given. Otherwise, fails without consuming any--- input. Also fails without consuming any input if there are pending--- short options or if a stopper has already been parsed. Does not pay--- any attention to whether a stopper is present.-nextWordIs :: String -> Parser ()-nextWordIs str = Parser $ \s@(State ps rm sp) ->-  let err = Error (descLocation s) [dsc]-      dsc = Expected $ "next argument \"" ++ str ++ "\""-      ert = Empty $ Fail err-      gd rm'' = Consumed $ Ok () (State ps rm'' sp) err-  in maybe ert gd $ do-      guard $ null ps-      (a, rm') <- nextW rm-      guard (a == str)-      return rm'----- | If there are pending short options, fails without consuming any input.------ Otherwise, if a stopper has NOT already been parsed, then returns--- the next word if it is either a single dash or any other word that--- does not begin with a dash. If the next word does not meet these--- criteria, fails without consuming any input.------ Otherwise, if a stopper has already been parsed, then returns the--- next word, regardless of whether it begins with a dash or not.-nonOptionPosArg :: Parser String-nonOptionPosArg = Parser $ \s@(State ps rm sp) ->-  let err = Error (descLocation s) [dsc]-      dsc = Expected "non option positional argument"-      ert = Empty $ Fail err-      gd (str, rm'') = Consumed $ Ok str (State ps rm'' sp) err-  in maybe ert gd $ do-    guard $ null ps-    (x, rm') <- nextW rm-    result <- if sp-              then return x-              else case x of-                [] -> return x-                '-':[] -> return "-"-                f:_ -> if f == '-' then mzero else return x-    return (result, rm')----- | Succeeds if there is no more input left.-end :: Parser ()-end = Parser $ \s@(State ps rm _) ->-  let err = Error (descLocation s) [dsc]-      dsc = Expected "end of input"-      ert = Empty $ Fail err-      gd = Empty $ Ok () s err-  in if null ps && null rm then gd else ert----- | Examines the possible words in Set. If there are no pendings,--- then get the next word and see if it matches one of the words in--- Set. If so, returns the word actually parsed and the matching word--- from Set. If there is no match, fails without consuming any--- input. Pays no attention to whether a stopper has been seen.-matchApproxWord :: Set String -> Parser (String, String)-matchApproxWord set = Parser $ \s@(State ps rm sp) ->-  let err = Error (descLocation s) . lsDsc-      lsDsc = map (Expected . ("next word: " ++))-      ert = Empty . Fail . err-      gd (act, mtch, rm'') =-        Consumed $ Ok (act, mtch) (State ps rm'' sp) (err allWords)-      allWords = Set.toList set-  in either ert gd $ do-      assert allWords $ null ps-      (x, rm') <- fromMaybe allWords $ nextW rm-      let matches = Set.filter p set-          p t = x `isPrefixOf` t-      case Set.toList matches of-        [] -> Left allWords-        r:[] -> return (x, r, rm')-        xs -> Left xs-      --- | @manyTill p end@ runs parser p zero or more times until parser--- @end@ succeeds. If @end@ succeeds and consumes input, that input is--- also consumed. in the result of @manyTill@. If that is a problem,--- wrap it in @lookAhead@. Also, if @end@ fails and consumes input,--- @manyTill@ fails and consumes input. If that is a problem, wrap--- @end@ in @try@.-manyTill :: Parser a -> Parser end -> Parser [a]-manyTill p e = do-  maybeEnd <- optional e-  case maybeEnd of-    Just _ -> return []-    Nothing -> do-      a <- crashOnEmptyOk "manyTill" p-      rs <- manyTill p e-      return $ a:rs-
− lib/System/Console/MultiArg/SampleParser.hs 
@@ -1,70 +0,0 @@--- | This is sample code using "System.Console.MultiArg". This could--- be a command-line parser for the version of the Unix command @tail@--- that is included with GNU coreutils version 8.5. "main" simply gets--- the command line arguments, parses them, and prints out what was--- parsed. To test it out, simply compile an executable that looks--- like this and then feed it different options:------ > import System.Console.MultiArg.SampleParser--- > main = sampleMain Intersperse------ or:------ > import System.Console.MultiArg.SampleParser--- > main = sampleMain StopOptions------ The code in the module is the sample code; the sample code is not--- in the Haddock documentation! If you're reading this in Haddock,--- you will want to also take a look at the actual source code.-module System.Console.MultiArg.SampleParser where--import qualified System.Console.MultiArg.Combinator as C-import qualified System.Console.MultiArg.CommandLine as P--data Flag =-  Bytes String-  | Follow (Maybe String)-  | Retry-  | Lines String-  | Stats String-  | Pid String-  | Quiet-  | Sleep String-  | Verbose-  | Help-  | Version-  | Filename String-  deriving Show--specs :: [C.OptSpec Flag]--specs =-  [ C.OptSpec ["bytes"]                     ['c']-              (C.OneArg (return . Bytes))--  , C.OptSpec ["follow"]                    ['f']-              (C.OptionalArg (return . Follow))--  , C.OptSpec ["follow-retry"]              ['F']     (C.NoArg Retry)--  , C.OptSpec ["lines"]                     ['n']-              (C.OneArg (return . Lines))--  , C.OptSpec ["max-unchanged-stats"]       []-              (C.OneArg (return . Stats))--  , C.OptSpec ["pid"]                       []-              (C.OneArg (return . Pid))-  , C.OptSpec ["quiet"]                     ['q']     (C.NoArg Quiet)--  , C.OptSpec ["sleep-interval"]            ['s']-              (C.OneArg (return . Sleep))-  , C.OptSpec ["verbose"]                   ['v']     (C.NoArg Verbose)-  , C.OptSpec ["help"]                      []        (C.NoArg Help)-  , C.OptSpec ["version"]                   []        (C.NoArg Version)-  ]--sampleMain :: P.Intersperse -> IO ()-sampleMain i = do-  r <- P.simpleIO specs i (return . Filename)-  print r
multiarg.cabal view
@@ -1,5 +1,5 @@ Name: multiarg-Version: 0.26.0.0+Version: 0.28.0.0 Cabal-version: >=1.8 Build-Type: Simple License: BSD3@@ -16,8 +16,6 @@   minimum-versions.txt, current-versions.txt,   sunlight-test.hs -tested-with: GHC==7.4.1, GHC==7.6.3- description: multiarg is a parser combinator library to build command  line parsers. With it you can easily create parsers with options  that take more than one option argument--for example, I created@@ -30,7 +28,7 @@  for many situtations and shields you from the underlying complexity  if you don't need it.  .- See the documentation in the System.Console.MultiArg module for+ See the documentation in the Multiarg module for  details.  source-repository head@@ -46,12 +44,12 @@   hs-source-dirs: lib    Exposed-modules:-      System.Console.MultiArg-    , System.Console.MultiArg.Combinator-    , System.Console.MultiArg.CommandLine-    , System.Console.MultiArg.Option-    , System.Console.MultiArg.Prim-    , System.Console.MultiArg.SampleParser+      Multiarg+    , Multiarg.Combinator+    , Multiarg.CommandLine+    , Multiarg.Option+    , Multiarg.Prim+    , Multiarg.SampleParser    ghc-options: -Wall