multiarg 0.16.0.0 → 0.18.0.0

raw patch · 15 files changed

+2040/−2006 lines, 15 filesdep −utf8-stringdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies removed: utf8-string

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• NEWS +12/−0
• System/Console/MultiArg.hs +0/−169
• System/Console/MultiArg/Combinator.hs +0/−551
• System/Console/MultiArg/GetArgs.hs +0/−68
• System/Console/MultiArg/Option.hs +0/−45
• System/Console/MultiArg/Prim.hs +0/−676
• System/Console/MultiArg/SampleParser.hs +0/−60
• System/Console/MultiArg/SimpleParser.hs +0/−413
• lib/System/Console/MultiArg.hs +169/−0
• lib/System/Console/MultiArg/Combinator.hs +551/−0
• lib/System/Console/MultiArg/CommandLine.hs +515/−0
• lib/System/Console/MultiArg/Option.hs +45/−0
• lib/System/Console/MultiArg/Prim.hs +676/−0
• lib/System/Console/MultiArg/SampleParser.hs +58/−0
• multiarg.cabal +14/−24

@@ -1,3 +1,15 @@+Release 0.18.0.0, August 14, 2013+Changes since release 0.16.0.0:++* Rename SimpleParser module to CommandLine++* Made a number of changes to CommandLine to reorganize the data types+  and functions responsible for parsing simple and multi-mode command+  lines++* Remove GetArgs, as this was for an old library bug which has been+  fixed for some time now+ Release 0.16.0.0, May 21, 2013 Changes since release 0.14.0.0: 

@@ -1,169 +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.SimpleParser" 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.SimpleParser" 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.SimpleParser" 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.GetArgs-  , module System.Console.MultiArg.Option-  , module System.Console.MultiArg.Prim-  , module System.Console.MultiArg.SimpleParser-  , module Control.Monad.Exception.Synchronous-  ) where--import System.Console.MultiArg.Combinator-import System.Console.MultiArg.GetArgs-import System.Console.MultiArg.Option-import System.Console.MultiArg.Prim-import System.Console.MultiArg.SimpleParser-import Control.Monad.Exception.Synchronous

@@ -1,551 +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 qualified Control.Monad.Exception.Synchronous as Ex-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 -> Ex.Exceptional InputError a-reader s = case reads s of-  (a, ""):[] -> return a-  _ -> Ex.throw . 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-  -> Ex.Exceptional InputError (Maybe a)-optReader ms = case ms of-  Nothing -> return Nothing-  Just s -> case reads s of-    (a, ""):[] -> return (Just a)-    _ -> Ex.throw . 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".------ Some of these value constructors have names ending in @E@. Use--- these constructors when you want to parse option arguments that may--- fail to parse--for example, you want to parse an Int. The function--- passed as an argument to the value constructor indicates failure by--- returing an 'Exception'.-data ArgSpec a =-  NoArg a-  -- ^ This option takes no arguments--  | OptionalArg (Maybe String -> 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 -> 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 -> a)-    -- ^ This option takes two arguments. Parsed similarly to-    -- 'OneArg'.--  | ThreeArg (String -> String -> String -> a)-    -- ^ This option takes three arguments. Parsed similarly to-    -- 'OneArg'.--  | VariableArg ([String] -> 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@.--  | OptionalArgE (Maybe String -> Ex.Exceptional InputError a)-    -- ^ This option takes an optional argument, like-    -- 'OptionalArg'. Parsing of the optional argument might fail.--  | OneArgE (String -> Ex.Exceptional InputError a)-    -- ^ This option takes a single argument, like 'OneArg'. Parsing-    -- of the argument might fail.--  | TwoArgE (String -> String -> Ex.Exceptional InputError a)-    -- ^ This option takes two arguments, like 'TwoArg'. Parsing of-    -- the arguments might fail.--  | ThreeArgE (String -> String -> String -> Ex.Exceptional InputError a)-    -- ^ This option takes three arguments, like 'ThreeArg'. Parsing-    -- of the arguments might fail.--  | VariableArgE ([String] -> Ex.Exceptional InputError a)-    -- ^ This option takes a variable number of arguments, like-    -- 'VariableArg'. Parsing of the arguments might fail.---instance Functor ArgSpec where-  fmap f a = case a of-    NoArg i -> NoArg $ f i-    OptionalArg g ->-      OptionalArg $ \ms -> f (g ms)-    OneArg g ->-      OneArg $ \s1 -> f (g s1)-    TwoArg g ->-      TwoArg $ \s1 s2 -> f (g s1 s2)-    ThreeArg g ->-      ThreeArg $ \s1 s2 s3 -> f (g s1 s2 s3)-    VariableArg g ->-      VariableArg $ \ls -> f (g ls)-    ChoiceArg gs ->-      ChoiceArg . map (\(s, r) -> (s, f r)) $ gs--    OptionalArgE g -> OptionalArgE $ \ms -> fmap f (g ms)--    OneArgE g ->-      OneArgE $ \s1 -> fmap f (g s1)--    TwoArgE g ->-      TwoArgE $ \s1 s2 -> fmap f (g s1 s2)--    ThreeArgE g ->-      ThreeArgE $ \s1 s2 s3 -> fmap f (g s1 s2 s3)--    VariableArgE g ->-      VariableArgE $ \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"-    OptionalArg f -> return (f maybeArg)-    OneArg f -> f <$> maybeNextArg-    TwoArg f -> f <$> maybeNextArg <*> nextWord-    ThreeArg f -> f <$> maybeNextArg <*> nextWord <*> nextWord-    VariableArg f -> do-      as <- many nonOptionPosArg-      return . f $ case maybeArg of-        Nothing -> as-        Just a1 -> a1 : as-    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--    OptionalArgE f -> case maybeArg of-      Nothing -> Ex.switch (fail . errorMsg (Left lo) []) return-                 $ f Nothing-      Just s -> Ex.switch (fail . errorMsg (Left lo) [s]) return-                $ f (Just s)---    OneArgE f -> maybeNextArg >>= g-      where-        g a = Ex.switch (fail . errorMsg (Left lo) [a]) return-              $ f a--    TwoArgE f -> do-      a1 <- maybeNextArg-      a2 <- nextWord-      Ex.switch (fail . errorMsg (Left lo) [a1, a2]) return-        $ f a1 a2--    ThreeArgE f -> do-      a1 <- maybeNextArg-      a2 <- nextWord-      a3 <- nextWord-      Ex.switch (fail . errorMsg (Left lo) [a1, a2, a3]) return-        $ f a1 a2 a3--    VariableArgE f -> do-      as <- many nonOptionPosArg-      let args = case maybeArg of-            Nothing -> as-            Just a -> a:as-      Ex.switch (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-      OptionalArg f -> shortOptionalArg f-      OneArg f -> shortOneArg f-      TwoArg f -> shortTwoArg f-      ThreeArg f -> shortThreeArg f-      VariableArg f -> shortVariableArg f-      ChoiceArg ls -> shortChoiceArg opt ls-      OptionalArgE f -> shortOptionalArgE opt f-      OneArgE f -> shortOneArgE opt f-      TwoArgE f -> shortTwoArgE opt f-      ThreeArgE f -> shortThreeArgE opt f-      VariableArgE f -> shortVariableArgE 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 :: ([String] -> a) -> Parser a-shortVariableArg f = do-  maybeSameWordArg <- optional pendingShortOptArg-  args <- many nonOptionPosArg-  case maybeSameWordArg of-    Nothing -> return (f args)-    Just arg1 -> return (f (arg1:args))---shortVariableArgE-  :: ShortOpt-  -> ([String] -> Ex.Exceptional InputError a)-  -> Parser a-shortVariableArgE so f = do-  maybeSameWordArg <- optional pendingShortOptArg-  args <- many nonOptionPosArg-  let as = case maybeSameWordArg of-        Nothing -> args-        Just a -> a:args-  Ex.switch (fail . errorMsg (Right so) as) return $ f as---shortOneArg :: (String -> a) -> Parser a-shortOneArg f = f <$> firstShortArg--shortOneArgE-  :: ShortOpt-  -> (String -> Ex.Exceptional InputError a)-  -> Parser a-shortOneArgE so f = do-  a <- firstShortArg-  Ex.switch (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 :: (String -> String -> a) -> Parser a-shortTwoArg f = f <$> firstShortArg <*> nextWord--shortTwoArgE-  :: ShortOpt-  -> (String -> String -> Ex.Exceptional InputError a)-  -> Parser a-shortTwoArgE so f = do-  a1 <- firstShortArg-  a2 <- nextWord-  Ex.switch (fail . errorMsg (Right so) [a1, a2]) return-    $ f a1 a2--shortThreeArg :: (String -> String -> String -> a) -> Parser a-shortThreeArg f = f <$> firstShortArg <*> nextWord <*> nextWord--shortThreeArgE-  :: ShortOpt-  -> (String -> String -> String -> Ex.Exceptional InputError a)-  -> Parser a-shortThreeArgE so f = do-  a1 <- firstShortArg-  a2 <- nextWord-  a3 <- nextWord-  Ex.switch (fail . errorMsg (Right so) [a1, a2, a3]) return-    $ f a1 a2 a3--shortOptionalArg :: (Maybe String -> a) -> Parser a-shortOptionalArg f = do-  maybeSameWordArg <- optional pendingShortOptArg-  case maybeSameWordArg of-    Nothing -> do-      maybeArg <- optional nonOptionPosArg-      case maybeArg of-        Nothing -> return (f Nothing)-        Just a -> return (f (Just a))-    Just a -> return (f (Just a))--shortOptionalArgE-  :: ShortOpt-  -> (Maybe String -> Ex.Exceptional InputError a)-  -> Parser a-shortOptionalArgE so f = do-  maybeSameWordArg <- optional pendingShortOptArg-  case maybeSameWordArg of-    Nothing -> do-      maybeArg <- optional nonOptionPosArg-      case maybeArg of-        Nothing -> Ex.switch (fail . errorMsg (Right so) []) return-                   $ f Nothing-        Just a -> Ex.switch (fail . errorMsg (Right so) [a]) return-                  $ f (Just a)-    Just a -> Ex.switch (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 ""-    

@@ -1,68 +0,0 @@-{-# LANGUAGE CPP #-}---- | Get the arguments from the command line, ensuring they are--- properly encoded into Unicode.------ base 4.3.1.0 has a System.Environment.getArgs that does not return--- a Unicode string. Instead, it simply puts each octet into a--- different Char. Thus its getArgs is broken on UTF-8 and nearly any--- non-ASCII encoding. As a workaround I use--- System.Environment.UTF8. The downside of this is that it requires--- that the command line be encoded in UTF8, regardless of what the--- default system encoding is.------ Unlike base 4.3.1.0, base 4.4.0.0 actually returns a proper Unicode--- string when you call System.Environment.getArgs. (base 4.3.1.0--- comes with ghc 7.0.4; base 4.4.0.0 comes with ghc 7.2.) The string--- is encoded depending on the default system locale. The only problem--- is that System.Environment.UTF8 apparently simply uses--- System.Environment.getArgs and then assumes that the string it--- returns has not been decoded. In other words,--- System.Environment.UTF8 assumes that System.Environment.getArgs is--- broken, and when System.Environment.getArgs was fixed in base--- 4.4.0.0, it likely will break System.Environment.UTF8.------ One obvious solution to this problem is to find some other way to--- get the command line that will not break when base is updated. But--- it was not easy to find such a thing. The other libraries I saw on--- hackage (as of January 6, 2012) had problems, such as breakage on--- ghc 7.2. There is a package that has a simple interface to the UNIX--- setlocale(3) function, but I'm not sure that what it returns easily--- and reliably maps to character encodings that you can use with,--- say, iconv.------ So by use of Cabal and preprocessor macors, the code uses--- utf8-string if base is less than 4.4, and uses--- System.Environment.getArgs if base is at least 4.4.------ The GHC bug is here:------ <http://hackage.haskell.org/trac/ghc/ticket/3309>--module System.Console.MultiArg.GetArgs ( getArgs, getProgName ) where--#if MIN_VERSION_base(4,4,0)-import qualified System.Environment as E ( getArgs, getProgName )-#else-import qualified System.Environment.UTF8 as E ( getArgs, getProgName )-#endif---- | Gets the command-line arguments supplied by the program's--- user. If the @base@ package is older than version 4.4, then this--- function assumes the command line is encoded in UTF-8, which is--- true for many newer Unix systems; however, many older systems may--- use single-byte encodings like ISO-8859. In such cases, this--- function will give erroneous results.------ If the @base@ package is version 4.4.0 or newer, this function--- simply uses the getArgs that comes with @base@. That getArgs--- detects the system's default encoding and uses that, so it should--- give accurate results on most systems.-getArgs :: IO [String]-getArgs = E.getArgs---- | Gets the name of the program that the user invoked. See--- documentation for 'getArgs' for important caveats that also apply--- to this function.-getProgName :: IO String-getProgName = E.getProgName

@@ -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

@@ -1,676 +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 Control.Monad.Exception.Synchronous as Ex-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--  -> Ex.Exceptional 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 _ _ -> Ex.Success x-        Fail m -> Ex.Exception 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)----- | 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 Ex.switch ert gd $ do-    Ex.assert allOpts $ null ps-    Ex.assert allOpts $ not stop-    (x, rm') <- Ex.fromMaybe allOpts $ nextW rm-    (word, afterEq) <- Ex.fromMaybe allOpts $ getLongOption x-    opt <- Ex.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-        [] -> Ex.throw allOpts-        (m:[]) -> return (word, m, afterEq, rm')-        ls -> Ex.throw 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 Ex.switch ert gd $ do-      Ex.assert allWords $ null ps-      (x, rm') <- Ex.fromMaybe allWords $ nextW rm-      let matches = Set.filter p set-          p t = x `isPrefixOf` t-      case Set.toList matches of-        [] -> Ex.throw allWords-        r:[] -> return (x, r, rm')-        xs -> Ex.throw 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-

@@ -1,60 +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 System.Console.MultiArg.GetArgs (getArgs)-import qualified System.Console.MultiArg.SimpleParser 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 Bytes)-  , C.OptSpec ["follow"]                    ['f']     (C.OptionalArg Follow)-  , C.OptSpec ["follow-retry"]              ['F']     (C.NoArg Retry)-  , C.OptSpec ["lines"]                     ['n']     (C.OneArg Lines)-  , C.OptSpec ["max-unchanged-stats"]       []        (C.OneArg Stats)-  , C.OptSpec ["pid"]                       []        (C.OneArg Pid)-  , C.OptSpec ["quiet"]                     ['q']     (C.NoArg Quiet)-  , C.OptSpec ["sleep-interval"]            ['s']     (C.OneArg 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-  as <- getArgs-  let r = P.simple i specs (return . Filename) as-  print r

@@ -1,413 +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@.-module System.Console.MultiArg.SimpleParser (-  -- * Interspersion control-  Intersperse (Intersperse, StopOptions)--    -- * The parser-  , simple-  , simpleWithHelp--    -- * Parsing multi-mode command lines-  , Mode(..)-  , modes-  , modesWithHelp-  ) where--import Data.Either (partitionEithers)-import qualified System.Console.MultiArg.Combinator as C-import qualified System.Console.MultiArg.GetArgs as GetArgs-import qualified System.Console.MultiArg.Prim as P-import qualified Control.Monad.Exception.Synchronous as Ex-import System.Exit (exitFailure, exitSuccess)-import qualified System.IO as IO-import Control.Applicative ( many, (<|>), optional,-                             (<$), (<*>), (<*), (<$>))-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.---- | Parse a command line.-simple ::-  Intersperse-  -- ^ What to do after encountering the first positional argument--  -> [C.OptSpec a]-  -- ^ All possible options--  -> (String -> Ex.Exceptional C.InputError a)-  -- ^ How to handle positional arguments. This function is applied to-  -- the appropriate string every time the parser encounters a-  -- positional argument. This function shall return an Exception if-  -- something was wrong with the argument, or a Success if it is-  -- okay.--  -> [String]-  -- ^ The command line to parse. This function correctly handles-  -- Unicode strings; however, because 'System.Environment.getArgs'-  -- does not always correctly handle Unicode strings, consult the-  -- documentation in 'System.Console.MultiArg.GetArgs' and consider-  -- using the functions in there if there is any chance that you will-  -- be parsing command lines that have non-ASCII strings.--  -> Ex.Exceptional P.Error [a]-simple i os p as =-  let optParser = C.parseOption os-      parser = case i of-        Intersperse -> parseIntersperse optParser p-        StopOptions -> parseStopOpts optParser p-  in P.parse as parser--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---parsePosArg-  :: (String -> Ex.Exceptional C.InputError a)-  -> P.Parser a-parsePosArg p = do-  a <- P.nextWord-  case p a of-    Ex.Exception e ->-      let msg = "invalid positional argument: \"" ++ a ++ "\""-      in case e of-          C.NoMsg -> fail msg-          C.ErrorMsg s -> fail $ msg ++ ": " ++ s-    Ex.Success g -> return g--parseStopOpts-  :: P.Parser a-  -> (String -> Ex.Exceptional C.InputError a)-  -> P.Parser [a]-parseStopOpts optParser p =-  (++)-  <$> parseOptsNoIntersperse optParser-  <* optional P.stopper-  <*> many (parsePosArg 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.-parseIntersperse-  :: P.Parser a-  -> (String -> Ex.Exceptional C.InputError a)-  -> P.Parser [a]-parseIntersperse optParser p =-  let pa = Just <$> parsePosArg p-      po = Just <$> optParser-      ps = Nothing <$ P.stopper-      parser = po <|> ps <|> pa-  in catMaybes <$> P.manyTill parser P.end------- simpleWithHelp------- | Wraps the OptSpec passed into to simpleWithHelp. -data ArgWrap a-  = HelpArg-  | OtherArg a--data ArgWrapResult a-  = NeedsHelp String-  | NoHelp a--instance Functor ArgWrap where-  fmap _ HelpArg = HelpArg-  fmap f (OtherArg a) = OtherArg $ f a--partitionHelp :: [ArgWrap a] -> (DoHelp, [a])-partitionHelp xs = (not . null . fst $ r, snd r)-  where-    toEither h = case h of-      HelpArg -> Left ()-      OtherArg a -> Right a-    r = partitionEithers . map toEither $ xs---- | Shows help and exits successfully if that was requested;--- otherwise, returns the parsed command line options.-extractOpts :: String -> (String -> String) -> [ArgWrap a] -> IO [a]-extractOpts pn hlp opts =-  let (doHelp, os) = partitionHelp opts-  in if doHelp-      then putStr (hlp pn) >> exitSuccess-      else return os----- | Parses a simple command line (that is, one without modes) in the--- IO monad. Gets the arguments for you using 'getArgs'.  In addition--- to the arguments you provide for 'simple', you also provide online--- help. This function adds @-h@ and @--help@ options and shows help--- if the user entered one of these options anywhere on the command--- line. If help is shown, the program exits successfully. In--- addition, it will print a message to standard error if parsing the--- command line fails and then exit unsuccessfully.-simpleWithHelp-  :: (String -> String)-  -- ^ Help message. Printed as is, so it can be one line or have many-  -- lines. It should however have a final end-of-line character. The-  -- function is applied to the name of the program (which is-  -- retrieved at runtime.)--  -> Intersperse-  -- ^ What to do after encountering the first positional argument--  -> [C.OptSpec a]-  -- ^ All possible options. Do not add a @-h@ or @--help@ option;-  -- these are added for you.--  -> (String -> Ex.Exceptional C.InputError a)-  -- ^ How to handle positional arguments. This function is applied to-  -- the appropriate string every time the parser encounters a-  -- positional argument. This function shall return an Exception if-  -- something was wrong with the argument, or a Success if it is-  -- okay.--  -> IO [a]-  -- ^ If help is requested, the program will print it and exit-  -- successfully. If there was an error parsing the command line, the-  -- program will print an error message and exit-  -- unsuccessfully. Otherwise, the parsed arguments are returned.-simpleWithHelp h i os p = do-  let os' = addHelpOpt os-  as <- GetArgs.getArgs-  pn <- GetArgs.getProgName-  let exResult = simple i os' (fmap (fmap OtherArg) p) as-  rs <- case exResult of-    Ex.Exception e -> do-      IO.hPutStr IO.stderr (C.formatError pn e)-      enterForHelp pn-      exitFailure-    Ex.Success g -> return g-  extractOpts pn h rs---- | Display a simple enter-h-for-help message.-enterForHelp-  :: String-  -- ^ Program name-  -> IO ()-enterForHelp pn =-  let s = "\nEnter \"" ++ pn ++ " -h\" for help.\n"-  in IO.hPutStr IO.stderr s------- Mode parsing------- | Provides information on each mode that you wish to parse.-data Mode result = forall b. Mode-  { mName :: String-    -- ^ How the user identifies the mode on the command line. For-    -- example, with @git@ this would be @commit@, @pull@, etc.--  , mIntersperse :: Intersperse-    -- ^ Each mode may have options and positional arguments; may-    -- these be interspersed?--  , mOpts :: [C.OptSpec b]-    -- ^ Options for this mode--  , mPosArgs :: String -> Ex.Exceptional C.InputError b-    -- ^ How to parse positional arguments for this mode. This-    -- function shall return an Exception if something was wrong with-    -- the argument, or a Success if it is okay.--  , mProcess :: [b] -> result-    -- ^ Processes the options after they have been parsed.--  , mHelp :: String -> String-    -- ^ Help string for this mode. This is used only in-    -- 'modesWithHelp'; 'modes' ignores this. This is displayed on-    -- screen exactly as is, so be sure to include the necessary-    -- trailing newline. The function is applied to the name of the-    -- program (which is retrieved at runtime.)-  -  }--instance Functor Mode where-  fmap f (Mode nm i os pa p h) =-    Mode nm i os pa (f . p) h--type DoHelp = Bool--modesWithHelpPure-  :: String-  -- ^ Program name-  -> (String -> String)-  -- ^ Global help-  -> [C.OptSpec a]-  -> ([a] -> Either ([String] -> result) [Mode result])-  -> [String]-  -> Ex.Exceptional P.Error (ArgWrapResult (ArgWrapResult result))-modesWithHelpPure pn getHlp globals lsToEi ss = P.parse ss $ do-  let globals' = addHelpOpt globals-  gs <- P.manyTill (C.parseOption globals') endOrNonOpt-  let (needsHelp, gblOs) = partitionHelp gs-  if needsHelp then return (NeedsHelp (getHlp pn)) else NoHelp <$>-    case lsToEi gblOs of-      Left parsePosArgs ->-            (NoHelp . parsePosArgs) <$> many P.nextWord <* P.end-      Right mds -> do-        let modeWords = Set.fromList . map mName $ mds-        (_, w) <- P.matchApproxWord modeWords-        let cmd = fromJust . find (\c -> mName c == w) $ mds-        processModeWithHelp pn cmd--modesNoHelp-  :: [C.OptSpec a]-  -> ([a] -> Either ([String] -> result) [Mode result])-  -> [String]-  -> Ex.Exceptional P.Error result-modesNoHelp globals lsToEi ss = P.parse ss $ do-  gs <- P.manyTill (C.parseOption globals) endOrNonOpt-  case lsToEi gs of-    Left parsePosArgs ->-          parsePosArgs <$> many P.nextWord <* P.end-    Right mds -> do-      let modeWords = Set.fromList . map mName $ mds-      (_, w) <- P.matchApproxWord modeWords-      let cmd = fromJust . find (\c -> mName c == w) $ mds-      processModeNoHelp cmd--processModeWithHelp-  :: String-  -- ^ Program name-   -> Mode result-   -> P.Parser (ArgWrapResult result)-processModeWithHelp pn (Mode _ i os pa p h) = do-  let prsr = case i of-        Intersperse -> parseIntersperse-        StopOptions -> parseStopOpts-      os' = addHelpOpt os-  rs <- prsr (C.parseOption os') (fmap (fmap OtherArg) pa) <* P.end-  let (needsHelp, parsedOpts) = partitionHelp rs-  return $ if needsHelp then NeedsHelp (h pn) else NoHelp $ p parsedOpts---processModeNoHelp-   :: Mode result-   -> P.Parser result-processModeNoHelp (Mode _ i os pa p _) = do-  let prsr = case i of-        Intersperse -> parseIntersperse-        StopOptions -> parseStopOpts-  rs <- prsr (C.parseOption os) pa <* P.end-  return $ p rs---addHelpOpt :: [C.OptSpec a] -> [C.OptSpec (ArgWrap a)]-addHelpOpt os =-  let helpOpt = C.OptSpec ["help"] "h" (C.NoArg HelpArg)-      origOpts = fmap (fmap OtherArg) os-  in helpOpt : origOpts---- | Parses a command line that may feature options followed by a--- mode followed by more options and then followed by positional--- arguments.-modes-  :: [C.OptSpec a]-  -- ^ Global options. These come after the program name but before-  -- the mode name.--  -> ([a] -> Either ([String] -> result) [Mode result])-  -- ^ This function will be applied to the result of parsing the-  -- global options. The function must return a @Left@ if you do not-  -- want to parse any modes at all. This can be useful if one of the-  -- global options was something like @--help@ or @--version@ and so-  -- you do not need to see any mode. The function returned in the-  -- @Left@ will be applied to a list of all remaining command-line-  -- arguments after the global options.--  -> [String]-  -- ^ The command line to parse (presumably from 'getArgs')--  -> Ex.Exceptional P.Error result-  -- ^ Returns an Exception if an error was encountered when parsing-  -- any part of the command line (either the global options or the-  -- mode.) Otherwise, returns the result.-modes = modesNoHelp---- | Like 'modes', but runs in the IO monad. Gets the command line--- arguments for you.  This function adds the options @-h@ and--- @--help@, both in the global options and in the options for each--- mode. If @-h@ or @--help@ is entered in the global options, the--- global help is shown and the program exits successfully; similarly,--- if help is requested for a particular mode, that mode's help is--- shown and the program exits successfully.------ If an error occurs in the processing of the command line, an error--- message is printed and the program exits with a failure.-modesWithHelp-  :: (String -> String)-  -- ^ Global help. This is a function that, when applied to the name-  -- of the program (which is retrieved at runtime), returns a help-  -- string. This is output exactly as is, so include any necessary-  -- trailing newlines.--  -> [C.OptSpec a]-  -- ^ Global options. These come after the program name but before-  -- the mode name. Do not add options for @-h@ or @--help@; these are-  -- added automatically.--  -> ([a] -> Either ([String] -> result) [Mode result])-  -- ^ This function will be applied to the result of parsing the-  -- global options. The function must return a @Left@ if you do not-  -- want to parse any modes at all. This can be useful if one of the-  -- global options was something like @--version@ and so-  -- you do not need to see any mode. The function returned in the-  -- @Left@ will be applied to a list of all remaining command-line-  -- arguments after the global options.--  -> IO result--modesWithHelp hlp glbls lsToEi = do-  as <- GetArgs.getArgs-  pn <- GetArgs.getProgName-  case modesWithHelpPure pn hlp glbls lsToEi as of-    Ex.Exception e -> do-      IO.hPutStr IO.stderr $ C.formatError pn e-      enterForHelp pn-      exitFailure-    Ex.Success g -> case g of-      NeedsHelp h -> putStr h >> exitSuccess-      NoHelp g2 -> case g2 of-        NeedsHelp h -> putStr h >> exitSuccess-        NoHelp g3 -> return g3----- | 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

@@ -0,0 +1,169 @@+-- | 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 Control.Monad.Exception.Synchronous+  , 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 Control.Monad.Exception.Synchronous+import System.Environment

@@ -0,0 +1,551 @@+-- | 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 qualified Control.Monad.Exception.Synchronous as Ex+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 -> Ex.Exceptional InputError a+reader s = case reads s of+  (a, ""):[] -> return a+  _ -> Ex.throw . 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+  -> Ex.Exceptional InputError (Maybe a)+optReader ms = case ms of+  Nothing -> return Nothing+  Just s -> case reads s of+    (a, ""):[] -> return (Just a)+    _ -> Ex.throw . 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".+--+-- Some of these value constructors have names ending in @E@. Use+-- these constructors when you want to parse option arguments that may+-- fail to parse--for example, you want to parse an Int. The function+-- passed as an argument to the value constructor indicates failure by+-- returing an 'Exception'.+data ArgSpec a =+  NoArg a+  -- ^ This option takes no arguments++  | OptionalArg (Maybe String -> 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 -> 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 -> a)+    -- ^ This option takes two arguments. Parsed similarly to+    -- 'OneArg'.++  | ThreeArg (String -> String -> String -> a)+    -- ^ This option takes three arguments. Parsed similarly to+    -- 'OneArg'.++  | VariableArg ([String] -> 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@.++  | OptionalArgE (Maybe String -> Ex.Exceptional InputError a)+    -- ^ This option takes an optional argument, like+    -- 'OptionalArg'. Parsing of the optional argument might fail.++  | OneArgE (String -> Ex.Exceptional InputError a)+    -- ^ This option takes a single argument, like 'OneArg'. Parsing+    -- of the argument might fail.++  | TwoArgE (String -> String -> Ex.Exceptional InputError a)+    -- ^ This option takes two arguments, like 'TwoArg'. Parsing of+    -- the arguments might fail.++  | ThreeArgE (String -> String -> String -> Ex.Exceptional InputError a)+    -- ^ This option takes three arguments, like 'ThreeArg'. Parsing+    -- of the arguments might fail.++  | VariableArgE ([String] -> Ex.Exceptional InputError a)+    -- ^ This option takes a variable number of arguments, like+    -- 'VariableArg'. Parsing of the arguments might fail.+++instance Functor ArgSpec where+  fmap f a = case a of+    NoArg i -> NoArg $ f i+    OptionalArg g ->+      OptionalArg $ \ms -> f (g ms)+    OneArg g ->+      OneArg $ \s1 -> f (g s1)+    TwoArg g ->+      TwoArg $ \s1 s2 -> f (g s1 s2)+    ThreeArg g ->+      ThreeArg $ \s1 s2 s3 -> f (g s1 s2 s3)+    VariableArg g ->+      VariableArg $ \ls -> f (g ls)+    ChoiceArg gs ->+      ChoiceArg . map (\(s, r) -> (s, f r)) $ gs++    OptionalArgE g -> OptionalArgE $ \ms -> fmap f (g ms)++    OneArgE g ->+      OneArgE $ \s1 -> fmap f (g s1)++    TwoArgE g ->+      TwoArgE $ \s1 s2 -> fmap f (g s1 s2)++    ThreeArgE g ->+      ThreeArgE $ \s1 s2 s3 -> fmap f (g s1 s2 s3)++    VariableArgE g ->+      VariableArgE $ \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"+    OptionalArg f -> return (f maybeArg)+    OneArg f -> f <$> maybeNextArg+    TwoArg f -> f <$> maybeNextArg <*> nextWord+    ThreeArg f -> f <$> maybeNextArg <*> nextWord <*> nextWord+    VariableArg f -> do+      as <- many nonOptionPosArg+      return . f $ case maybeArg of+        Nothing -> as+        Just a1 -> a1 : as+    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++    OptionalArgE f -> case maybeArg of+      Nothing -> Ex.switch (fail . errorMsg (Left lo) []) return+                 $ f Nothing+      Just s -> Ex.switch (fail . errorMsg (Left lo) [s]) return+                $ f (Just s)+++    OneArgE f -> maybeNextArg >>= g+      where+        g a = Ex.switch (fail . errorMsg (Left lo) [a]) return+              $ f a++    TwoArgE f -> do+      a1 <- maybeNextArg+      a2 <- nextWord+      Ex.switch (fail . errorMsg (Left lo) [a1, a2]) return+        $ f a1 a2++    ThreeArgE f -> do+      a1 <- maybeNextArg+      a2 <- nextWord+      a3 <- nextWord+      Ex.switch (fail . errorMsg (Left lo) [a1, a2, a3]) return+        $ f a1 a2 a3++    VariableArgE f -> do+      as <- many nonOptionPosArg+      let args = case maybeArg of+            Nothing -> as+            Just a -> a:as+      Ex.switch (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+      OptionalArg f -> shortOptionalArg f+      OneArg f -> shortOneArg f+      TwoArg f -> shortTwoArg f+      ThreeArg f -> shortThreeArg f+      VariableArg f -> shortVariableArg f+      ChoiceArg ls -> shortChoiceArg opt ls+      OptionalArgE f -> shortOptionalArgE opt f+      OneArgE f -> shortOneArgE opt f+      TwoArgE f -> shortTwoArgE opt f+      ThreeArgE f -> shortThreeArgE opt f+      VariableArgE f -> shortVariableArgE 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 :: ([String] -> a) -> Parser a+shortVariableArg f = do+  maybeSameWordArg <- optional pendingShortOptArg+  args <- many nonOptionPosArg+  case maybeSameWordArg of+    Nothing -> return (f args)+    Just arg1 -> return (f (arg1:args))+++shortVariableArgE+  :: ShortOpt+  -> ([String] -> Ex.Exceptional InputError a)+  -> Parser a+shortVariableArgE so f = do+  maybeSameWordArg <- optional pendingShortOptArg+  args <- many nonOptionPosArg+  let as = case maybeSameWordArg of+        Nothing -> args+        Just a -> a:args+  Ex.switch (fail . errorMsg (Right so) as) return $ f as+++shortOneArg :: (String -> a) -> Parser a+shortOneArg f = f <$> firstShortArg++shortOneArgE+  :: ShortOpt+  -> (String -> Ex.Exceptional InputError a)+  -> Parser a+shortOneArgE so f = do+  a <- firstShortArg+  Ex.switch (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 :: (String -> String -> a) -> Parser a+shortTwoArg f = f <$> firstShortArg <*> nextWord++shortTwoArgE+  :: ShortOpt+  -> (String -> String -> Ex.Exceptional InputError a)+  -> Parser a+shortTwoArgE so f = do+  a1 <- firstShortArg+  a2 <- nextWord+  Ex.switch (fail . errorMsg (Right so) [a1, a2]) return+    $ f a1 a2++shortThreeArg :: (String -> String -> String -> a) -> Parser a+shortThreeArg f = f <$> firstShortArg <*> nextWord <*> nextWord++shortThreeArgE+  :: ShortOpt+  -> (String -> String -> String -> Ex.Exceptional InputError a)+  -> Parser a+shortThreeArgE so f = do+  a1 <- firstShortArg+  a2 <- nextWord+  a3 <- nextWord+  Ex.switch (fail . errorMsg (Right so) [a1, a2, a3]) return+    $ f a1 a2 a3++shortOptionalArg :: (Maybe String -> a) -> Parser a+shortOptionalArg f = do+  maybeSameWordArg <- optional pendingShortOptArg+  case maybeSameWordArg of+    Nothing -> do+      maybeArg <- optional nonOptionPosArg+      case maybeArg of+        Nothing -> return (f Nothing)+        Just a -> return (f (Just a))+    Just a -> return (f (Just a))++shortOptionalArgE+  :: ShortOpt+  -> (Maybe String -> Ex.Exceptional InputError a)+  -> Parser a+shortOptionalArgE so f = do+  maybeSameWordArg <- optional pendingShortOptArg+  case maybeSameWordArg of+    Nothing -> do+      maybeArg <- optional nonOptionPosArg+      case maybeArg of+        Nothing -> Ex.switch (fail . errorMsg (Right so) []) return+                   $ f Nothing+        Just a -> Ex.switch (fail . errorMsg (Right so) [a]) return+                  $ f (Just a)+    Just a -> Ex.switch (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 ""+    

@@ -0,0 +1,515 @@+{-# 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(..)+  , MapShortcuts(..)+  , 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 qualified Control.Monad.Exception.Synchronous as Ex+import System.Environment (getArgs, getProgName)+import System.Exit (exitFailure, exitSuccess)+import qualified System.IO as IO+import Control.Applicative ( many, (<|>), optional,+                             (<$), (<*>), (<*), (<$>))+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+  { oOptions :: [C.OptSpec a]+  -- ^ If the user does not specify any shortcut options, she may+  -- specify any number of these options.++  , 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.++  }++-- | 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 os = Opts os [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 os = Opts os [ C.OptSpec ["help"] "h" (C.NoArg h)+                                 , C.OptSpec ["version"] "v" (C.NoArg v) ]++instance Functor (Opts s) where+  fmap f (Opts os ss) = Opts (map (fmap f) os) ss++-- | Things that contain shortcut options that can be changed.+class MapShortcuts f where+  smap :: (a -> b) -> f a o -> f b o++instance MapShortcuts Opts where+  smap f (Opts os ss) = Opts os (map (fmap f) ss)++-- | Specification for both options and positional arguments.+data OptsWithPosArgs s a = OptsWithPosArgs+  { opOpts :: Opts s a+  , opIntersperse :: Intersperse+  , opPosArg :: String -> Ex.Exceptional C.InputError a+  }++instance MapShortcuts OptsWithPosArgs where+  smap f (OptsWithPosArgs os i p) = OptsWithPosArgs (smap f os) i p++instance Functor (OptsWithPosArgs s) where+  fmap f (OptsWithPosArgs os i p) =+    OptsWithPosArgs (fmap f os) i (fmap (fmap f) p)++-- | 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.+  }++-- | 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 -> Ex.Exceptional C.InputError a)+  -- ^ Parses positional arguments++  -> Mode h r++modeHelp n h getR os i p =+  Mode n getR (OptsWithPosArgs (Opts os ss) i p)+  where+    ss = [C.OptSpec ["help"] "h" (C.NoArg h)]++instance MapShortcuts Mode where+  smap f (Mode n g o) = Mode n g (smap f o)++instance Functor (Mode s) where+  fmap f (Mode n gr os) = Mode n (fmap f gr) os++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++  -> Ex.Exceptional 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] -> Ex.Exceptional 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 an Exception if there is something wrong with the+  -- global options (a nonsensical combination, perhaps.)  Otherwise,+  -- it returns an 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++  -> Ex.Exceptional P.Error (Either s r)+  -- ^ If the command line arguments fail to parse, this will be an+  -- Exception with the error.  If the parser is successful, this+  -- returns an 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+          Ex.Exception s -> fail s+          Ex.Success 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 -> Ex.Exceptional 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+    Ex.Exception e -> errorAct e+    Ex.Success 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+    Ex.Exception e -> showErr e >> exitFailure+    Ex.Success 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] -> Ex.Exceptional 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 an Exception if there is something wrong with the+  -- global options (a nonsensical combination, perhaps.)  Otherwise,+  -- it returns an 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+    Ex.Exception e -> errorAct e+    Ex.Success 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 -> Ex.Exceptional 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 os shortcuts) 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 -> Ex.Exceptional 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 os shortcuts) ir getArg+  ei <- simpleIOCustomError errorActDisplayHelp opts+  case ei of+    Left act -> act+    Right as -> return as++-- # Helpers++-- | Parses positional arguments and handles errors with them.+parsePosArg+  :: (String -> Ex.Exceptional C.InputError a)+  -> P.Parser a+parsePosArg p = do+  a <- P.nextWord+  case p a of+    Ex.Exception e ->+      let msg = "invalid positional argument: \"" ++ a ++ "\""+      in case e of+          C.NoMsg -> fail msg+          C.ErrorMsg s -> fail $ msg ++ ": " ++ s+    Ex.Success 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 -> Ex.Exceptional C.InputError a)+  -> P.Parser [a]+parseStopOpts optParser p =+  (++)+  <$> parseOptsNoIntersperse optParser+  <* optional P.stopper+  <*> many (parsePosArg 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.+parseIntersperse+  :: P.Parser a+  -> (String -> Ex.Exceptional C.InputError a)+  -> P.Parser [a]+parseIntersperse optParser p =+  let pa = Just <$> parsePosArg 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+

@@ -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 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

@@ -0,0 +1,676 @@+-- | 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 Control.Monad.Exception.Synchronous as Ex+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++  -> Ex.Exceptional 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 _ _ -> Ex.Success x+        Fail m -> Ex.Exception 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)+++-- | 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 Ex.switch ert gd $ do+    Ex.assert allOpts $ null ps+    Ex.assert allOpts $ not stop+    (x, rm') <- Ex.fromMaybe allOpts $ nextW rm+    (word, afterEq) <- Ex.fromMaybe allOpts $ getLongOption x+    opt <- Ex.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+        [] -> Ex.throw allOpts+        (m:[]) -> return (word, m, afterEq, rm')+        ls -> Ex.throw 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 Ex.switch ert gd $ do+      Ex.assert allWords $ null ps+      (x, rm') <- Ex.fromMaybe allWords $ nextW rm+      let matches = Set.filter p set+          p t = x `isPrefixOf` t+      case Set.toList matches of+        [] -> Ex.throw allWords+        r:[] -> return (x, r, rm')+        xs -> Ex.throw 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+

@@ -0,0 +1,58 @@+-- | 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 Bytes)+  , C.OptSpec ["follow"]                    ['f']     (C.OptionalArg Follow)+  , C.OptSpec ["follow-retry"]              ['F']     (C.NoArg Retry)+  , C.OptSpec ["lines"]                     ['n']     (C.OneArg Lines)+  , C.OptSpec ["max-unchanged-stats"]       []        (C.OneArg Stats)+  , C.OptSpec ["pid"]                       []        (C.OneArg Pid)+  , C.OptSpec ["quiet"]                     ['q']     (C.NoArg Quiet)+  , C.OptSpec ["sleep-interval"]            ['s']     (C.OneArg 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

@@ -1,5 +1,5 @@ Name: multiarg-Version: 0.16.0.0+Version: 0.18.0.0 Cabal-version: >=1.8 Build-Type: Simple License: BSD3@@ -29,35 +29,25 @@  See the documentation in the System.Console.MultiArg module for  details. -Flag newbase-    Description: Builds package with base >= 4.4.0.0.- source-repository head     type: git     location: git://github.com/massysett/multiarg.git  Library-    Build-depends:-        explicit-exception ==0.1.*,-        containers ==0.5.*+  Build-depends:+      base ==4.6.*+    , containers ==0.5.*+    , explicit-exception ==0.1.* +  hs-source-dirs: lib -    -- See documentation in System.Console.MultiArg.GetArgs for details-    if flag(newbase)-        Build-depends:-            base >= 4.4 && < 5-    else-        Build-depends:-            base < 4.4,-            utf8-string == 0.3.7+  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 -    Exposed-modules:-        System.Console.MultiArg,-        System.Console.MultiArg.Combinator,-        System.Console.MultiArg.GetArgs,-        System.Console.MultiArg.Option,-        System.Console.MultiArg.Prim,-        System.Console.MultiArg.SampleParser,-        System.Console.MultiArg.SimpleParser+  ghc-options: -Wall -    ghc-options: -Wall