multiarg 0.1.0.0 → 0.2.0.0

raw patch · 23 files changed

+2152/−2134 lines, 23 filesdep −QuickCheckPVP ok

version bump matches the API change (PVP)

Dependencies removed: QuickCheck

API changes (from Hackage documentation)

Files

• NEWS +14/−0
• System/Console/MultiArg.hs +0/−169
• System/Console/MultiArg/Combinator.hs +0/−364
• System/Console/MultiArg/Error.hs +0/−274
• System/Console/MultiArg/GetArgs.hs +0/−68
• System/Console/MultiArg/Option.hs +0/−72
• System/Console/MultiArg/Prim.hs +0/−847
• System/Console/MultiArg/QuickCheckHelpers.hs +0/−24
• System/Console/MultiArg/SampleParser.hs +0/−30
• System/Console/MultiArg/SimpleParser.hs +0/−255
• System/Console/MultiArg/TextNonEmpty.hs +0/−23
• binaries/sample.hs +0/−4
• doc/sample.hs +4/−0
• lib/System/Console/MultiArg.hs +169/−0
• lib/System/Console/MultiArg/Combinator.hs +364/−0
• lib/System/Console/MultiArg/Error.hs +215/−0
• lib/System/Console/MultiArg/GetArgs.hs +68/−0
• lib/System/Console/MultiArg/Option.hs +61/−0
• lib/System/Console/MultiArg/Prim.hs +962/−0
• lib/System/Console/MultiArg/SampleParser.hs +30/−0
• lib/System/Console/MultiArg/SimpleParser.hs +255/−0
• lib/System/Console/MultiArg/TextNonEmpty.hs +6/−0
• multiarg.cabal +4/−4

@@ -0,0 +1,14 @@+Release 0.2.0.0, April 2, 2012+Changes since release 0.1.0.0:++* Henceforth all public releases will have only even numbers in their+  release numbers (e.g. 0.2.0.0, 0.2.0.2, etc.) If a release has any+  odd numbers in its version, it is a development release.++* QuickCheck tests are removed. Eventually I will reimplement these in+  a separate library package.++* Added Feed function to System.Console.MultiArg.Prim; this allows you+  to carry out stateful parses without using a user state. Sometimes+  this aids in composability--for instance, I use it when combining+  parsers from different parts of the same program.

@@ -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. For-  -- maximum flexibility you will want to start with the-  -- "System.Console.MultiArg.Prim" module.-  ---  -- Using the parsers and combinators in-  -- "System.Console.MultiArg.Prim", 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. You can also easily parse command lines for programs-  -- that have multiple \"modes\", like @git@ or @darcs@. If you're-  -- doing this, of course first start by reading the documentation-  -- for "System.Console.MultiArg.Prim" and-  -- "System.Console.MultiArg.Combinator". You will also want to look-  -- at 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.-  ---  -- Internally the combinators in "System.Console.MultiArg.Prim" use-  -- strict "Data.Text" values rather than "String"s. That is because-  -- this library was built for an application that sometimes parses an-  -- enormous amount of command line data, and I thought that using-  -- Data.Text would yield some memory savings while retaining Unicode-  -- safety. Though I cannot remember whether this actually yielded any-  -- space savings (it did not lead to more space usage, at least) it-  -- also made the parser consistent with the rest of that program,-  -- which also uses Data.Text. I have considered making this library-  -- use either Data.Text or Strings but that makes it a lot more-  -- complicated for little gain. The SimpleParser module, however,-  -- wraps the "Data.Text" values up and exposes only Strings in the-  -- interface, keeping things nice and simple. This does mean that-  -- Strings have to be converted to Data.Text and back again, but the-  -- performance hit will not be significant unless you are parsing an-  -- obscene amount of data--and if you're doing that, you might want to-  -- use Data.Text anyway :)--  module System.Console.MultiArg.SimpleParser ) where--import System.Console.MultiArg.SimpleParser

@@ -1,364 +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-  option,-  optionMaybe,-  notFollowedBy,-  -  -- * Short options-  shortNoArg,-  shortOptionalArg,-  shortOneArg,-  shortTwoArg,-  shortVariableArg,--  -- * Long options-  nonGNUexactLongOpt,-  matchApproxLongOpt,-  matchNonGNUApproxLongOpt,-  longNoArg,-  longOptionalArg,-  longOneArg,-  longTwoArg,-  longVariableArg,-  -  -- * Mixed options-  mixedNoArg,-  mixedOptionalArg,-  mixedOneArg,-  mixedTwoArg,-  mixedVariableArg,-  -  -- * Other words-  matchApproxWord ) where-  -import Data.Text ( Text, isPrefixOf )-import Data.Set ( Set )-import qualified Data.Set as Set-import Control.Monad ( liftM )--import System.Console.MultiArg.Prim-  ( ParserT, throw, try, approxLongOpt,-    nextArg, pendingShortOptArg, nonOptionPosArg,-    pendingShortOpt, nonPendingShortOpt,-    exactLongOpt, nextArg, (<?>))-import System.Console.MultiArg.Option-  ( LongOpt, ShortOpt )-import qualified System.Console.MultiArg.Error as E-import System.Console.MultiArg.Error-  ( Error, parseErr )-import Control.Applicative ((<|>), many)-import Control.Monad ( void )-import Data.Monoid ( mconcat )---- | @option x p@ runs parser p. If p fails without consuming any--- input, returns x. Otherwise, returns p.-option :: (Error e, Monad m) =>-          a-          -> ParserT s e m a-          -> ParserT s e m a-option x p = p <|> return x---- | @optionMaybe p@ runs parser p. If p fails without returning any--- input, returns Nothing. If p succeeds, returns the result of p--- wrapped in a Just. If p fails but consumes input, optionMaybe--- fails.-optionMaybe :: (Error e, Monad m)-               => ParserT s e m a-               -> ParserT s e m (Maybe a)-optionMaybe p = option Nothing (liftM Just p)---- | @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 :: (Error e, Monad m)-                 => ParserT s e m a-                 -> ParserT s e m ()-notFollowedBy p =-  void $ ((try p >> throw (E.parseErr E.ExpNotFollowedBy E.SawFollowedBy))-          <|> return ())----- | Parses only a non-GNU style long option (that is, one that does--- not take option arguments by attaching them with an equal sign,--- such as @--lines=20@).-nonGNUexactLongOpt :: (Error e, Monad m)-                      => LongOpt-                      -> ParserT s e m LongOpt-nonGNUexactLongOpt l = try $ do-  (lo, maybeArg) <- exactLongOpt l-  case maybeArg of-    Nothing -> return lo-    (Just t) ->-      throw (parseErr (E.ExpNonGNUExactLong l)-            (E.SawGNULongOptArg t))---- | Takes a long option and a set of long options. If the next word--- on the command line unambiguously starts with the name of the long--- option given, returns the actual text found on the command line,--- the long option, and the text of any GNU-style option--- argument. Make sure that the long option you are looking for is--- both the first argument and that it is included in the set;--- otherwise this parser will always fail.-matchApproxLongOpt :: (Error e, Monad m)-                      => LongOpt-                      -> Set LongOpt-                      -> ParserT s e m (Text, LongOpt, Maybe Text)-matchApproxLongOpt l s = try $ do-  a@(t, lo, _) <- approxLongOpt s-  if lo == l-    then return a-    else throw (parseErr (E.ExpMatchingApproxLong l s)-               (E.SawNotMatchingApproxLong t lo))---- | Like matchApproxLongOpt but only parses non-GNU-style long--- options.-matchNonGNUApproxLongOpt :: (Error e, Monad m)-                            => LongOpt-                            -> Set LongOpt-                            -> ParserT s e m (Text, LongOpt)-matchNonGNUApproxLongOpt l s = try $ do-  (t, lo, arg) <- matchApproxLongOpt l s-  let err b = throw (parseErr (E.ExpNonGNUMatchingApproxLong l s)-                    (E.SawMatchingApproxLongWithArg b))-  maybe (return (t, lo)) err arg---- | 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.-matchApproxWord :: (Error e, Monad m)-                   => Set Text-                   -> ParserT s e m (Text, Text)-matchApproxWord s = try $ do-  a <- nextArg-  let p t = a `isPrefixOf` t-      matches = Set.filter p s-      err saw = throw (parseErr (E.ExpApproxWord s) saw)-  case Set.toList matches of-    [] -> err (E.SawNoMatches a)-    (x:[]) -> return (a, x)-    _ -> err (E.SawMultipleApproxMatches matches a)---- | Parses short options that do not take any argument. (It is--- however okay for the short option to be combined with other short--- options in the same word.)-shortNoArg :: (Error e, Monad m)-            => ShortOpt-            -> ParserT s e m ShortOpt-shortNoArg s = pendingShortOpt s <|> nonPendingShortOpt s---- | Parses short options that take an optional argument. The argument--- can be combined in the same word with the short option (@-c42@) or--- can be in the ext word (@-c 42@).-shortOptionalArg :: (Error e, Monad m)-                 => ShortOpt-                 -> ParserT s e m (ShortOpt, Maybe Text)-shortOptionalArg s = do-  so <- shortNoArg s-  a <- optionMaybe (pendingShortOptArg <|> nonOptionPosArg)-  return (so, a)---- | Parses short options that take a required argument.  The argument--- can be combined in the same word with the short option (@-c42@) or--- can be in the ext word (@-c 42@).-shortOneArg :: (Error e, Monad m) =>-               ShortOpt-               -> ParserT s e m (ShortOpt, Text)-shortOneArg s = do-  so <- shortNoArg s-  a <- pendingShortOptArg <|> nextArg-  return (so, a)---- | Parses short options that take two required arguments. The first--- argument can be combined in the same word with the short option--- (@-c42@) or can be in the ext word (@-c 42@). The next argument--- will have to be in a separate word.-shortTwoArg :: (Error e, Monad m)-               => ShortOpt-               -> ParserT s e m (ShortOpt, Text, Text)-shortTwoArg s = do-  (so, a1) <- shortOneArg s-  a2 <- nextArg-  return (so, a1, a2)---- | Parses short options that take a variable number of--- arguments. This will keep on parsing option arguments until it--- encounters one that does not "look like" an option--that is, until--- it encounters one that begins with a dash. Therefore, the only way--- to terminate a variable argument option if it is the last option is--- with a stopper. The first argument can be combined in the same word--- with the short option (@-c42@) or can be in the ext word (@-c--- 42@). Subsequent arguments will have to be in separate words.-shortVariableArg :: (Error e, Monad m)-                 => ShortOpt-                 -> ParserT s e m (ShortOpt, [Text])-shortVariableArg s = do-  so <- shortNoArg s-  firstArg <- optionMaybe pendingShortOptArg-  rest <- many nonOptionPosArg-  let result = maybe rest ( : rest ) firstArg-  return (so, result)---- | Parses long options that do not take any argument.-longNoArg :: (Error e, Monad m)-           => LongOpt-           -> ParserT s e m LongOpt-longNoArg = nonGNUexactLongOpt---- | Parses long options that take a single, optional argument. The--- single argument can be given GNU-style (@--lines=20@) or non-GNU--- style in separate words (@lines 20@).-longOptionalArg :: (Error e, Monad m)-                   => LongOpt-                   -> ParserT s e m (LongOpt, Maybe Text)-longOptionalArg = exactLongOpt---- | Parses long options that take a single, required argument. The--- single argument can be given GNU-style (@--lines=20@) or non-GNU--- style in separate words (@lines 20@).-longOneArg :: (Error e, Monad m)-                 => LongOpt-                 -> ParserT s e m (LongOpt, Text)-longOneArg l = do-  (lo, mt) <- longOptionalArg l-  case mt of-    (Just t) -> return (lo, t)-    Nothing -> do-      a <- nextArg <?> E.parseErr E.ExpLongOptArg E.SawNoArgsLeft-      return (l, a)---- | Parses long options that take a double, required argument. The--- first argument can be given GNU-style (@--lines=20@) or non-GNU--- style in separate words (@lines 20@). The second argument will have--- to be in a separate word.-longTwoArg :: (Error e, Monad m)-                 => LongOpt-                 -> ParserT s e m (LongOpt, Text, Text)-longTwoArg l = do-  (lo, mt) <- longOptionalArg l-  case mt of-    (Just t) -> do-      a2 <- nextArg-      return (lo, t, a2)-    Nothing -> do-      a1 <- nextArg-      a2 <- nextArg-      return (lo, a1, a2)---- | Parses long options that take a variable number of--- arguments. This will keep on parsing option arguments until it--- encounters one that does not "look like" an option--that is, until--- it encounters one that begins with a dash. Therefore, the only way--- to terminate a variable argument option if it is the last option is--- with a stopper. The first argument can be combined in the same word--- with the short option (@--lines=20@) or can be in the ext word--- (@--lines 42@). Subsequent arguments will have to be in separate--- words.-longVariableArg :: (Error e, Monad m)-                   => LongOpt-                   -> ParserT s e m (LongOpt, [Text])-longVariableArg l = do-  (lo, mt) <- longOptionalArg l-  rest <- many nonOptionPosArg-  return (lo, maybe rest (:rest) mt)---- | Parses at least one long option and a variable number of short--- and long options that take no arguments.-mixedNoArg :: (Error e, Monad m)-              => LongOpt-              -> [LongOpt]-              -> [ShortOpt]-              -> ParserT s e m (Either ShortOpt LongOpt)-mixedNoArg l ls ss = mconcat ([f] ++ longs ++ shorts) where-  toLong lo = do-    r <- longNoArg lo-    return $ Right r-  toShort so = do-    s <- shortNoArg so-    return $ Left s-  f = toLong l-  longs = map toLong ls-  shorts = map toShort ss---- | Parses at least one long option and a variable number of short--- and long options that take an optional argument.-mixedOptionalArg ::-  (Error e, Monad m)-  => LongOpt-  -> [LongOpt]-  -> [ShortOpt]-  -> ParserT s e m ((Either ShortOpt LongOpt), Maybe Text)-mixedOptionalArg l ls ss = mconcat ([f] ++ longs ++ shorts) where-  toLong lo = do-    (o, a) <- longOptionalArg lo-    return $ (Right o, a)-  toShort so = do-    (o, a) <- shortOptionalArg so-    return $ (Left o, a)-  f = toLong l-  longs = map toLong ls-  shorts = map toShort ss---- | Parses at least one long option and additional long and short--- options that take one argument.-mixedOneArg ::-  (Error e, Monad m)-  => LongOpt-  -> [LongOpt]-  -> [ShortOpt]-  -> ParserT s e m ((Either ShortOpt LongOpt), Text)-mixedOneArg l ls ss = mconcat ([f] ++ longs ++ shorts) where-  toLong lo = do-    (o, a) <- longOneArg lo-    return (Right o, a)-  toShort lo = do-    (o, a) <- shortOneArg lo-    return (Left o, a)-  f = toLong l-  longs = map toLong ls-  shorts = map toShort ss---- | Parses at least one long option and additonal long and short--- options that take two arguments.-mixedTwoArg ::-  (Error e, Monad m)-  => LongOpt-  -> [LongOpt]-  -> [ShortOpt]-  -> ParserT s e m ((Either ShortOpt LongOpt), Text, Text)-mixedTwoArg l ls ss = mconcat ([f] ++ longs ++ shorts) where-  toLong lo = do-    (o, a1, a2) <- longTwoArg lo-    return (Right o, a1, a2)-  toShort lo = do-    (o, a1, a2) <- shortTwoArg lo-    return (Left o, a1, a2)-  f = toLong l-  longs = map toLong ls-  shorts = map toShort ss---- | Parses at least one long option and additional long and short--- options that take a variable number of arguments.-mixedVariableArg ::-  (Error e, Monad m)-  => LongOpt-  -> [LongOpt]-  -> [ShortOpt]-  -> ParserT s e m ((Either ShortOpt LongOpt), [Text])-mixedVariableArg l ls ss = mconcat ([f] ++ longs ++ shorts) where-  toLong lo = do-    (o, a) <- longVariableArg lo-    return (Right o, a)-  toShort lo = do-    (o, a) <- shortVariableArg lo-    return (Left o, a)-  f = toLong l-  longs = map toLong ls-  shorts = map toShort ss-

@@ -1,274 +0,0 @@--- | Errors. Parsing a command line when a user has entered it--- correctly is easy; doing something sensible when an incorrect line--- has been entered is a bit more difficult. This module exports an--- 'Error' typeclass, which you can declare instances of in order to--- have your own type to represent errors. Or you can use--- 'SimpleError', which is already an instance of 'Error'.-module System.Console.MultiArg.Error where--import System.Console.MultiArg.Option-  ( LongOpt, ShortOpt, unLongOpt, unShortOpt )-import System.Console.MultiArg.TextNonEmpty-  ( TextNonEmpty ( TextNonEmpty ) )-import Data.Text ( Text, pack, append, singleton, intercalate,-                   snoc )-import Data.Set ( Set )-import qualified Data.Set as Set-import Test.QuickCheck ( Arbitrary ( arbitrary ), -                         choose )-import System.Console.MultiArg.QuickCheckHelpers-  ( randSet, randText )-import Control.Monad ( liftM, liftM2 )---- | Instances of this typeclass represent multiarg errors. You can--- declare instances of this typeclass so that you can use your own--- type for errors. This makes multiarg easy to integrate into your--- own programs. Then you can also easily add other errors, which you--- can report from the parsers you build by calling--- 'System.Console.MultiArg.Prim.throw'.-class Error e where-  -- | Store an error in your Error instance.-  parseErr :: Expecting -> Saw -> e---- | A simple type that is already an instance of 'Error'.-data SimpleError = SimpleError Expecting Saw deriving (Show, Eq)---- | Generates error messages.-printError :: SimpleError -> Text-printError (SimpleError e s) =-  pack "Error parsing command line input.\n"-  `append` pack "expected to see: "-  `append` printExpecting e `snoc` '\n'-  `append` pack "actually saw: "-  `append` printSaw s `snoc` '\n'--instance Error SimpleError where-  parseErr = SimpleError--instance Arbitrary SimpleError where-  arbitrary = liftM2 SimpleError arbitrary arbitrary---- | Each error consists of two parts: what the parser was expecting--- to see, and what it actually saw. This type holds what the parser--- expected to see. If you just want to give some text to be used in--- an error message, use 'ExpTextError'. To generate a generic error,--- use 'ExpOtherFailure'.-data Expecting = ExpPendingShortOpt ShortOpt-               | ExpExactLong LongOpt-               | ExpApproxLong (Set LongOpt)-               | ExpLongOptArg-               | ExpPendingShortArg-               | ExpStopper-               | ExpNextArg-               | ExpNonOptionPosArg-               | ExpEnd-               | ExpNonGNUExactLong LongOpt-               | ExpMatchingApproxLong LongOpt (Set LongOpt)-               | ExpNonGNUMatchingApproxLong LongOpt (Set LongOpt)-               | ExpApproxWord (Set Text)-               | ExpOptionOrPosArg-               | ExpTextError Text-               | ExpNonPendingShortOpt ShortOpt-               | ExpNotFollowedBy-               | ExpOtherFailure-               deriving (Show, Eq)---- | Generates an error message from an Expecting.-printExpecting :: Expecting -> Text-printExpecting e = case e of-  (ExpPendingShortOpt s) ->-    (pack "short option: ") `append` (singleton . unShortOpt $ s)-  (ExpExactLong l) ->-    (pack "long option: ") `append` (unLongOpt $ l)-  (ExpApproxLong ls) ->-    (pack "approximate long option matching one of: ") `append`-    intercalate (pack ", ") (map unLongOpt . Set.toList $ ls)-  ExpLongOptArg -> pack "argument to long option"-  ExpPendingShortArg -> pack "argument to short option"-  ExpStopper -> pack "stopper (\"--\")"-  ExpNextArg -> pack "next word on command line"-  ExpNonOptionPosArg ->-    pack "word on command line not starting with a hyphen"-  ExpEnd -> pack "end of command line input"-  (ExpNonGNUExactLong lo) ->-    pack "long option without an included argument: "-    `append` (unLongOpt lo)-  (ExpMatchingApproxLong l ls) ->-    pack "abbreviated long option named: " `append` (unLongOpt l)-    `append` pack "from possible abbreviated long options named: "-    `append` (intercalate (pack ", ")-              (map unLongOpt . Set.toList $ ls))-  (ExpNonGNUMatchingApproxLong l ls) ->-    pack "abbreviated long without an included argument named: "-    `append` (unLongOpt l)-    `append` pack "from possible abbreviated long options named: "-    `append` (intercalate (pack ", ")-              (map unLongOpt . Set.toList $ ls))-  (ExpApproxWord ws) ->-    pack "one of these abbreviated words: "-    `append` (intercalate (pack ", ") (Set.toList $ ws))-  ExpOptionOrPosArg ->-    pack "option or positional argument"-  (ExpTextError t) -> t-  (ExpNonPendingShortOpt s) ->-    (pack "short option: ") `append` (singleton . unShortOpt $ s)-  ExpNotFollowedBy ->-    pack "not followed by"-  (ExpOtherFailure) -> pack "general failure"----instance Arbitrary Expecting where-  arbitrary = do-    i <- choose (0, (17 :: Int))-    case i of-      0 -> liftM ExpPendingShortOpt arbitrary-      1 -> liftM ExpExactLong arbitrary-      2 -> liftM ExpApproxLong randSet-      3 -> return ExpLongOptArg-      4 -> return ExpPendingShortArg-      5 -> return ExpStopper-      6 -> return ExpNextArg-      7 -> return ExpNonOptionPosArg-      8 -> return ExpEnd-      9 -> liftM ExpNonGNUExactLong arbitrary-      10 -> liftM2 ExpMatchingApproxLong arbitrary randSet-      11 -> liftM2 ExpNonGNUMatchingApproxLong arbitrary randSet-      12 -> liftM ExpApproxWord-            (liftM (Set.fromList . map pack) arbitrary)-      13 -> return ExpOptionOrPosArg-      14 -> liftM ExpTextError randText-      15 -> liftM ExpNonPendingShortOpt arbitrary-      16 -> return ExpNotFollowedBy-      17 -> return ExpOtherFailure-      _  -> error "should never happen"---- | What the parser actually saw. To give some text to be used in the--- error message, use 'SawTextError'. To generate a generic error, use--- 'SawOtherFailure'.-data Saw = SawNoPendingShorts-         | SawWrongPendingShort Char-         | SawNoArgsLeft-         | SawEmptyArg-         | SawSingleDashArg-         | SawStillPendingShorts TextNonEmpty-         | SawNotShortArg Text-         | SawWrongShortArg Char-         | SawNotLongArg Text-         | SawWrongLongArg Text-         | SawNoMatches Text-         | SawMultipleMatches (Set LongOpt) Text-         | SawNoPendingShortArg-         | SawAlreadyStopper-         | SawNewStopper-         | SawNotStopper-         | SawLeadingDashArg Text-         | SawMoreInput-         | SawGNULongOptArg Text-         | SawNotMatchingApproxLong Text LongOpt-         | SawMatchingApproxLongWithArg Text -- Text of the argument-         | SawMultipleApproxMatches (Set Text) Text-         | SawNoOption-         | SawNoOptionOrPosArg-         | SawTextError Text-         | SawFollowedBy-         | SawOtherFailure-         deriving (Show, Eq)---- | Generates error messages from a 'Saw'.-printSaw :: Saw -> Text-printSaw s = case s of-  SawNoPendingShorts -> pack "no pending short options"-  (SawWrongPendingShort c) ->-    pack "unexpected short option: " `snoc` c-  SawNoArgsLeft -> pack "no command line words remaining"-  SawEmptyArg -> pack "command line word that is the empty string"-  SawSingleDashArg ->-    pack "command line word that is a single hyphen (\"-\")"-  (SawStillPendingShorts (TextNonEmpty first rest)) ->-    pack "pending short options: " `snoc` first-    `append` rest-  (SawNotShortArg t) ->-    pack "word that is not a short option: " `append` t-  (SawWrongShortArg c) ->-    pack "wrong short option: " `snoc` c-  (SawNotLongArg t) ->-    pack "word that is not a long option: " `append` t-  (SawWrongLongArg t) ->-    pack "wrong long option: " `append` t-  (SawNoMatches t) ->-    pack "word that does not match the available choices: "-    `append` t-  (SawMultipleMatches ss t) ->-    pack "word matches more than one of the available choices. "-    `append` pack "word given: " `append` t-    `append` pack " matches these words: "-    `append` (intercalate (pack ", ") (map unLongOpt . Set.toList $ ss))-  SawNoPendingShortArg -> pack "no short argument"-  SawAlreadyStopper ->-    pack "already seen a stopper (\"--\")"-  SawNewStopper ->-    pack "new stopper (\"--\")"-  SawNotStopper ->-    pack "word that is not a stopper (\"--\")"-  (SawLeadingDashArg t) ->-    pack "word with a leading hyphen: " `append` t-  SawMoreInput ->-    pack "additional words remaining on command line"-  (SawGNULongOptArg t) ->-    pack "attached argument for option that does not take one: "-    `append` t-  (SawNotMatchingApproxLong t lo) ->-    pack "long argument that does not match expected one. "-    `append` pack "argument given: " `append` t-    `append` pack "argument expected: " `append` unLongOpt lo-  (SawMatchingApproxLongWithArg t) ->-    pack "long argument that matches expected long argument, but it "-    `append` pack "has an attached argument. Text of argument: "-    `append` t-  (SawMultipleApproxMatches ms m) ->-    pack "multiple words match the one given. Word given: " `append` m-    `append` pack "possible matches: "-    `append` (intercalate (pack ", ") (Set.toList ms))-  SawNoOption ->-    pack "word that is not an option"-  SawNoOptionOrPosArg ->-    pack "not an option or positional argument"-  (SawTextError t) -> t-  SawFollowedBy -> pack "followed by"-  (SawOtherFailure) -> pack "general failure"--instance Arbitrary Saw where-  arbitrary = do-    i <- choose (0, (26 :: Int))-    case i of-      0 -> return SawNoPendingShorts-      1 -> liftM SawWrongPendingShort arbitrary-      2 -> return SawNoArgsLeft-      3 -> return SawEmptyArg-      4 -> return SawSingleDashArg-      5 -> liftM SawStillPendingShorts arbitrary-      6 -> liftM SawNotShortArg randText-      7 -> liftM SawWrongShortArg arbitrary-      8 -> liftM SawNotLongArg randText-      9 -> liftM SawWrongLongArg randText-      10 -> liftM SawNoMatches randText-      11 -> liftM2 SawMultipleMatches randSet randText-      12 -> return SawNoPendingShortArg-      13 -> return SawAlreadyStopper-      14 -> return SawNewStopper-      15 -> return SawNotStopper-      16 -> liftM SawLeadingDashArg randText-      17 -> return SawMoreInput-      18 -> liftM SawGNULongOptArg randText-      19 -> liftM2 SawNotMatchingApproxLong randText arbitrary-      20 -> liftM SawMatchingApproxLongWithArg randText-      21 -> liftM2 SawMultipleApproxMatches-            (liftM (Set.fromList . map pack) arbitrary)-            randText-      22 -> return SawNoOption-      23 -> return SawNoOptionOrPosArg-      24 -> liftM SawTextError randText-      25 -> return SawFollowedBy-      26 -> return SawOtherFailure-      _  -> error "should never happen"

@@ -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,72 +0,0 @@--- | These types represent options. They are abstract and in a--- separate module to prevent you from accidentally making an option--- with an invalid name. 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--import Test.QuickCheck ( Arbitrary ( arbitrary ),-                         suchThat )-import qualified Data.Text as X-import Data.Text ( Text, unpack, index )-import Control.Monad ( when )-import System.Console.MultiArg.QuickCheckHelpers ( randText )---- | 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)-instance Arbitrary ShortOpt where-  arbitrary = do-    c <- suchThat arbitrary (/= '-')-    return $ ShortOpt c---- | This function is partial. It calls error if its argument is a--- single dash. This is the only way to make a short option so it--- prevents you from making one that is invalid.-makeShortOpt :: Char -> ShortOpt-makeShortOpt c = case c of-  '-' -> error "short option must not be a dash"-  x -> 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 not have a dash as--- either the first or second character and it 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 :: Text } deriving (Show, Eq, Ord)-instance Arbitrary LongOpt where-  arbitrary = do-    t <- suchThat randText isValidLongOptText-    return $ LongOpt t---- | This function is partial. It calls error if its argument contains--- text that is not a valid long option. This is the only way to make--- a long option so it prevents you from making invalid ones.-makeLongOpt :: Text -> LongOpt-makeLongOpt t = case isValidLongOptText t of-  True -> LongOpt t-  False -> error $ "invalid long option: " ++ unpack t--isValidLongOptText :: Text -> Bool-isValidLongOptText t = maybe False (const True) $ do-  when (X.null t) Nothing-  when ((t `index` 0) == '-') Nothing-  when ((X.length t > 1) && ((t `index` 1) == '-')) Nothing-  case X.find (== '=') t of-    (Just _) -> Nothing-    Nothing -> return ()-  return ()--

@@ -1,847 +0,0 @@--- | Parser primitives. These are the only functions that have access--- to the internals of the parser.-module System.Console.MultiArg.Prim (-    -- * Parser types-  Parser,-  ParserE,-  ParserSE,-  ParserT,-  -  -- * Running a parser-  -  -- | Each parser runner is applied to a list of Text, which are the-  -- command line arguments to parse. 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'.-  parse,-  parseE,-  parseSE,-  parseT,-  -  -- * Higher-level parser combinators-  parserMap,-  good,-  apply,-  choice,-  combine,-  lookAhead,-  -  -- ** Running parsers multiple times-  several,-  manyTill,--  -- ** Monad lifting-  parserLift,-  parserIO,--  -- ** Failure and errors-  throw,-  throwString,-  genericThrow,-  (<?>),-  try,-  -  -- * Parsers-  -- ** Short options and arguments-  pendingShortOpt,-  nonPendingShortOpt,-  pendingShortOptArg,  -  -  -- ** Long options and arguments-  exactLongOpt,-  approxLongOpt,--  -- ** Stoppers-  stopper,-  -  -- ** Positional (non-option) arguments-  nextArg,-  nonOptionPosArg,-  -  -- ** Miscellaneous-  end,-  -  -- * User state-  get,-  put,-  modify-  ) where---import qualified System.Console.MultiArg.Error as E-import System.Console.MultiArg.Option-  (ShortOpt,-    unShortOpt,-    LongOpt,-    unLongOpt )-import System.Console.MultiArg.TextNonEmpty-  ( TextNonEmpty ( TextNonEmpty ) )-import Control.Applicative ( Applicative, Alternative )-import qualified Control.Applicative-import Control.Monad.Exception.Synchronous-  (Exceptional(Success, Exception), switch )-import qualified Control.Monad.Exception.Synchronous as S-import Data.Functor.Identity ( runIdentity )-import Data.Text ( Text, pack, isPrefixOf, cons )-import qualified Data.Text as X-import qualified Data.Set as Set-import Data.Set ( Set )-import Control.Monad ( when, MonadPlus(mzero, mplus) )-import Control.Monad.Trans.Class ( lift )-import Data.Maybe ( isNothing )-import Data.Monoid ( Monoid ( mempty, mappend ) )-import Data.Functor.Identity ( Identity )-import Control.Monad.Trans.Class ( MonadTrans )-import Control.Monad.IO.Class ( MonadIO ( liftIO ) )---- | Takes the head of a Text. Returns Nothing if the Text is empty.-textHead :: Text -> Maybe (Char, Text)-textHead t = case X.null t of-  True -> Nothing-  False -> Just (X.head t, X.tail t)---- | Converts a Text to a TextNonEmpty. Returns Nothing if the Text is--- empty.-toTextNonEmpty :: Text -> Maybe TextNonEmpty-toTextNonEmpty t = case textHead t of-  Nothing -> Nothing-  (Just (c, r)) -> Just $ TextNonEmpty c r---- | Carries the internal state of the parser. The counter is a simple--- way to determine whether the remaining list one ParseSt has been--- modified from another. When parsers modify remaining, they--- increment the counter.-data ParseSt s = ParseSt { pendingShort :: Maybe TextNonEmpty-                         , remaining :: [Text]-                         , sawStopper :: Bool-                         , userState :: s-                         , counter :: Int-                         } deriving (Show, Eq)---- | Load up the ParseSt with an initial user state and a list of--- commmand line arguments.-defaultState :: s -> [Text] -> ParseSt s-defaultState s ts = ParseSt { pendingShort = Nothing-                            , remaining = ts-                            , sawStopper = False-                            , userState = s-                            , counter = 0 }---- | Carries the result of each parse.-data Result e a = Bad e | Good a---- | @ParserT s e m a@ is a parser with user state s, error type e,--- underlying monad m, and result type a. Internally the parser is a--- state monad which keeps track of what is remaining to be--- parsed. Since the parser has an internal state anyway, the user can--- add to this state (this is called the user state.) The parser--- ignores this user state so you can use it however you wish. If you--- do not need a user state, just make it the unit type ().------ The parser also includes the notion of failure. Any parser can--- fail; a failed parser affects the behavior of combinators such as--- combine. The failure type should be a instance of--- System.Console.MultiArg.Error.Error. This allows you to define your--- own type and use it for the failure type, which can be useful when--- combining MultiArg with your own program.------ The underlying monad is m. This makes ParserT into a monad--- transformer; you can layer it on top of other monads. For instance--- you might layer it on top of the IO monad so that your parser can--- perform IO (for example, by examining the disk to see if arguments--- that specify files are valid.) If you don't need a monad--- transformer, just layer ParserT on top of Identity.-data ParserT s e m a =-  ParserT { runParserT :: ParseSt s -> m (Result e a, ParseSt s) }--instance (Monad m) => Functor (ParserT s e m) where-  fmap = parserMap--instance (Monad m) => Applicative (ParserT s e m) where-  pure = good-  (<*>) = apply--instance (Monad m, E.Error e) => Monoid (ParserT s e m a) where-  mempty = genericThrow-  mappend = choice--instance (Monad m, E.Error e) => Alternative (ParserT s e m) where-  empty = genericThrow-  (<|>) = choice-  many = several--instance (E.Error e, Monad m) => Monad (ParserT s e m) where-  (>>=) = combine-  return = good-  fail = throwString--instance (Monad m, E.Error e) => MonadPlus (ParserT s e m) where-  mzero = genericThrow-  mplus = choice--instance MonadTrans (ParserT s e) where-  lift = parserLift--instance (MonadIO m, E.Error e) => MonadIO (ParserT s e m) where-  liftIO = parserIO---- | @ParserSE s e a@ is a parser with user state s, error type e,--- underlying monad Identity, and result type a.-type ParserSE s e a = ParserT s e Identity a---- | @ParserE e a@ is a parser with user state (), error type e,--- underlying monad Identity, and result type a.-type ParserE e a = ParserT () e Identity a---- | @Parser a@ is a parser with user state (), error type--- SimpleError, underlying monad Identity, and result type a.-type Parser a = ParserT () E.SimpleError Identity a---- | Runs a parser that has a user state and an underlying monad--- Identity.-parseSE ::-  s-  -- ^ The initial user state-  -  -> [Text]-  -- ^ Command line arguments--  -> ParserSE s e a-  -- ^ Parser to run-  -  -> (Exceptional e a, s)-  -- ^ Success or failure, and the final user state-  -parseSE s ts p =-  let r = runIdentity (runParserT p (defaultState s ts))-      (result, st') = r-  in case result of-    (Good g) -> (Success g, userState st')-    (Bad e) -> (Exception e, userState st')---- | Runs a parser that has no user state and an underlying monad of--- Identity and is parameterized on the error type.-parseE ::-  [Text]-  -- ^ Command line arguments to parse-  -  -> ParserE e a-  -- ^ Parser to run-  -  -> Exceptional e a-  -- ^ Success or failure--parseE ts p =-  let r = runIdentity (runParserT p (defaultState () ts))-      (result, _) = r-  in case result of-    (Good g) -> Success g-    (Bad e) -> Exception e---- | The simplest parser runner; has no user state, an underlying--- monad Identity, and error type SimpleError.-parse :: [Text]-         -- ^ Command line arguments to parse-         -         -> Parser a-         -- ^ Parser to run--         -> Exceptional E.SimpleError a-         -- ^ Successful result or an error-parse = parseE---- | The most complex parser runner. Runs a parser with a user-defined--- state, error type, and underlying monad. Returns the final parse--- result and the final user state, inside of the underlying monad.-parseT ::-  (Monad m)-  => s-  -- ^ Initial user state--  -> [Text]-  -- ^ Command line arguments to parse--  -> ParserT s e m a-  -- ^ Parser to run-  -  -> m (Exceptional e a, s)-  -- ^ Success or failure and the final user state, inside of the-  -- underlying monad--parseT s ts p = runParserT p (defaultState s ts) >>= \r ->-  let (result, st') = r-  in case result of-    (Good g) -> return (Success g, userState st')-    (Bad e) -> return (Exception e, userState st')---- | Lifts a computation of the underlying monad into the ParserT--- monad. This provides the implementation for--- 'Control.Monad.Trans.Class.lift'.-parserLift ::-  Monad m-  => m a-  -> ParserT s e m a-parserLift c = ParserT $ \s ->-  c >>= \a -> return (Good a, s)---- | Lifts a computation from the IO monad into the ParserT--- monad. This provides the implementation for--- 'Control.Monad.IO.Class.liftIO'.-parserIO ::-  (MonadIO m, E.Error e)-  => IO a-  -> ParserT s e m a-parserIO c = parserLift . liftIO $ c---- | 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'.-combine ::-  (Monad m)-  => ParserT s e m a-  -> (a -> ParserT s e m b)-  -> ParserT s e m b-combine (ParserT l) f = ParserT $ \s ->-  l s >>= \(r, s') ->-  case r of-    (Bad e) -> return (Bad e, s')-    (Good g) ->-      let (ParserT fr) = f g-      in fr s'---- | @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 ::-  (Monad m)-  => ParserT s e m a-  -> ParserT s e m a-lookAhead (ParserT p) = ParserT $ \s ->-  p s >>= \(r, s') ->-  return $ case r of-    (Good g) -> (Good g, s)-    (Bad e) -> (Bad e, s')---- | @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 ::-  (Monad m)-  => a-  -> ParserT s e m a-good a = ParserT $ \s ->-  return (Good a, s)---- | @throwString 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'.-throwString ::-  (E.Error e, Monad m)-  => String-  -> ParserT s e m a-throwString e = ParserT $ \s ->-  return (Bad (E.parseErr E.ExpOtherFailure-               (E.SawTextError (pack e))), s)---- | @parserMap f p@ applies function f to the result of parser--- p. First parser p is run. If it succeeds, function f is applied to--- the result and another parser is returned with the result. If it--- fails, f is not applied and a failed parser is returned. This--- provides the implementation for 'Prelude.Functor.fmap'.-parserMap ::-  (Monad m)-  => (a -> b)-  -> ParserT s e m a-  -> ParserT s e m b-parserMap f (ParserT l) = ParserT $ \s ->-  l s >>= \r ->-  let (result, st') = r-  in case result of-    (Good g) -> return (Good (f g), st')-    (Bad e) -> return (Bad e, st')---- | apply l r applies the function found in parser l to the result of--- parser r. First the l parser is run. If it succeeds, it has a--- resulting function. Then the r parser is run. If it succeeds, the--- function from the l parser is applied to the result of the r--- parser, and a new parser is returned with the result. If either--- parser l or parser r fails, then a failed parser is returned. This--- provides the implementation for '<*>' in--- 'Control.Applicative.Applicative'.-apply ::-  (Monad m)-  => ParserT s e m (a -> b)-  -> ParserT s e m a-  -> ParserT s e m b-apply (ParserT x) (ParserT y) = ParserT $ \s ->-  x s >>= \r ->-  let (result, st') = r-  in case result of-    (Good f) -> y st' >>= \r' ->-      let (result', st'') = r'-      in case result' of-        (Good a) -> return (Good (f a), st'')-        (Bad e) -> return (Bad e, st'')-    (Bad e) -> return (Bad e, st')---- | Fail with an unhelpful error message. Usually throw is more--- useful, but this is handy to implement some typeclass instances.-genericThrow ::-  (Monad m, E.Error e)-  => ParserT s e m a-genericThrow = throw (E.parseErr E.ExpOtherFailure E.SawOtherFailure)---- | throw e always fails without consuming any input and returns a--- failed parser with error state e.-throw :: (Monad m) => e -> ParserT s e m a-throw e = ParserT $ \s ->-  return (Bad e, s)--noConsumed :: ParseSt s -> ParseSt s -> Bool-noConsumed old new = counter old >= counter new---- | 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 ::-  (Monad m)-  => ParserT s e m a-  -> ParserT s e m a-  -> ParserT s e m a-choice (ParserT l) (ParserT r) = ParserT $ \sOld ->-  l sOld >>= \(a, s') ->-  case a of-    (Good g) -> return (Good g, s')-    (Bad e) ->-      if noConsumed sOld s'-      then r sOld-      else return (Bad e, s')---- | Runs the parser given. If it succeeds, then returns the result of--- the parser. If it fails and consumes input, returns the result of--- the parser. If it fails without consuming any input, then changes--- the error using the function given.-(<?>) ::-  (Monad m)-  => ParserT s e m a-  -> e-  -> ParserT s e m a-(<?>) (ParserT l) e = ParserT $ \s ->-  l s >>= \(r, s') ->-  case r of-    (Good g) -> return (Good g, s')-    (Bad err) ->-      if noConsumed s s'-      then return (Bad e, s)-      else return (Bad err, s')--infix 0 <?>--increment :: ParseSt s -> ParseSt s-increment old = old { counter = succ . counter $ old }---- | 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; returns the short option parsed.-pendingShortOpt ::-  (Monad m, E.Error e)-  => ShortOpt-  -> ParserT s e m ShortOpt-pendingShortOpt so = ParserT $ \s ->-  let err saw = return (Bad (E.parseErr (E.ExpPendingShortOpt so) saw), s)-      gd (res, newSt) = return (Good res, newSt)-  in switch err gd $ do-    when (sawStopper s) $ S.throw E.SawAlreadyStopper-    (TextNonEmpty first rest) <--      maybe (S.throw E.SawNoPendingShorts) return (pendingShort s)-    when (unShortOpt so /= first)-      (S.throw $ E.SawWrongPendingShort first)-    return (so, increment s { pendingShort = toTextNonEmpty rest })---- | Parses only non-pending short options. Fails without consuming--- any input if, in order:------ * 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. Returns the short option--- parsed.-nonPendingShortOpt ::-  (E.Error e, Monad m)-  => ShortOpt-  -> ParserT s e m ShortOpt-nonPendingShortOpt so = ParserT $ \s ->-  let err saw =-        return (Bad (E.parseErr (E.ExpNonPendingShortOpt so) saw), s)-      gd (g, n) = return (Good g, n)-  in switch err gd $ do-    maybe (return ()) (S.throw . E.SawStillPendingShorts) (pendingShort s)-    when (sawStopper s) (S.throw E.SawAlreadyStopper)-    (a:as) <- case remaining s of-      [] -> S.throw E.SawNoArgsLeft-      x -> return x-    (maybeDash, word) <- case textHead a of-      Nothing -> S.throw E.SawEmptyArg-      (Just w) -> return w-    when (maybeDash /= '-') $ S.throw (E.SawNotShortArg a)-    (letter, arg) <- case textHead word of-      Nothing -> S.throw E.SawSingleDashArg-      (Just w) -> return w-    when (letter /= unShortOpt so) $ S.throw (E.SawWrongShortArg letter)-    when (letter == '-') $ S.throw E.SawNewStopper-    let s' = increment s { pendingShort = toTextNonEmpty arg-                         , remaining = as }-    return (so, s')---- | Parses an exact long option. That is, the text of the--- command-line option must exactly match the text of the--- option. Returns the option, and 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 ::-  (E.Error e, Monad m)-  => LongOpt-  -> ParserT s e m (LongOpt, Maybe Text)-exactLongOpt lo = ParserT $ \s ->-  let err saw = return (Bad (E.parseErr (E.ExpExactLong lo) saw), s)-      gd (g, n) = return (Good g, n)-  in switch err gd $ do-    maybe (return ()) (S.throw . E.SawStillPendingShorts) (pendingShort s)-    when (sawStopper s) (S.throw E.SawAlreadyStopper)-    (x:xs) <- case remaining s of-      [] -> S.throw E.SawNoArgsLeft-      ls -> return ls-    let (pre, word, afterEq) = splitLongWord x-    when (pre /= pack "--") $ S.throw (E.SawNotLongArg x)-    when (X.null word && isNothing afterEq) (S.throw E.SawNewStopper)-    when (word /= unLongOpt lo) $ S.throw (E.SawWrongLongArg word)-    let s' = increment s { remaining = xs }-    return ((lo, afterEq), s')---- | Takes a single Text 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 Text with everything after the--- equal sign if there is one.-splitLongWord :: Text -> (Text, Text, Maybe Text)-splitLongWord t = (f, s, r) where-  (f, rest) = X.splitAt 2 t-  (s, withEq) = X.break (== '=') rest-  r = case textHead withEq of-    Nothing -> Nothing-    (Just (_, afterEq)) -> Just afterEq---- | Examines the next word. If it matches a Text in the set--- unambiguously, returns a tuple of the word actually found and the--- matching word in the set.-approxLongOpt ::-  (E.Error e, Monad m)-  => Set LongOpt-  -> ParserT s e m (Text, LongOpt, Maybe Text)-approxLongOpt ts = ParserT $ \s ->-  let err saw = return (Bad (E.parseErr (E.ExpApproxLong ts) saw), s)-      gd (g, newSt) = return (Good g, newSt)-  in switch err gd $ do-    maybe (return ()) (S.throw . E.SawStillPendingShorts) (pendingShort s)-    (x:xs) <- case remaining s of-      [] -> S.throw E.SawNoArgsLeft-      r -> return r-    let (pre, word, afterEq) = splitLongWord x-    when (pre /= pack "--") (S.throw (E.SawNotLongArg x))-    when (X.null word && isNothing afterEq) (S.throw E.SawNewStopper)-    let p t = word `isPrefixOf` (unLongOpt t)-        matches = Set.filter p ts-    case Set.toList matches of-      [] -> S.throw (E.SawNoMatches word)-      (m:[]) -> let s' = increment s { remaining = xs }-                in return ((word, m, afterEq), s')-      _ -> S.throw (E.SawMultipleMatches matches word)---- | 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 text of the pending short option argument--- (this text cannot be empty).-pendingShortOptArg ::-  (E.Error e, Monad m)-  => ParserT s e m Text-pendingShortOptArg = ParserT $ \s ->-  let err saw = return (Bad (E.parseErr E.ExpPendingShortArg saw), s)-      gd (g, newSt) = return (Good g, newSt)-  in switch err gd $ do-    when (sawStopper s) (S.throw E.SawAlreadyStopper)-    let f (TextNonEmpty c t) = return (c `cons` t)-    a <- maybe (S.throw E.SawNoPendingShortArg) f (pendingShort s)-    let newSt = increment s { pendingShort = Nothing }-    return (a, newSt)---- | Parses a "stopper" - that is, a double dash. Changes the internal--- state of the parser to reflect that a stopper has been seen.-stopper ::-  (E.Error e, Monad m)-  => ParserT s e m ()-stopper = ParserT $ \s ->-  let err saw = return (Bad (E.parseErr E.ExpStopper saw), s)-      gd (g, newSt) = return (Good g, newSt)-  in switch err gd $ do-    maybe (return ()) (S.throw . E.SawStillPendingShorts) (pendingShort s)-    when (sawStopper s) $ S.throw E.SawAlreadyStopper-    (x:xs) <- case remaining s of-      [] -> S.throw E.SawNoArgsLeft-      r -> return r-    when (not $ pack "--" `isPrefixOf` x) (S.throw E.SawNotStopper)-    when (X.length x /= 2) (S.throw E.SawNotStopper)-    let s' = increment s { sawStopper = True-                         , remaining = xs }-    return ((), s')---- | try p behaves just like p, but if p fails, try p will not consume--- any input.-try :: Monad m => ParserT s e m a -> ParserT s e m a-try (ParserT l) = ParserT $ \s ->-  l s >>= \(r, s') ->-  case r of-    (Good g) -> return (Good g, s')-    (Bad e) -> return (Bad e, s)---- | Returns the next string on the command line as long as there are--- no pendings. 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.-nextArg ::-  (E.Error e, Monad m)-  => ParserT s e m Text-nextArg = ParserT $ \s ->-  let err saw = return (Bad (E.parseErr E.ExpNextArg saw), s)-      gd (g, newSt) = return (Good g, newSt)-  in switch err gd $ do-    maybe (return ()) (S.throw . E.SawStillPendingShorts) (pendingShort s)-    (x:xs) <- case remaining s of-      [] -> S.throw E.SawNoArgsLeft-      r -> return r-    let newSt = increment s { remaining = xs }-    return (x, newSt)---- | Returns the next string on the command line as long as there are--- no pendings and as long as the next string does not begin with a--- dash. If there has already been a stopper, then will return the--- next string even if it starts with a dash.-nonOptionPosArg ::-  (E.Error e, Monad m)-  => ParserT s e m Text-nonOptionPosArg = ParserT $ \s ->-  let err saw = return (Bad (E.parseErr E.ExpNonOptionPosArg saw), s)-      gd (g, newSt) = return (Good g, newSt)-  in switch err gd $ do-    maybe (return ()) (S.throw . E.SawStillPendingShorts) (pendingShort s)-    (x:xs) <- case remaining s of-      [] -> S.throw E.SawNoArgsLeft-      r -> return r-    result <- if sawStopper s-              then return x-              else case textHead x of-                Just ('-', _) -> S.throw $ E.SawLeadingDashArg x-                _ -> return x-    let newSt = increment s { remaining = xs }-    return (result, newSt)---- | manyTill p e runs parser p repeatedly until parser e succeeds.------ More precisely, first it runs parser e. If parser e succeeds, then--- manyTill returns the result of all the preceding successful parses--- of p. If parser e fails (it does not matter whether e consumed any--- input or not), manyTill runs parser p again. What happens next--- depends on whether p succeeded or failed. If p succeeded, then the--- loop starts over by running parser e again. If p failed (it does--- not matter whether it consumed any input or not), then manyTill--- fails. The state of the parser is updated to reflect its state--- after the failed run of p, and the parser is left in a failed--- state.------ Should parser e succeed (as it will on a successful application of--- manyTill), then the parser state will reflect that parser e--- succeeded--that is, if parser e consumes input, that input will be--- consumed in the parser that is returned. Wrap e inside of--- @lookAhead@ if that is undesirable.------ Be particularly careful to get the order of the arguments--- correct. Applying this function to reversed arguments will yield--- bugs that are very difficult to diagnose.-manyTill ::-  Monad m-  => ParserT s e m a-  -> ParserT s e m end-  -> ParserT s e m [a]-manyTill (ParserT r) (ParserT f) = ParserT $ \s ->-  parseTill s r f >>= \till ->-  case lastFailure till of-    Nothing -> return (Good (goods till), lastSt till)-    (Just e) -> return (Bad e, lastSt till)--data Till s e a =-  Till { goods :: [a]-       , lastSt :: ParseSt s-       , lastFailure :: Maybe e }--parseTill ::-  (Monad m)-  => ParseSt s-  -> (ParseSt s -> m (Result e a, ParseSt s))-  -> (ParseSt s -> m (Result e b, ParseSt s))-  -> m (Till s e a)-parseTill s fr ff = ff s >>= \r ->-  case r of-    (Good _, s') -> return $ Till [] s' Nothing-    (Bad _, _) ->-      fr s >>= \r' ->-      case r' of-        (Bad e, s') -> return $ Till [] s' (Just e)-        (Good g, s') ->-          parseTill s' fr ff >>= \r'' ->-          let (Till gs lS lF) = r''-          in if counter s' == counter s-             then error "parseTill applied to parser that takes empty list"-             else return $ Till (g:gs) lS lF---- | several p runs parser p zero or more times and returns all the--- results. This proceeds like this: parser p is run and, if it--- succeeds, the result is saved and parser p is run--- again. Repeat. Eventually this will have to fail. If the last run--- of parser p fails without consuming any input, then several p runs--- successfully. The state of the parser is updated to reflect the--- successful runs of p. If the last run of parser p fails but it--- consumed input, then several p fails. The state of the parser is--- updated to reflect the state up to and including the run that--- partially consumed input. The parser is left in a failed state.------ This semantic can come in handy. For example you might run a parser--- multiple times that parses an option and arguments to the--- option. If the arguments fail to parse, then several will fail.-several ::-  (Monad m)-  => ParserT s e m a-  -> ParserT s e m [a]-several (ParserT l) = ParserT $ \s ->-  parseRepeat s l >>= \r ->-  let (result, finalGoodSt, failure, finalBadSt) = r-  in if noConsumed finalGoodSt finalBadSt-     then return (Good result, finalGoodSt)-     else return (Bad failure, finalBadSt)--parseRepeat ::-  (Monad m)-  => ParseSt s-  -> (ParseSt s -> m (Result e a, ParseSt s))-  -> m ([a], ParseSt s, e, ParseSt s)-parseRepeat st1 f = f st1 >>= \r ->-  case r of-    (Good a, st') ->-      if noConsumed st1 st'-      then error "parseRepeat applied to parser that takes empty list"-      else parseRepeat st' f >>= \r' ->-      let (ls, finalGoodSt, failure, finalBadSt) = r'-      in return (a : ls, finalGoodSt, failure, finalBadSt)-    (Bad e, st') -> return ([], st1, e, st')---- | Succeeds if there is no more input left.-end ::-  (E.Error e, Monad m)-  => ParserT s e m ()-end = ParserT $ \s ->-  let err saw = return (Bad (E.parseErr E.ExpEnd saw), s)-      gd (g, newSt) = return (Good g, newSt)-  in switch err gd $ do-    maybe (return ()) (S.throw . E.SawStillPendingShorts) (pendingShort s)-    when (not . null . remaining $ s) (S.throw E.SawMoreInput)-    return ((), s)---- | Gets the user state.-get ::-  (Monad m)-  => ParserT s e m s-get = ParserT $ \s ->-  return (Good (userState s), s)---- | Puts a new user state.-put ::-  (Monad m)-  => s-  -> ParserT s e m ()-put newUserSt = ParserT $ \s ->-  return (Good (), s { userState = newUserSt })---- | Modify the user state.-modify ::-  (Monad m)-  => (s -> s)-  -> ParserT s e m ()-modify f = ParserT $ \s ->-  return (Good (), s { userState = f (userState s) })

@@ -1,24 +0,0 @@-module System.Console.MultiArg.QuickCheckHelpers where--import Test.QuickCheck ( Arbitrary ( arbitrary ),-                         Gen,-                         CoArbitrary ( coarbitrary ),-                         coarbitraryShow )-import Data.Text ( Text, pack )-import qualified Data.Set as Set-import Control.Monad ( liftM )--randText :: Gen Text-randText = liftM pack arbitrary--randSet :: (Ord a, Arbitrary a) => Gen (Set.Set a)-randSet = liftM Set.fromList arbitrary--newtype WText = WText { unWText :: Text }-                deriving Show--instance Arbitrary WText where-  arbitrary = liftM WText randText--instance CoArbitrary WText where-  coarbitrary (WText a) gc = coarbitraryShow a gc

@@ -1,30 +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, there is a @sample.hs@ file in the--- @binaries@ directory of the multiarg archive that you can compile.-module System.Console.MultiArg.SampleParser where--import System.Console.MultiArg--specs :: [OptSpec]--specs = [ OptSpec "bytes"               "c" []          oneArg-        , OptSpec "follow"              "f" []          optionalArg-        , OptSpec "follow-retry"        "F" []          noArg-        , OptSpec "lines"               "n" []          oneArg-        , OptSpec "max-unchanged-stats" ""  []          oneArg-        , OptSpec "pid"                 ""  []          oneArg-        , OptSpec "quiet"               "q" ["silent"]  noArg-        , OptSpec "sleep-interval"      "s" []          oneArg-        , OptSpec "verbose"             "v" []          noArg-        , OptSpec "help"                ""  []          noArg-        , OptSpec "version"             ""  []          noArg-        ]--sampleMain :: IO ()-sampleMain = do-  as <- getArgs-  let r = parse Intersperse specs as-  print r

@@ -1,255 +0,0 @@--- | 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'.-module System.Console.MultiArg.SimpleParser (-  OptSpec(..),-  Intersperse(..),-  Result(..),-  Args(..),-  noArg,-  optionalArg,-  oneArg,-  twoArg,-  variableArg,-  SimpleError,-  getArgs,-  System.Console.MultiArg.SimpleParser.parse ) where--import System.Console.MultiArg.Prim (-  Parser, manyTill, lookAhead, nextArg, nonOptionPosArg,-  end, (<?>), stopper, nonOptionPosArg, try )-import qualified System.Console.MultiArg.Prim as Prim-import System.Console.MultiArg.Combinator (-  mixedNoArg, mixedOptionalArg, mixedOneArg, mixedTwoArg,-  mixedVariableArg )-import System.Console.MultiArg.Option (-  makeLongOpt, makeShortOpt )-import Control.Monad.Exception.Synchronous ( toEither )-import System.Console.MultiArg.Error ( SimpleError )-import Data.Text ( pack, unpack )-import System.Environment ( getArgs )-import Data.Monoid ( mconcat )-import Control.Applicative ( many, (<|>) )---- | Specifies each option that your program accepts.-data OptSpec = OptSpec {-  longOpt :: String-  -- ^ Each option must have at least one long option, which you-  -- specify here. Your program's users specify long options by-  -- preceding them with two dashes, such as @--verbose@. When writing-  -- your code you omit the dashes, so you would specify @verbose@-  -- here; including the dashes in your code results in a runtime-  -- error.--  , shortOpts :: [Char]-    -- ^ Additional, synonymous short options may be specified-    -- here. For instance if you want your users to be able to specify-    -- @-v@ in addition to @--verbose@, include @v@ in this list.-    -  , longOpts :: [String]-    -- ^ Additional synonymous long options may be specified here. For-    -- instance, if you specified @quiet@ for @longOpt@, you might-    -- want to include @silent@ in this list.--  , argSpec :: Args-    -- ^ Specifies what arguments, if any, this option takes.-  }-             deriving Show---- | This datatype does dual duty. When part of an 'OptSpec', you use--- it to specify how many arguments, if any, an option takes. When you--- use it for this purpose, it only matters which data constructor you--- use; the fields can be any value, even 'undefined'.------ When part of a Result, 'Args' indicates what arguments the user--- supplied to the option.-data Args =-  NoArg-  -- ^ This option takes no arguments-          -  | OptionalArg  { oArg :: Maybe String }--    -- ^ 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       { sArg1 :: String }-    -- ^ 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       { tArg1 :: String-                 , tArg2 :: String }-    -- ^ This option takes two arguments. Parsed similarly to 'OneArg'.-    -  | VariableArg { vArgs :: [String] }-    -- ^ 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.-    -  deriving Show---- | Specify that this option takes no arguments.-noArg :: Args-noArg = NoArg---- | Specify that this option takes an optional argument.-optionalArg :: Args-optionalArg = OptionalArg Nothing---- | Specify that this option takes one argument.-oneArg :: Args-oneArg = OneArg ""---- | Specify that this option takes two arguments.-twoArg :: Args-twoArg = TwoArg "" ""---- | Specify that this option takes a variable number of arguments.-variableArg :: Args-variableArg = VariableArg []---- | Holds the result of command line parsing. Each option (along with--- its option arguments) or positional argument is assigned to its own--- Result.-data Result =-  PosArg   { posArg :: String }-  | Stopper-  | Option {-    label :: String-    -- ^ Each option must have at least one long option. So that you-    -- can distinguish one option from another, the name of that long-    -- option is returned here.-    , args :: Args }-              deriving Show---- | 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. -parse ::-  Intersperse-  -> [OptSpec]-  -> [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.--  -> Either SimpleError [Result]-parse i os ss = toEither $ Prim.parse (map pack ss) (f os) where-  f = case i of Intersperse -> parseIntersperse-                StopOptions -> parseNoIntersperse--parseNoIntersperse :: [OptSpec] -> Parser [Result]-parseNoIntersperse os = do-  let opts = mconcat . map optSpec $ os-  rs <- manyTill opts (try $ lookAhead afterArgs)-  firstArg <- afterArgs-  case firstArg of-    EndOfInput -> return rs-    (FirstArg s) -> do-      as <- noIntersperseArgs-      let first = PosArg s-      return $ rs ++ ( first : as )-    AAStopper -> do-      as <- noIntersperseArgs-      let first = Stopper-      return $ rs ++ ( first : as )--noIntersperseArgs :: Parser [Result]-noIntersperseArgs = do-  as <- many nextArg-  let r = map PosArg . map unpack $ as-  return r--data AfterArgs = EndOfInput | FirstArg String | AAStopper--afterArgs :: Parser AfterArgs-afterArgs = parseFirst <|> parseEnd <|> parseStopper where-  parseFirst = do-    a <- nonOptionPosArg-    let aS = unpack a-    return $ FirstArg aS-  parseEnd = do-    end-    return EndOfInput-  parseStopper = do-    _ <- stopperParser-    return AAStopper--parseIntersperse :: [OptSpec] -> Parser [Result]-parseIntersperse os = do-  let optsAndStopper = foldl1 (<|>) $ optSpecs ++ rest-      rest = [stopperParser, posArgParser]-      optSpecs = map optSpec os-  rs <- manyTill optsAndStopper end-  end <?> error "the end parser should always succeed"-  return rs--stopperParser :: Parser Result-stopperParser = stopper >> return Stopper--posArgParser :: Parser Result-posArgParser = do-  a <- nonOptionPosArg-  return $ PosArg (unpack a)--optSpec :: OptSpec -> Parser Result-optSpec o = let-  lo = makeLongOpt . pack . longOpt $ o-  ss = map makeShortOpt . shortOpts $ o-  ls = map makeLongOpt . map pack . longOpts $ o-  opt = return . Option (longOpt o)-  in case argSpec o of-    NoArg -> do-      _ <- mixedNoArg lo ls ss-      opt NoArg-    (OptionalArg {}) -> do-      (_, a) <- mixedOptionalArg lo ls ss-      opt (OptionalArg . fmap unpack $ a)-    (OneArg {}) -> do-      (_, a) <- mixedOneArg lo ls ss-      opt (OneArg . unpack $ a)-    (TwoArg {}) -> do-      (_, a1, a2) <- mixedTwoArg lo ls ss-      opt (TwoArg (unpack a1) (unpack a2))-    (VariableArg {}) -> do-      (_, as) <- mixedVariableArg lo ls ss-      opt (VariableArg . map unpack $ as)-

@@ -1,23 +0,0 @@-module System.Console.MultiArg.TextNonEmpty where--import Test.QuickCheck-  ( Arbitrary ( arbitrary ), CoArbitrary ( coarbitrary ),-    (><) )-import System.Console.MultiArg.QuickCheckHelpers -  ( randText, WText(WText) )-                                                   -import Data.Text ( Text )--data TextNonEmpty = TextNonEmpty Char Text-                    deriving (Show, Eq)--instance Arbitrary TextNonEmpty where-  arbitrary = do-    c <- arbitrary-    t <- randText-    return $ TextNonEmpty c t--instance CoArbitrary TextNonEmpty where-  coarbitrary (TextNonEmpty c t)  = vc >< vt where-    vc = coarbitrary c-    vt = coarbitrary (WText t)

@@ -1,4 +0,0 @@-import System.Console.MultiArg.SampleParser--main :: IO ()-main = sampleMain

@@ -0,0 +1,4 @@+import System.Console.MultiArg.SampleParser++main :: IO ()+main = sampleMain

@@ -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.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. For+  -- maximum flexibility you will want to start with the+  -- "System.Console.MultiArg.Prim" module.+  --+  -- Using the parsers and combinators in+  -- "System.Console.MultiArg.Prim", 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. You can also easily parse command lines for programs+  -- that have multiple \"modes\", like @git@ or @darcs@. If you're+  -- doing this, of course first start by reading the documentation+  -- for "System.Console.MultiArg.Prim" and+  -- "System.Console.MultiArg.Combinator". You will also want to look+  -- at 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.+  --+  -- Internally the combinators in "System.Console.MultiArg.Prim" use+  -- strict "Data.Text" values rather than "String"s. That is because+  -- this library was built for an application that sometimes parses an+  -- enormous amount of command line data, and I thought that using+  -- Data.Text would yield some memory savings while retaining Unicode+  -- safety. Though I cannot remember whether this actually yielded any+  -- space savings (it did not lead to more space usage, at least) it+  -- also made the parser consistent with the rest of that program,+  -- which also uses Data.Text. I have considered making this library+  -- use either Data.Text or Strings but that makes it a lot more+  -- complicated for little gain. The SimpleParser module, however,+  -- wraps the "Data.Text" values up and exposes only Strings in the+  -- interface, keeping things nice and simple. This does mean that+  -- Strings have to be converted to Data.Text and back again, but the+  -- performance hit will not be significant unless you are parsing an+  -- obscene amount of data--and if you're doing that, you might want to+  -- use Data.Text anyway :)++  module System.Console.MultiArg.SimpleParser ) where++import System.Console.MultiArg.SimpleParser

@@ -0,0 +1,364 @@+-- | 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+  option,+  optionMaybe,+  notFollowedBy,+  +  -- * Short options+  shortNoArg,+  shortOptionalArg,+  shortOneArg,+  shortTwoArg,+  shortVariableArg,++  -- * Long options+  nonGNUexactLongOpt,+  matchApproxLongOpt,+  matchNonGNUApproxLongOpt,+  longNoArg,+  longOptionalArg,+  longOneArg,+  longTwoArg,+  longVariableArg,+  +  -- * Mixed options+  mixedNoArg,+  mixedOptionalArg,+  mixedOneArg,+  mixedTwoArg,+  mixedVariableArg,+  +  -- * Other words+  matchApproxWord ) where+  +import Data.Text ( Text, isPrefixOf )+import Data.Set ( Set )+import qualified Data.Set as Set+import Control.Monad ( liftM )++import System.Console.MultiArg.Prim+  ( ParserT, throw, try, approxLongOpt,+    nextArg, pendingShortOptArg, nonOptionPosArg,+    pendingShortOpt, nonPendingShortOpt,+    exactLongOpt, nextArg, (<?>))+import System.Console.MultiArg.Option+  ( LongOpt, ShortOpt )+import qualified System.Console.MultiArg.Error as E+import System.Console.MultiArg.Error+  ( Error, parseErr )+import Control.Applicative ((<|>), many)+import Control.Monad ( void )+import Data.Monoid ( mconcat )++-- | @option x p@ runs parser p. If p fails without consuming any+-- input, returns x. Otherwise, returns p.+option :: (Error e, Monad m) =>+          a+          -> ParserT s e m a+          -> ParserT s e m a+option x p = p <|> return x++-- | @optionMaybe p@ runs parser p. If p fails without returning any+-- input, returns Nothing. If p succeeds, returns the result of p+-- wrapped in a Just. If p fails but consumes input, optionMaybe+-- fails.+optionMaybe :: (Error e, Monad m)+               => ParserT s e m a+               -> ParserT s e m (Maybe a)+optionMaybe p = option Nothing (liftM Just p)++-- | @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 :: (Error e, Monad m)+                 => ParserT s e m a+                 -> ParserT s e m ()+notFollowedBy p =+  void $ ((try p >> throw (E.parseErr E.ExpNotFollowedBy E.SawFollowedBy))+          <|> return ())+++-- | Parses only a non-GNU style long option (that is, one that does+-- not take option arguments by attaching them with an equal sign,+-- such as @--lines=20@).+nonGNUexactLongOpt :: (Error e, Monad m)+                      => LongOpt+                      -> ParserT s e m LongOpt+nonGNUexactLongOpt l = try $ do+  (lo, maybeArg) <- exactLongOpt l+  case maybeArg of+    Nothing -> return lo+    (Just t) ->+      throw (parseErr (E.ExpNonGNUExactLong l)+            (E.SawGNULongOptArg t))++-- | Takes a long option and a set of long options. If the next word+-- on the command line unambiguously starts with the name of the long+-- option given, returns the actual text found on the command line,+-- the long option, and the text of any GNU-style option+-- argument. Make sure that the long option you are looking for is+-- both the first argument and that it is included in the set;+-- otherwise this parser will always fail.+matchApproxLongOpt :: (Error e, Monad m)+                      => LongOpt+                      -> Set LongOpt+                      -> ParserT s e m (Text, LongOpt, Maybe Text)+matchApproxLongOpt l s = try $ do+  a@(t, lo, _) <- approxLongOpt s+  if lo == l+    then return a+    else throw (parseErr (E.ExpMatchingApproxLong l s)+               (E.SawNotMatchingApproxLong t lo))++-- | Like matchApproxLongOpt but only parses non-GNU-style long+-- options.+matchNonGNUApproxLongOpt :: (Error e, Monad m)+                            => LongOpt+                            -> Set LongOpt+                            -> ParserT s e m (Text, LongOpt)+matchNonGNUApproxLongOpt l s = try $ do+  (t, lo, arg) <- matchApproxLongOpt l s+  let err b = throw (parseErr (E.ExpNonGNUMatchingApproxLong l s)+                    (E.SawMatchingApproxLongWithArg b))+  maybe (return (t, lo)) err arg++-- | 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.+matchApproxWord :: (Error e, Monad m)+                   => Set Text+                   -> ParserT s e m (Text, Text)+matchApproxWord s = try $ do+  a <- nextArg+  let p t = a `isPrefixOf` t+      matches = Set.filter p s+      err saw = throw (parseErr (E.ExpApproxWord s) saw)+  case Set.toList matches of+    [] -> err (E.SawNoMatches a)+    (x:[]) -> return (a, x)+    _ -> err (E.SawMultipleApproxMatches matches a)++-- | Parses short options that do not take any argument. (It is+-- however okay for the short option to be combined with other short+-- options in the same word.)+shortNoArg :: (Error e, Monad m)+            => ShortOpt+            -> ParserT s e m ShortOpt+shortNoArg s = pendingShortOpt s <|> nonPendingShortOpt s++-- | Parses short options that take an optional argument. The argument+-- can be combined in the same word with the short option (@-c42@) or+-- can be in the ext word (@-c 42@).+shortOptionalArg :: (Error e, Monad m)+                 => ShortOpt+                 -> ParserT s e m (ShortOpt, Maybe Text)+shortOptionalArg s = do+  so <- shortNoArg s+  a <- optionMaybe (pendingShortOptArg <|> nonOptionPosArg)+  return (so, a)++-- | Parses short options that take a required argument.  The argument+-- can be combined in the same word with the short option (@-c42@) or+-- can be in the ext word (@-c 42@).+shortOneArg :: (Error e, Monad m) =>+               ShortOpt+               -> ParserT s e m (ShortOpt, Text)+shortOneArg s = do+  so <- shortNoArg s+  a <- pendingShortOptArg <|> nextArg+  return (so, a)++-- | Parses short options that take two required arguments. The first+-- argument can be combined in the same word with the short option+-- (@-c42@) or can be in the ext word (@-c 42@). The next argument+-- will have to be in a separate word.+shortTwoArg :: (Error e, Monad m)+               => ShortOpt+               -> ParserT s e m (ShortOpt, Text, Text)+shortTwoArg s = do+  (so, a1) <- shortOneArg s+  a2 <- nextArg+  return (so, a1, a2)++-- | Parses short options that take a variable number of+-- arguments. This will keep on parsing option arguments until it+-- encounters one that does not "look like" an option--that is, until+-- it encounters one that begins with a dash. Therefore, the only way+-- to terminate a variable argument option if it is the last option is+-- with a stopper. The first argument can be combined in the same word+-- with the short option (@-c42@) or can be in the ext word (@-c+-- 42@). Subsequent arguments will have to be in separate words.+shortVariableArg :: (Error e, Monad m)+                 => ShortOpt+                 -> ParserT s e m (ShortOpt, [Text])+shortVariableArg s = do+  so <- shortNoArg s+  firstArg <- optionMaybe pendingShortOptArg+  rest <- many nonOptionPosArg+  let result = maybe rest ( : rest ) firstArg+  return (so, result)++-- | Parses long options that do not take any argument.+longNoArg :: (Error e, Monad m)+           => LongOpt+           -> ParserT s e m LongOpt+longNoArg = nonGNUexactLongOpt++-- | Parses long options that take a single, optional argument. The+-- single argument can be given GNU-style (@--lines=20@) or non-GNU+-- style in separate words (@lines 20@).+longOptionalArg :: (Error e, Monad m)+                   => LongOpt+                   -> ParserT s e m (LongOpt, Maybe Text)+longOptionalArg = exactLongOpt++-- | Parses long options that take a single, required argument. The+-- single argument can be given GNU-style (@--lines=20@) or non-GNU+-- style in separate words (@lines 20@).+longOneArg :: (Error e, Monad m)+                 => LongOpt+                 -> ParserT s e m (LongOpt, Text)+longOneArg l = do+  (lo, mt) <- longOptionalArg l+  case mt of+    (Just t) -> return (lo, t)+    Nothing -> do+      a <- nextArg <?> E.parseErr E.ExpLongOptArg E.SawNoArgsLeft+      return (l, a)++-- | Parses long options that take a double, required argument. The+-- first argument can be given GNU-style (@--lines=20@) or non-GNU+-- style in separate words (@lines 20@). The second argument will have+-- to be in a separate word.+longTwoArg :: (Error e, Monad m)+                 => LongOpt+                 -> ParserT s e m (LongOpt, Text, Text)+longTwoArg l = do+  (lo, mt) <- longOptionalArg l+  case mt of+    (Just t) -> do+      a2 <- nextArg+      return (lo, t, a2)+    Nothing -> do+      a1 <- nextArg+      a2 <- nextArg+      return (lo, a1, a2)++-- | Parses long options that take a variable number of+-- arguments. This will keep on parsing option arguments until it+-- encounters one that does not "look like" an option--that is, until+-- it encounters one that begins with a dash. Therefore, the only way+-- to terminate a variable argument option if it is the last option is+-- with a stopper. The first argument can be combined in the same word+-- with the short option (@--lines=20@) or can be in the ext word+-- (@--lines 42@). Subsequent arguments will have to be in separate+-- words.+longVariableArg :: (Error e, Monad m)+                   => LongOpt+                   -> ParserT s e m (LongOpt, [Text])+longVariableArg l = do+  (lo, mt) <- longOptionalArg l+  rest <- many nonOptionPosArg+  return (lo, maybe rest (:rest) mt)++-- | Parses at least one long option and a variable number of short+-- and long options that take no arguments.+mixedNoArg :: (Error e, Monad m)+              => LongOpt+              -> [LongOpt]+              -> [ShortOpt]+              -> ParserT s e m (Either ShortOpt LongOpt)+mixedNoArg l ls ss = mconcat ([f] ++ longs ++ shorts) where+  toLong lo = do+    r <- longNoArg lo+    return $ Right r+  toShort so = do+    s <- shortNoArg so+    return $ Left s+  f = toLong l+  longs = map toLong ls+  shorts = map toShort ss++-- | Parses at least one long option and a variable number of short+-- and long options that take an optional argument.+mixedOptionalArg ::+  (Error e, Monad m)+  => LongOpt+  -> [LongOpt]+  -> [ShortOpt]+  -> ParserT s e m ((Either ShortOpt LongOpt), Maybe Text)+mixedOptionalArg l ls ss = mconcat ([f] ++ longs ++ shorts) where+  toLong lo = do+    (o, a) <- longOptionalArg lo+    return $ (Right o, a)+  toShort so = do+    (o, a) <- shortOptionalArg so+    return $ (Left o, a)+  f = toLong l+  longs = map toLong ls+  shorts = map toShort ss++-- | Parses at least one long option and additional long and short+-- options that take one argument.+mixedOneArg ::+  (Error e, Monad m)+  => LongOpt+  -> [LongOpt]+  -> [ShortOpt]+  -> ParserT s e m ((Either ShortOpt LongOpt), Text)+mixedOneArg l ls ss = mconcat ([f] ++ longs ++ shorts) where+  toLong lo = do+    (o, a) <- longOneArg lo+    return (Right o, a)+  toShort lo = do+    (o, a) <- shortOneArg lo+    return (Left o, a)+  f = toLong l+  longs = map toLong ls+  shorts = map toShort ss++-- | Parses at least one long option and additonal long and short+-- options that take two arguments.+mixedTwoArg ::+  (Error e, Monad m)+  => LongOpt+  -> [LongOpt]+  -> [ShortOpt]+  -> ParserT s e m ((Either ShortOpt LongOpt), Text, Text)+mixedTwoArg l ls ss = mconcat ([f] ++ longs ++ shorts) where+  toLong lo = do+    (o, a1, a2) <- longTwoArg lo+    return (Right o, a1, a2)+  toShort lo = do+    (o, a1, a2) <- shortTwoArg lo+    return (Left o, a1, a2)+  f = toLong l+  longs = map toLong ls+  shorts = map toShort ss++-- | Parses at least one long option and additional long and short+-- options that take a variable number of arguments.+mixedVariableArg ::+  (Error e, Monad m)+  => LongOpt+  -> [LongOpt]+  -> [ShortOpt]+  -> ParserT s e m ((Either ShortOpt LongOpt), [Text])+mixedVariableArg l ls ss = mconcat ([f] ++ longs ++ shorts) where+  toLong lo = do+    (o, a) <- longVariableArg lo+    return (Right o, a)+  toShort lo = do+    (o, a) <- shortVariableArg lo+    return (Left o, a)+  f = toLong l+  longs = map toLong ls+  shorts = map toShort ss+

@@ -0,0 +1,215 @@+-- | Errors. Parsing a command line when a user has entered it+-- correctly is easy; doing something sensible when an incorrect line+-- has been entered is a bit more difficult. This module exports an+-- 'Error' typeclass, which you can declare instances of in order to+-- have your own type to represent errors. Or you can use+-- 'SimpleError', which is already an instance of 'Error'.+module System.Console.MultiArg.Error where++import System.Console.MultiArg.Option+  ( LongOpt, ShortOpt, unLongOpt, unShortOpt )+import System.Console.MultiArg.TextNonEmpty+  ( TextNonEmpty ( TextNonEmpty ) )+import Data.Text ( Text, pack, append, singleton, intercalate,+                   snoc )+import Data.Set ( Set )+import qualified Data.Set as Set++-- | Instances of this typeclass represent multiarg errors. You can+-- declare instances of this typeclass so that you can use your own+-- type for errors. This makes multiarg easy to integrate into your+-- own programs. Then you can also easily add other errors, which you+-- can report from the parsers you build by calling+-- 'System.Console.MultiArg.Prim.throw'.+class Error e where+  -- | Store an error in your Error instance.+  parseErr :: Expecting -> Saw -> e++instance Error Text where+  parseErr e s =+    pack "command line parser error.\n"+    `append` pack "expecting: " `append` printExpecting e+    `snoc` '\n'+    `append` pack "saw: " `append` printSaw s+    `snoc` '\n'++-- | A simple type that is already an instance of 'Error'.+data SimpleError = SimpleError Expecting Saw deriving (Show, Eq)++-- | Generates error messages.+printError :: SimpleError -> Text+printError (SimpleError e s) =+  pack "Error parsing command line input.\n"+  `append` pack "expected to see: "+  `append` printExpecting e `snoc` '\n'+  `append` pack "actually saw: "+  `append` printSaw s `snoc` '\n'++instance Error SimpleError where+  parseErr = SimpleError++-- | Each error consists of two parts: what the parser was expecting+-- to see, and what it actually saw. This type holds what the parser+-- expected to see. If you just want to give some text to be used in+-- an error message, use 'ExpTextError'. To generate a generic error,+-- use 'ExpOtherFailure'.+data Expecting = ExpPendingShortOpt ShortOpt+               | ExpExactLong LongOpt+               | ExpApproxLong (Set LongOpt)+               | ExpLongOptArg+               | ExpPendingShortArg+               | ExpStopper+               | ExpNextArg+               | ExpNonOptionPosArg+               | ExpEnd+               | ExpNonGNUExactLong LongOpt+               | ExpMatchingApproxLong LongOpt (Set LongOpt)+               | ExpNonGNUMatchingApproxLong LongOpt (Set LongOpt)+               | ExpApproxWord (Set Text)+               | ExpOptionOrPosArg+               | ExpTextError Text+               | ExpNonPendingShortOpt ShortOpt+               | ExpNotFollowedBy+               | ExpOtherFailure+               deriving (Show, Eq)++-- | Generates an error message from an Expecting.+printExpecting :: Expecting -> Text+printExpecting e = case e of+  (ExpPendingShortOpt s) ->+    (pack "short option: ") `append` (singleton . unShortOpt $ s)+  (ExpExactLong l) ->+    (pack "long option: ") `append` (unLongOpt $ l)+  (ExpApproxLong ls) ->+    (pack "approximate long option matching one of: ") `append`+    intercalate (pack ", ") (map unLongOpt . Set.toList $ ls)+  ExpLongOptArg -> pack "argument to long option"+  ExpPendingShortArg -> pack "argument to short option"+  ExpStopper -> pack "stopper (\"--\")"+  ExpNextArg -> pack "next word on command line"+  ExpNonOptionPosArg ->+    pack "word on command line not starting with a hyphen"+  ExpEnd -> pack "end of command line input"+  (ExpNonGNUExactLong lo) ->+    pack "long option without an included argument: "+    `append` (unLongOpt lo)+  (ExpMatchingApproxLong l ls) ->+    pack "abbreviated long option named: " `append` (unLongOpt l)+    `append` pack "from possible abbreviated long options named: "+    `append` (intercalate (pack ", ")+              (map unLongOpt . Set.toList $ ls))+  (ExpNonGNUMatchingApproxLong l ls) ->+    pack "abbreviated long without an included argument named: "+    `append` (unLongOpt l)+    `append` pack "from possible abbreviated long options named: "+    `append` (intercalate (pack ", ")+              (map unLongOpt . Set.toList $ ls))+  (ExpApproxWord ws) ->+    pack "one of these abbreviated words: "+    `append` (intercalate (pack ", ") (Set.toList $ ws))+  ExpOptionOrPosArg ->+    pack "option or positional argument"+  (ExpTextError t) -> t+  (ExpNonPendingShortOpt s) ->+    (pack "short option: ") `append` (singleton . unShortOpt $ s)+  ExpNotFollowedBy ->+    pack "not followed by"+  (ExpOtherFailure) -> pack "general failure"++++-- | What the parser actually saw. To give some text to be used in the+-- error message, use 'SawTextError'. To generate a generic error, use+-- 'SawOtherFailure'.+data Saw = SawNoPendingShorts+         | SawWrongPendingShort Char+         | SawNoArgsLeft+         | SawEmptyArg+         | SawSingleDashArg+         | SawStillPendingShorts TextNonEmpty+         | SawNotShortArg Text+         | SawWrongShortArg Char+         | SawNotLongArg Text+         | SawWrongLongArg Text+         | SawNoMatches Text+         | SawMultipleMatches (Set LongOpt) Text+         | SawNoPendingShortArg+         | SawAlreadyStopper+         | SawNewStopper+         | SawNotStopper+         | SawLeadingDashArg Text+         | SawMoreInput+         | SawGNULongOptArg Text+         | SawNotMatchingApproxLong Text LongOpt+         | SawMatchingApproxLongWithArg Text -- Text of the argument+         | SawMultipleApproxMatches (Set Text) Text+         | SawNoOption+         | SawNoOptionOrPosArg+         | SawTextError Text+         | SawFollowedBy+         | SawOtherFailure+         deriving (Show, Eq)++-- | Generates error messages from a 'Saw'.+printSaw :: Saw -> Text+printSaw s = case s of+  SawNoPendingShorts -> pack "no pending short options"+  (SawWrongPendingShort c) ->+    pack "unexpected short option: " `snoc` c+  SawNoArgsLeft -> pack "no command line words remaining"+  SawEmptyArg -> pack "command line word that is the empty string"+  SawSingleDashArg ->+    pack "command line word that is a single hyphen (\"-\")"+  (SawStillPendingShorts (TextNonEmpty first rest)) ->+    pack "pending short options: " `snoc` first+    `append` rest+  (SawNotShortArg t) ->+    pack "word that is not a short option: " `append` t+  (SawWrongShortArg c) ->+    pack "wrong short option: " `snoc` c+  (SawNotLongArg t) ->+    pack "word that is not a long option: " `append` t+  (SawWrongLongArg t) ->+    pack "wrong long option: " `append` t+  (SawNoMatches t) ->+    pack "word that does not match the available choices: "+    `append` t+  (SawMultipleMatches ss t) ->+    pack "word matches more than one of the available choices. "+    `append` pack "word given: " `append` t+    `append` pack " matches these words: "+    `append` (intercalate (pack ", ") (map unLongOpt . Set.toList $ ss))+  SawNoPendingShortArg -> pack "no short argument"+  SawAlreadyStopper ->+    pack "already seen a stopper (\"--\")"+  SawNewStopper ->+    pack "new stopper (\"--\")"+  SawNotStopper ->+    pack "word that is not a stopper (\"--\")"+  (SawLeadingDashArg t) ->+    pack "word with a leading hyphen: " `append` t+  SawMoreInput ->+    pack "additional words remaining on command line"+  (SawGNULongOptArg t) ->+    pack "attached argument for option that does not take one: "+    `append` t+  (SawNotMatchingApproxLong t lo) ->+    pack "long argument that does not match expected one. "+    `append` pack "argument given: " `append` t+    `append` pack "argument expected: " `append` unLongOpt lo+  (SawMatchingApproxLongWithArg t) ->+    pack "long argument that matches expected long argument, but it "+    `append` pack "has an attached argument. Text of argument: "+    `append` t+  (SawMultipleApproxMatches ms m) ->+    pack "multiple words match the one given. Word given: " `append` m+    `append` pack "possible matches: "+    `append` (intercalate (pack ", ") (Set.toList ms))+  SawNoOption ->+    pack "word that is not an option"+  SawNoOptionOrPosArg ->+    pack "not an option or positional argument"+  (SawTextError t) -> t+  SawFollowedBy -> pack "followed by"+  (SawOtherFailure) -> pack "general failure"+

@@ -0,0 +1,68 @@+{-# 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

@@ -0,0 +1,61 @@+-- | These types represent options. They are abstract and in a+-- separate module to prevent you from accidentally making an option+-- with an invalid name. 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++import qualified Data.Text as X+import Data.Text ( Text, unpack, index )+import Control.Monad ( when )++-- | 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)++-- | This function is partial. It calls error if its argument is a+-- single dash. This is the only way to make a short option so it+-- prevents you from making one that is invalid.+makeShortOpt :: Char -> ShortOpt+makeShortOpt c = case c of+  '-' -> error "short option must not be a dash"+  x -> 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 not have a dash as+-- either the first or second character and it 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 :: Text } deriving (Show, Eq, Ord)++-- | This function is partial. It calls error if its argument contains+-- text that is not a valid long option. This is the only way to make+-- a long option so it prevents you from making invalid ones.+makeLongOpt :: Text -> LongOpt+makeLongOpt t = case isValidLongOptText t of+  True -> LongOpt t+  False -> error $ "invalid long option: " ++ unpack t++isValidLongOptText :: Text -> Bool+isValidLongOptText t = maybe False (const True) $ do+  when (X.null t) Nothing+  when ((t `index` 0) == '-') Nothing+  when ((X.length t > 1) && ((t `index` 1) == '-')) Nothing+  case X.find (== '=') t of+    (Just _) -> Nothing+    Nothing -> return ()+  return ()++

@@ -0,0 +1,962 @@+-- | Parser primitives. These are the only functions that have access+-- to the internals of the parser.+module System.Console.MultiArg.Prim (+    -- * Parser types+  Parser,+  ParserE,+  ParserSE,+  ParserT,+  +  -- * Running a parser+  +  -- | Each parser runner is applied to a list of Text, which are the+  -- command line arguments to parse. 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'.+  parse,+  parseE,+  parseSE,+  parseT,+  +  -- * Higher-level parser combinators+  parserMap,+  good,+  apply,+  choice,+  combine,+  lookAhead,+  +  -- ** Running parsers multiple times+  several,+  manyTill,+  feed,++  -- ** Monad lifting+  parserLift,+  parserIO,++  -- ** Failure and errors+  throw,+  throwString,+  genericThrow,+  (<?>),+  try,+  +  -- * Parsers+  -- ** Short options and arguments+  pendingShortOpt,+  nonPendingShortOpt,+  pendingShortOptArg,  +  +  -- ** Long options and arguments+  exactLongOpt,+  approxLongOpt,++  -- ** Stoppers+  stopper,+  +  -- ** Positional (non-option) arguments+  nextArg,+  nonOptionPosArg,+  +  -- ** Miscellaneous+  end,+  +  -- * User state+  get,+  put,+  modify+  ) where+++import qualified System.Console.MultiArg.Error as E+import System.Console.MultiArg.Option+  (ShortOpt,+    unShortOpt,+    LongOpt,+    unLongOpt )+import System.Console.MultiArg.TextNonEmpty+  ( TextNonEmpty ( TextNonEmpty ) )+import Control.Applicative ( Applicative, Alternative )+import qualified Control.Applicative+import Control.Monad.Exception.Synchronous+  (Exceptional(Success, Exception), switch )+import qualified Control.Monad.Exception.Synchronous as S+import Data.Functor.Identity ( runIdentity )+import Data.Text ( Text, pack, isPrefixOf, cons )+import qualified Data.Text as X+import qualified Data.Set as Set+import Data.Set ( Set )+import Control.Monad ( when, MonadPlus(mzero, mplus) )+import Control.Monad.Trans.Class ( lift )+import Data.Maybe ( isNothing )+import Data.Monoid ( Monoid ( mempty, mappend ) )+import Data.Functor.Identity ( Identity )+import Control.Monad.Trans.Class ( MonadTrans )+import Control.Monad.IO.Class ( MonadIO ( liftIO ) )++-- | Takes the head of a Text. Returns Nothing if the Text is empty.+textHead :: Text -> Maybe (Char, Text)+textHead t = case X.null t of+  True -> Nothing+  False -> Just (X.head t, X.tail t)++-- | Converts a Text to a TextNonEmpty. Returns Nothing if the Text is+-- empty.+toTextNonEmpty :: Text -> Maybe TextNonEmpty+toTextNonEmpty t = case textHead t of+  Nothing -> Nothing+  (Just (c, r)) -> Just $ TextNonEmpty c r++-- | Carries the internal state of the parser. The counter is a simple+-- way to determine whether the remaining list one ParseSt has been+-- modified from another. When parsers modify remaining, they+-- increment the counter.+data ParseSt s = ParseSt { pendingShort :: Maybe TextNonEmpty+                         , remaining :: [Text]+                         , sawStopper :: Bool+                         , userState :: s+                         , counter :: Int+                         } deriving (Show, Eq)++-- | Load up the ParseSt with an initial user state and a list of+-- commmand line arguments.+defaultState :: s -> [Text] -> ParseSt s+defaultState s ts = ParseSt { pendingShort = Nothing+                            , remaining = ts+                            , sawStopper = False+                            , userState = s+                            , counter = 0 }++-- | Carries the result of each parse.+data Result e a = Bad e | Good a++-- | @ParserT s e m a@ is a parser with user state s, error type e,+-- underlying monad m, and result type a. Internally the parser is a+-- state monad which keeps track of what is remaining to be+-- parsed. Since the parser has an internal state anyway, the user can+-- add to this state (this is called the user state.) The parser+-- ignores this user state so you can use it however you wish. If you+-- do not need a user state, just make it the unit type ().+--+-- The parser also includes the notion of failure. Any parser can+-- fail; a failed parser affects the behavior of combinators such as+-- combine. The failure type should be a instance of+-- System.Console.MultiArg.Error.Error. This allows you to define your+-- own type and use it for the failure type, which can be useful when+-- combining MultiArg with your own program.+--+-- The underlying monad is m. This makes ParserT into a monad+-- transformer; you can layer it on top of other monads. For instance+-- you might layer it on top of the IO monad so that your parser can+-- perform IO (for example, by examining the disk to see if arguments+-- that specify files are valid.) If you don't need a monad+-- transformer, just layer ParserT on top of Identity.+data ParserT s e m a =+  ParserT { runParserT :: ParseSt s -> m (Result e a, ParseSt s) }++instance (Monad m) => Functor (ParserT s e m) where+  fmap = parserMap++instance (Monad m) => Applicative (ParserT s e m) where+  pure = good+  (<*>) = apply++instance (Monad m, E.Error e) => Monoid (ParserT s e m a) where+  mempty = genericThrow+  mappend = choice++instance (Monad m, E.Error e) => Alternative (ParserT s e m) where+  empty = genericThrow+  (<|>) = choice+  many = several++instance (E.Error e, Monad m) => Monad (ParserT s e m) where+  (>>=) = combine+  return = good+  fail = throwString++instance (Monad m, E.Error e) => MonadPlus (ParserT s e m) where+  mzero = genericThrow+  mplus = choice++instance MonadTrans (ParserT s e) where+  lift = parserLift++instance (MonadIO m, E.Error e) => MonadIO (ParserT s e m) where+  liftIO = parserIO++-- | @ParserSE s e a@ is a parser with user state s, error type e,+-- underlying monad Identity, and result type a.+type ParserSE s e a = ParserT s e Identity a++-- | @ParserE e a@ is a parser with user state (), error type e,+-- underlying monad Identity, and result type a.+type ParserE e a = ParserT () e Identity a++-- | @Parser a@ is a parser with user state (), error type+-- SimpleError, underlying monad Identity, and result type a.+type Parser a = ParserT () E.SimpleError Identity a++-- | Runs a parser that has a user state and an underlying monad+-- Identity.+parseSE ::+  s+  -- ^ The initial user state+  +  -> [Text]+  -- ^ Command line arguments++  -> ParserSE s e a+  -- ^ Parser to run+  +  -> (Exceptional e a, s)+  -- ^ Success or failure, and the final user state+  +parseSE s ts p =+  let r = runIdentity (runParserT p (defaultState s ts))+      (result, st') = r+  in case result of+    (Good g) -> (Success g, userState st')+    (Bad e) -> (Exception e, userState st')++-- | Runs a parser that has no user state and an underlying monad of+-- Identity and is parameterized on the error type.+parseE ::+  [Text]+  -- ^ Command line arguments to parse+  +  -> ParserE e a+  -- ^ Parser to run+  +  -> Exceptional e a+  -- ^ Success or failure++parseE ts p =+  let r = runIdentity (runParserT p (defaultState () ts))+      (result, _) = r+  in case result of+    (Good g) -> Success g+    (Bad e) -> Exception e++-- | The simplest parser runner; has no user state, an underlying+-- monad Identity, and error type SimpleError.+parse :: [Text]+         -- ^ Command line arguments to parse+         +         -> Parser a+         -- ^ Parser to run++         -> Exceptional E.SimpleError a+         -- ^ Successful result or an error+parse = parseE++-- | The most complex parser runner. Runs a parser with a user-defined+-- state, error type, and underlying monad. Returns the final parse+-- result and the final user state, inside of the underlying monad.+parseT ::+  (Monad m)+  => s+  -- ^ Initial user state++  -> [Text]+  -- ^ Command line arguments to parse++  -> ParserT s e m a+  -- ^ Parser to run+  +  -> m (Exceptional e a, s)+  -- ^ Success or failure and the final user state, inside of the+  -- underlying monad++parseT s ts p = runParserT p (defaultState s ts) >>= \r ->+  let (result, st') = r+  in case result of+    (Good g) -> return (Success g, userState st')+    (Bad e) -> return (Exception e, userState st')++-- | Lifts a computation of the underlying monad into the ParserT+-- monad. This provides the implementation for+-- 'Control.Monad.Trans.Class.lift'.+parserLift ::+  Monad m+  => m a+  -> ParserT s e m a+parserLift c = ParserT $ \s ->+  c >>= \a -> return (Good a, s)++-- | Lifts a computation from the IO monad into the ParserT+-- monad. This provides the implementation for+-- 'Control.Monad.IO.Class.liftIO'.+parserIO ::+  (MonadIO m, E.Error e)+  => IO a+  -> ParserT s e m a+parserIO c = parserLift . liftIO $ c++-- | 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'.+combine ::+  (Monad m)+  => ParserT s e m a+  -> (a -> ParserT s e m b)+  -> ParserT s e m b+combine (ParserT l) f = ParserT $ \s ->+  l s >>= \(r, s') ->+  case r of+    (Bad e) -> return (Bad e, s')+    (Good g) ->+      let (ParserT fr) = f g+      in fr s'++-- | @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 ::+  (Monad m)+  => ParserT s e m a+  -> ParserT s e m a+lookAhead (ParserT p) = ParserT $ \s ->+  p s >>= \(r, s') ->+  return $ case r of+    (Good g) -> (Good g, s)+    (Bad e) -> (Bad e, s')++-- | @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 ::+  (Monad m)+  => a+  -> ParserT s e m a+good a = ParserT $ \s ->+  return (Good a, s)++-- | @throwString 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'.+throwString ::+  (E.Error e, Monad m)+  => String+  -> ParserT s e m a+throwString e = ParserT $ \s ->+  return (Bad (E.parseErr E.ExpOtherFailure+               (E.SawTextError (pack e))), s)++-- | @parserMap f p@ applies function f to the result of parser+-- p. First parser p is run. If it succeeds, function f is applied to+-- the result and another parser is returned with the result. If it+-- fails, f is not applied and a failed parser is returned. This+-- provides the implementation for 'Prelude.Functor.fmap'.+parserMap ::+  (Monad m)+  => (a -> b)+  -> ParserT s e m a+  -> ParserT s e m b+parserMap f (ParserT l) = ParserT $ \s ->+  l s >>= \r ->+  let (result, st') = r+  in case result of+    (Good g) -> return (Good (f g), st')+    (Bad e) -> return (Bad e, st')++-- | apply l r applies the function found in parser l to the result of+-- parser r. First the l parser is run. If it succeeds, it has a+-- resulting function. Then the r parser is run. If it succeeds, the+-- function from the l parser is applied to the result of the r+-- parser, and a new parser is returned with the result. If either+-- parser l or parser r fails, then a failed parser is returned. This+-- provides the implementation for '<*>' in+-- 'Control.Applicative.Applicative'.+apply ::+  (Monad m)+  => ParserT s e m (a -> b)+  -> ParserT s e m a+  -> ParserT s e m b+apply (ParserT x) (ParserT y) = ParserT $ \s ->+  x s >>= \r ->+  let (result, st') = r+  in case result of+    (Good f) -> y st' >>= \r' ->+      let (result', st'') = r'+      in case result' of+        (Good a) -> return (Good (f a), st'')+        (Bad e) -> return (Bad e, st'')+    (Bad e) -> return (Bad e, st')++-- | Fail with an unhelpful error message. Usually throw is more+-- useful, but this is handy to implement some typeclass instances.+genericThrow ::+  (Monad m, E.Error e)+  => ParserT s e m a+genericThrow = throw (E.parseErr E.ExpOtherFailure E.SawOtherFailure)++-- | throw e always fails without consuming any input and returns a+-- failed parser with error state e.+throw :: (Monad m) => e -> ParserT s e m a+throw e = ParserT $ \s ->+  return (Bad e, s)++noConsumed :: ParseSt s -> ParseSt s -> Bool+noConsumed old new = counter old >= counter new++-- | 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 ::+  (Monad m)+  => ParserT s e m a+  -> ParserT s e m a+  -> ParserT s e m a+choice (ParserT l) (ParserT r) = ParserT $ \sOld ->+  l sOld >>= \(a, s') ->+  case a of+    (Good g) -> return (Good g, s')+    (Bad e) ->+      if noConsumed sOld s'+      then r sOld+      else return (Bad e, s')++-- | Runs the parser given. If it succeeds, then returns the result of+-- the parser. If it fails and consumes input, returns the result of+-- the parser. If it fails without consuming any input, then changes+-- the error using the function given.+(<?>) ::+  (Monad m)+  => ParserT s e m a+  -> e+  -> ParserT s e m a+(<?>) (ParserT l) e = ParserT $ \s ->+  l s >>= \(r, s') ->+  case r of+    (Good g) -> return (Good g, s')+    (Bad err) ->+      if noConsumed s s'+      then return (Bad e, s)+      else return (Bad err, s')++infix 0 <?>++increment :: ParseSt s -> ParseSt s+increment old = old { counter = succ . counter $ old }++-- | 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; returns the short option parsed.+pendingShortOpt ::+  (Monad m, E.Error e)+  => ShortOpt+  -> ParserT s e m ShortOpt+pendingShortOpt so = ParserT $ \s ->+  let err saw = return (Bad (E.parseErr (E.ExpPendingShortOpt so) saw), s)+      gd (res, newSt) = return (Good res, newSt)+  in switch err gd $ do+    when (sawStopper s) $ S.throw E.SawAlreadyStopper+    (TextNonEmpty first rest) <-+      maybe (S.throw E.SawNoPendingShorts) return (pendingShort s)+    when (unShortOpt so /= first)+      (S.throw $ E.SawWrongPendingShort first)+    return (so, increment s { pendingShort = toTextNonEmpty rest })++-- | Parses only non-pending short options. Fails without consuming+-- any input if, in order:+--+-- * 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. Returns the short option+-- parsed.+nonPendingShortOpt ::+  (E.Error e, Monad m)+  => ShortOpt+  -> ParserT s e m ShortOpt+nonPendingShortOpt so = ParserT $ \s ->+  let err saw =+        return (Bad (E.parseErr (E.ExpNonPendingShortOpt so) saw), s)+      gd (g, n) = return (Good g, n)+  in switch err gd $ do+    maybe (return ()) (S.throw . E.SawStillPendingShorts) (pendingShort s)+    when (sawStopper s) (S.throw E.SawAlreadyStopper)+    (a:as) <- case remaining s of+      [] -> S.throw E.SawNoArgsLeft+      x -> return x+    (maybeDash, word) <- case textHead a of+      Nothing -> S.throw E.SawEmptyArg+      (Just w) -> return w+    when (maybeDash /= '-') $ S.throw (E.SawNotShortArg a)+    (letter, arg) <- case textHead word of+      Nothing -> S.throw E.SawSingleDashArg+      (Just w) -> return w+    when (letter /= unShortOpt so) $ S.throw (E.SawWrongShortArg letter)+    when (letter == '-') $ S.throw E.SawNewStopper+    let s' = increment s { pendingShort = toTextNonEmpty arg+                         , remaining = as }+    return (so, s')++-- | Parses an exact long option. That is, the text of the+-- command-line option must exactly match the text of the+-- option. Returns the option, and 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 ::+  (E.Error e, Monad m)+  => LongOpt+  -> ParserT s e m (LongOpt, Maybe Text)+exactLongOpt lo = ParserT $ \s ->+  let err saw = return (Bad (E.parseErr (E.ExpExactLong lo) saw), s)+      gd (g, n) = return (Good g, n)+  in switch err gd $ do+    maybe (return ()) (S.throw . E.SawStillPendingShorts) (pendingShort s)+    when (sawStopper s) (S.throw E.SawAlreadyStopper)+    (x:xs) <- case remaining s of+      [] -> S.throw E.SawNoArgsLeft+      ls -> return ls+    let (pre, word, afterEq) = splitLongWord x+    when (pre /= pack "--") $ S.throw (E.SawNotLongArg x)+    when (X.null word && isNothing afterEq) (S.throw E.SawNewStopper)+    when (word /= unLongOpt lo) $ S.throw (E.SawWrongLongArg word)+    let s' = increment s { remaining = xs }+    return ((lo, afterEq), s')++-- | Takes a single Text 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 Text with everything after the+-- equal sign if there is one.+splitLongWord :: Text -> (Text, Text, Maybe Text)+splitLongWord t = (f, s, r) where+  (f, rest) = X.splitAt 2 t+  (s, withEq) = X.break (== '=') rest+  r = case textHead withEq of+    Nothing -> Nothing+    (Just (_, afterEq)) -> Just afterEq++-- | Examines the next word. If it matches a Text in the set+-- unambiguously, returns a tuple of the word actually found and the+-- matching word in the set.+approxLongOpt ::+  (E.Error e, Monad m)+  => Set LongOpt+  -> ParserT s e m (Text, LongOpt, Maybe Text)+approxLongOpt ts = ParserT $ \s ->+  let err saw = return (Bad (E.parseErr (E.ExpApproxLong ts) saw), s)+      gd (g, newSt) = return (Good g, newSt)+  in switch err gd $ do+    maybe (return ()) (S.throw . E.SawStillPendingShorts) (pendingShort s)+    (x:xs) <- case remaining s of+      [] -> S.throw E.SawNoArgsLeft+      r -> return r+    let (pre, word, afterEq) = splitLongWord x+    when (pre /= pack "--") (S.throw (E.SawNotLongArg x))+    when (X.null word && isNothing afterEq) (S.throw E.SawNewStopper)+    let p t = word `isPrefixOf` (unLongOpt t)+        matches = Set.filter p ts+    case Set.toList matches of+      [] -> S.throw (E.SawNoMatches word)+      (m:[]) -> let s' = increment s { remaining = xs }+                in return ((word, m, afterEq), s')+      _ -> S.throw (E.SawMultipleMatches matches word)++-- | 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 text of the pending short option argument+-- (this text cannot be empty).+pendingShortOptArg ::+  (E.Error e, Monad m)+  => ParserT s e m Text+pendingShortOptArg = ParserT $ \s ->+  let err saw = return (Bad (E.parseErr E.ExpPendingShortArg saw), s)+      gd (g, newSt) = return (Good g, newSt)+  in switch err gd $ do+    when (sawStopper s) (S.throw E.SawAlreadyStopper)+    let f (TextNonEmpty c t) = return (c `cons` t)+    a <- maybe (S.throw E.SawNoPendingShortArg) f (pendingShort s)+    let newSt = increment s { pendingShort = Nothing }+    return (a, newSt)++-- | Parses a "stopper" - that is, a double dash. Changes the internal+-- state of the parser to reflect that a stopper has been seen.+stopper ::+  (E.Error e, Monad m)+  => ParserT s e m ()+stopper = ParserT $ \s ->+  let err saw = return (Bad (E.parseErr E.ExpStopper saw), s)+      gd (g, newSt) = return (Good g, newSt)+  in switch err gd $ do+    maybe (return ()) (S.throw . E.SawStillPendingShorts) (pendingShort s)+    when (sawStopper s) $ S.throw E.SawAlreadyStopper+    (x:xs) <- case remaining s of+      [] -> S.throw E.SawNoArgsLeft+      r -> return r+    when (not $ pack "--" `isPrefixOf` x) (S.throw E.SawNotStopper)+    when (X.length x /= 2) (S.throw E.SawNotStopper)+    let s' = increment s { sawStopper = True+                         , remaining = xs }+    return ((), s')++-- | try p behaves just like p, but if p fails, try p will not consume+-- any input.+try :: Monad m => ParserT s e m a -> ParserT s e m a+try (ParserT l) = ParserT $ \s ->+  l s >>= \(r, s') ->+  case r of+    (Good g) -> return (Good g, s')+    (Bad e) -> return (Bad e, s)++-- | Returns the next string on the command line as long as there are+-- no pendings. 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.+nextArg ::+  (E.Error e, Monad m)+  => ParserT s e m Text+nextArg = ParserT $ \s ->+  let err saw = return (Bad (E.parseErr E.ExpNextArg saw), s)+      gd (g, newSt) = return (Good g, newSt)+  in switch err gd $ do+    maybe (return ()) (S.throw . E.SawStillPendingShorts) (pendingShort s)+    (x:xs) <- case remaining s of+      [] -> S.throw E.SawNoArgsLeft+      r -> return r+    let newSt = increment s { remaining = xs }+    return (x, newSt)++-- | Returns the next string on the command line as long as there are+-- no pendings and as long as the next string does not begin with a+-- dash. If there has already been a stopper, then will return the+-- next string even if it starts with a dash.+nonOptionPosArg ::+  (E.Error e, Monad m)+  => ParserT s e m Text+nonOptionPosArg = ParserT $ \s ->+  let err saw = return (Bad (E.parseErr E.ExpNonOptionPosArg saw), s)+      gd (g, newSt) = return (Good g, newSt)+  in switch err gd $ do+    maybe (return ()) (S.throw . E.SawStillPendingShorts) (pendingShort s)+    (x:xs) <- case remaining s of+      [] -> S.throw E.SawNoArgsLeft+      r -> return r+    result <- if sawStopper s+              then return x+              else case textHead x of+                Just ('-', _) -> S.throw $ E.SawLeadingDashArg x+                _ -> return x+    let newSt = increment s { remaining = xs }+    return (result, newSt)+++-- | manyTill p e runs parser p repeatedly until parser e succeeds.+--+-- More precisely, first it runs parser e. If parser e succeeds, then+-- manyTill returns the result of all the preceding successful parses+-- of p. If parser e fails (it does not matter whether e consumed any+-- input or not), manyTill runs parser p again. What happens next+-- depends on whether p succeeded or failed. If p succeeded, then the+-- loop starts over by running parser e again. If p failed (it does+-- not matter whether it consumed any input or not), then manyTill+-- fails. The state of the parser is updated to reflect its state+-- after the failed run of p, and the parser is left in a failed+-- state.+--+-- Should parser e succeed (as it will on a successful application of+-- manyTill), then the parser state will reflect that parser e+-- succeeded--that is, if parser e consumes input, that input will be+-- consumed in the parser that is returned. Wrap e inside of+-- @lookAhead@ if that is undesirable.+--+-- Be particularly careful to get the order of the arguments+-- correct. Applying this function to reversed arguments will yield+-- bugs that are very difficult to diagnose.+manyTill ::+  Monad m+  => ParserT s e m a+  -> ParserT s e m end+  -> ParserT s e m [a]+manyTill (ParserT r) (ParserT f) = ParserT $ \s ->+  parseTill s r f >>= \till ->+  case lastFailure till of+    Nothing -> return (Good (goods till), lastSt till)+    (Just e) -> return (Bad e, lastSt till)++data Till s e a =+  Till { goods :: [a]+       , lastSt :: ParseSt s+       , lastFailure :: Maybe e }++parseTill ::+  (Monad m)+  => ParseSt s+  -> (ParseSt s -> m (Result e a, ParseSt s))+  -> (ParseSt s -> m (Result e b, ParseSt s))+  -> m (Till s e a)+parseTill s fr ff = ff s >>= \r ->+  case r of+    (Good _, s') -> return $ Till [] s' Nothing+    (Bad _, _) ->+      fr s >>= \r' ->+      case r' of+        (Bad e, s') -> return $ Till [] s' (Just e)+        (Good g, s') ->+          parseTill s' fr ff >>= \r'' ->+          let (Till gs lS lF) = r''+          in if counter s' == counter s+             then error "parseTill applied to parser that takes empty list"+             else return $ Till (g:gs) lS lF++-- It is impossible to implement several and manyTill in terms of+-- feed, as there is no easy way to specify what the starting value of+-- the state for feed would be.++-- | several p runs parser p zero or more times and returns all the+-- results. This proceeds like this: parser p is run and, if it+-- succeeds, the result is saved and parser p is run+-- again. Repeat. Eventually this will have to fail. If the last run+-- of parser p fails without consuming any input, then several p runs+-- successfully. The state of the parser is updated to reflect the+-- successful runs of p. If the last run of parser p fails but it+-- consumed input, then several p fails. The state of the parser is+-- updated to reflect the state up to and including the run that+-- partially consumed input. The parser is left in a failed state.+--+-- This semantic can come in handy. For example you might run a parser+-- multiple times that parses an option and arguments to the+-- option. If the arguments fail to parse, then several will fail.+--+-- This function provides the implementation for+-- 'Control.Applicative.Alternative.many'.+several ::+  (Monad m)+  => ParserT s e m a+  -> ParserT s e m [a]+several (ParserT l) = ParserT $ \s ->+  parseRepeat s l >>= \r ->+  let (result, finalGoodSt, failure, finalBadSt) = r+  in if noConsumed finalGoodSt finalBadSt+     then return (Good result, finalGoodSt)+     else return (Bad failure, finalBadSt)++parseRepeat ::+  (Monad m)+  => ParseSt s+  -> (ParseSt s -> m (Result e a, ParseSt s))+  -> m ([a], ParseSt s, e, ParseSt s)+parseRepeat st1 f = f st1 >>= \r ->+  case r of+    (Good a, st') ->+      if noConsumed st1 st'+      then error $ "several applied to parser that succeeds without"+           ++ " consuming any input"+      else+        parseRepeat st' f >>= \r' ->+        let (ls, finalGoodSt, failure, finalBadSt) = r'+        in return (a : ls, finalGoodSt, failure, finalBadSt)+    (Bad e, st') -> return ([], st1, e, st')++-- | feed runs in a recursive loop. Each loop starts with three+-- variables: a function @f@ that takes an input @i@ and returns a+-- parser @p@, a function @g@ that takes an input @i@ and returns a+-- parser @e@ that must succeed for the recursion to end, and an+-- initial input @i@. This proceeds as follows:+--+-- 1. Apply @g@ to @i@ and run resulting parser @e@. If this parser+-- succeeds, feed succeeds and returns a list of all successful runs+-- of @p@. The result of @e@ is not returned, but otherwise the parser+-- returned reflects the updated internal parser state from the+-- running of @e@. (If that is a problem, wrap @e@ in 'lookAhead'.) If+-- @e@ fails and consumes input, feed fails and returns a failed+-- parser whose internal state reflects the state after @e@ fails. If+-- @e@ fails without consuming any input, proceed with the following+-- steps.+--+-- 2. Apply function @f@ to input @i@, yielding a parser @p@. Run+-- parser @p@. If @p@ fails, feed also fails. If @p@ succeeds, it+-- yields a new input, @i'@.+--+-- 3. If @p@ succeeded without consuming any input, an infinite loop+-- will result, so apply @error@.+--+-- 4. Repeat from step 1, but with the new input retured from @p@,+-- @i'@.+--+-- For the initial application of feed, you supply the function @f@,+-- the end parser @e@, and the initial state @i@.+--+-- This function is useful for running multiple times a parser that+-- depends on the result of previous runs of the parser. You could+-- implement something similar using the user state feature, but for+-- various reasons sometimes it is more useful to use 'feed' instead.++feed ::+  Monad m+  => (a -> ParserT s e m a)+  -> (a -> ParserT s e m end)+  -> a+  -> ParserT s e m [a]+feed f e i = ParserT $ \s ->+  feedRecurse s f e i >>= \(s', lf) ->+  let res = case lf of+        EndFailure err -> Bad err+        RepeatFailure err -> Bad err+        RepeatSuccess ls -> Good ls+  in return (res, s')++data LastFeed e a =+  EndFailure e+  -- ^ The last run of the end parser failed and consumed input.+  +  | RepeatFailure e+    -- ^ The last run of the repetitive parser failed (whether or not+    -- it consumed any input).++  | RepeatSuccess [a]+    -- ^ The last run of the repetitive parser succeeded; here are all+    -- the results.++-- | Takes an initial state, a function @f@ that returns a parser @p@+-- to run repetitively, a parser @e@ that must succeed to stop the+-- recursion, and an input for @f@. Returns: @m (s, ei)@, where: +--+-- * @m@ is the inner monad+--+-- * @s@ is the state after the last application of either @e@ or @p@.+--+-- * @lf@ is a 'LastFeed' (see above).+feedRecurse ::+  Monad m+  => ParseSt s+  -> (a -> ParserT s e m a)+  -> (a -> ParserT s e m end)+  -> a+  -> m (ParseSt s, LastFeed e a)+feedRecurse st f fe i =+  runParserT (fe i) st >>= \(eResult, eSt) ->+  case eResult of+    Good _ -> return (eSt, RepeatSuccess [])+    Bad b ->+      if noConsumed st eSt+      then+        runParserT (f i) st >>= \(pResult, pSt) ->+        case pResult of+          Good g ->+            if noConsumed st pSt+            then feedRecurseError+            else+              feedRecurse pSt f fe g >>= \(recSt, lf) ->+              let res = case lf of+                    RepeatSuccess ls -> RepeatSuccess (g:ls)+                    failed -> failed+              in return (recSt, res)+          Bad badRepeat -> return (pSt, RepeatFailure badRepeat)+      else+        return (eSt, EndFailure b)++feedRecurseError :: a+feedRecurseError =+  error $ "feedRecurse applied to parser that succeeds without"+  ++ " consuming any input"+++-- | Succeeds if there is no more input left.+end ::+  (E.Error e, Monad m)+  => ParserT s e m ()+end = ParserT $ \s ->+  let err saw = return (Bad (E.parseErr E.ExpEnd saw), s)+      gd (g, newSt) = return (Good g, newSt)+  in switch err gd $ do+    maybe (return ()) (S.throw . E.SawStillPendingShorts) (pendingShort s)+    when (not . null . remaining $ s) (S.throw E.SawMoreInput)+    return ((), s)++-- | Gets the user state.+get ::+  (Monad m)+  => ParserT s e m s+get = ParserT $ \s ->+  return (Good (userState s), s)++-- | Puts a new user state.+put ::+  (Monad m)+  => s+  -> ParserT s e m ()+put newUserSt = ParserT $ \s ->+  return (Good (), s { userState = newUserSt })++-- | Modify the user state.+modify ::+  (Monad m)+  => (s -> s)+  -> ParserT s e m ()+modify f = ParserT $ \s ->+  return (Good (), s { userState = f (userState s) })

@@ -0,0 +1,30 @@+-- | 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, there is a @sample.hs@ file in the+-- @binaries@ directory of the multiarg archive that you can compile.+module System.Console.MultiArg.SampleParser where++import System.Console.MultiArg++specs :: [OptSpec]++specs = [ OptSpec "bytes"               "c" []          oneArg+        , OptSpec "follow"              "f" []          optionalArg+        , OptSpec "follow-retry"        "F" []          noArg+        , OptSpec "lines"               "n" []          oneArg+        , OptSpec "max-unchanged-stats" ""  []          oneArg+        , OptSpec "pid"                 ""  []          oneArg+        , OptSpec "quiet"               "q" ["silent"]  noArg+        , OptSpec "sleep-interval"      "s" []          oneArg+        , OptSpec "verbose"             "v" []          noArg+        , OptSpec "help"                ""  []          noArg+        , OptSpec "version"             ""  []          noArg+        ]++sampleMain :: IO ()+sampleMain = do+  as <- getArgs+  let r = parse Intersperse specs as+  print r

@@ -0,0 +1,255 @@+-- | 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'.+module System.Console.MultiArg.SimpleParser (+  OptSpec(..),+  Intersperse(..),+  Result(..),+  Args(..),+  noArg,+  optionalArg,+  oneArg,+  twoArg,+  variableArg,+  SimpleError,+  getArgs,+  System.Console.MultiArg.SimpleParser.parse ) where++import System.Console.MultiArg.Prim (+  Parser, manyTill, lookAhead, nextArg, nonOptionPosArg,+  end, (<?>), stopper, nonOptionPosArg, try )+import qualified System.Console.MultiArg.Prim as Prim+import System.Console.MultiArg.Combinator (+  mixedNoArg, mixedOptionalArg, mixedOneArg, mixedTwoArg,+  mixedVariableArg )+import System.Console.MultiArg.Option (+  makeLongOpt, makeShortOpt )+import Control.Monad.Exception.Synchronous ( toEither )+import System.Console.MultiArg.Error ( SimpleError )+import Data.Text ( pack, unpack )+import System.Environment ( getArgs )+import Data.Monoid ( mconcat )+import Control.Applicative ( many, (<|>) )++-- | Specifies each option that your program accepts.+data OptSpec = OptSpec {+  longOpt :: String+  -- ^ Each option must have at least one long option, which you+  -- specify here. Your program's users specify long options by+  -- preceding them with two dashes, such as @--verbose@. When writing+  -- your code you omit the dashes, so you would specify @verbose@+  -- here; including the dashes in your code results in a runtime+  -- error.++  , shortOpts :: [Char]+    -- ^ Additional, synonymous short options may be specified+    -- here. For instance if you want your users to be able to specify+    -- @-v@ in addition to @--verbose@, include @v@ in this list.+    +  , longOpts :: [String]+    -- ^ Additional synonymous long options may be specified here. For+    -- instance, if you specified @quiet@ for @longOpt@, you might+    -- want to include @silent@ in this list.++  , argSpec :: Args+    -- ^ Specifies what arguments, if any, this option takes.+  }+             deriving Show++-- | This datatype does dual duty. When part of an 'OptSpec', you use+-- it to specify how many arguments, if any, an option takes. When you+-- use it for this purpose, it only matters which data constructor you+-- use; the fields can be any value, even 'undefined'.+--+-- When part of a Result, 'Args' indicates what arguments the user+-- supplied to the option.+data Args =+  NoArg+  -- ^ This option takes no arguments+          +  | OptionalArg  { oArg :: Maybe String }++    -- ^ 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       { sArg1 :: String }+    -- ^ 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       { tArg1 :: String+                 , tArg2 :: String }+    -- ^ This option takes two arguments. Parsed similarly to 'OneArg'.+    +  | VariableArg { vArgs :: [String] }+    -- ^ 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.+    +  deriving Show++-- | Specify that this option takes no arguments.+noArg :: Args+noArg = NoArg++-- | Specify that this option takes an optional argument.+optionalArg :: Args+optionalArg = OptionalArg Nothing++-- | Specify that this option takes one argument.+oneArg :: Args+oneArg = OneArg ""++-- | Specify that this option takes two arguments.+twoArg :: Args+twoArg = TwoArg "" ""++-- | Specify that this option takes a variable number of arguments.+variableArg :: Args+variableArg = VariableArg []++-- | Holds the result of command line parsing. Each option (along with+-- its option arguments) or positional argument is assigned to its own+-- Result.+data Result =+  PosArg   { posArg :: String }+  | Stopper+  | Option {+    label :: String+    -- ^ Each option must have at least one long option. So that you+    -- can distinguish one option from another, the name of that long+    -- option is returned here.+    , args :: Args }+              deriving Show++-- | 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. +parse ::+  Intersperse+  -> [OptSpec]+  -> [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.++  -> Either SimpleError [Result]+parse i os ss = toEither $ Prim.parse (map pack ss) (f os) where+  f = case i of Intersperse -> parseIntersperse+                StopOptions -> parseNoIntersperse++parseNoIntersperse :: [OptSpec] -> Parser [Result]+parseNoIntersperse os = do+  let opts = mconcat . map optSpec $ os+  rs <- manyTill opts (try $ lookAhead afterArgs)+  firstArg <- afterArgs+  case firstArg of+    EndOfInput -> return rs+    (FirstArg s) -> do+      as <- noIntersperseArgs+      let first = PosArg s+      return $ rs ++ ( first : as )+    AAStopper -> do+      as <- noIntersperseArgs+      let first = Stopper+      return $ rs ++ ( first : as )++noIntersperseArgs :: Parser [Result]+noIntersperseArgs = do+  as <- many nextArg+  let r = map PosArg . map unpack $ as+  return r++data AfterArgs = EndOfInput | FirstArg String | AAStopper++afterArgs :: Parser AfterArgs+afterArgs = parseFirst <|> parseEnd <|> parseStopper where+  parseFirst = do+    a <- nonOptionPosArg+    let aS = unpack a+    return $ FirstArg aS+  parseEnd = do+    end+    return EndOfInput+  parseStopper = do+    _ <- stopperParser+    return AAStopper++parseIntersperse :: [OptSpec] -> Parser [Result]+parseIntersperse os = do+  let optsAndStopper = foldl1 (<|>) $ optSpecs ++ rest+      rest = [stopperParser, posArgParser]+      optSpecs = map optSpec os+  rs <- manyTill optsAndStopper end+  end <?> error "the end parser should always succeed"+  return rs++stopperParser :: Parser Result+stopperParser = stopper >> return Stopper++posArgParser :: Parser Result+posArgParser = do+  a <- nonOptionPosArg+  return $ PosArg (unpack a)++optSpec :: OptSpec -> Parser Result+optSpec o = let+  lo = makeLongOpt . pack . longOpt $ o+  ss = map makeShortOpt . shortOpts $ o+  ls = map makeLongOpt . map pack . longOpts $ o+  opt = return . Option (longOpt o)+  in case argSpec o of+    NoArg -> do+      _ <- mixedNoArg lo ls ss+      opt NoArg+    (OptionalArg {}) -> do+      (_, a) <- mixedOptionalArg lo ls ss+      opt (OptionalArg . fmap unpack $ a)+    (OneArg {}) -> do+      (_, a) <- mixedOneArg lo ls ss+      opt (OneArg . unpack $ a)+    (TwoArg {}) -> do+      (_, a1, a2) <- mixedTwoArg lo ls ss+      opt (TwoArg (unpack a1) (unpack a2))+    (VariableArg {}) -> do+      (_, as) <- mixedVariableArg lo ls ss+      opt (VariableArg . map unpack $ as)+

@@ -0,0 +1,6 @@+module System.Console.MultiArg.TextNonEmpty where++import Data.Text ( Text )++data TextNonEmpty = TextNonEmpty Char Text+                    deriving (Show, Eq)

@@ -1,5 +1,5 @@ Name: multiarg-Version: 0.1.0.0+Version: 0.2.0.0 Cabal-version: >=1.8 Build-Type: Simple License: MIT@@ -13,7 +13,7 @@ License-File: LICENSE synopsis: Combinators to build command line parsers extra-source-files:-        binaries/sample.hs+        doc/sample.hs, NEWS  description: multiarg is a parser combinator library to build command  line parsers. With it you can easily create parsers with options@@ -40,12 +40,13 @@     location: git://github.com/massysett/multiarg.git  Library+    hs-source-dirs: lib+     Build-depends:         base ==4.*,         text ==0.11.*,         explicit-exception ==0.1.*,         containers ==0.4.*,-        QuickCheck ==2.4.*,         transformers == 0.2.*              -- See documentation in System.Console.MultiArg.GetArgs for details@@ -64,7 +65,6 @@         System.Console.MultiArg.GetArgs,         System.Console.MultiArg.Option,         System.Console.MultiArg.Prim,-        System.Console.MultiArg.QuickCheckHelpers,         System.Console.MultiArg.SampleParser,         System.Console.MultiArg.SimpleParser,         System.Console.MultiArg.TextNonEmpty