multiarg (empty) → 0.1.0.0

raw patch · 14 files changed

+2234/−0 lines, 14 filesdep +QuickCheckdep +basedep +containerssetup-changed

Dependencies added: QuickCheck, base, containers, explicit-exception, text, transformers, utf8-string

Files

• LICENSE +30/−0
• Setup.hs +2/−0
• System/Console/MultiArg.hs +169/−0
• System/Console/MultiArg/Combinator.hs +364/−0
• System/Console/MultiArg/Error.hs +274/−0
• System/Console/MultiArg/GetArgs.hs +68/−0
• System/Console/MultiArg/Option.hs +72/−0
• System/Console/MultiArg/Prim.hs +847/−0
• System/Console/MultiArg/QuickCheckHelpers.hs +24/−0
• System/Console/MultiArg/SampleParser.hs +30/−0
• System/Console/MultiArg/SimpleParser.hs +255/−0
• System/Console/MultiArg/TextNonEmpty.hs +23/−0
• binaries/sample.hs +4/−0
• multiarg.cabal +72/−0

@@ -0,0 +1,30 @@+Copyright (c) 2011-2012 Omari Norman.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+    notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above copyright+    notice, this list of conditions and the following disclaimer in+    the documentation and/or other materials provided with the+    distribution.++    * Neither the name of Omari Norman nor the names of its+    contributors may be used to endorse or promote products derived+    from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -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,274 @@+-- | 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"

@@ -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,72 @@+-- | 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 ()++

@@ -0,0 +1,847 @@+-- | 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) })

@@ -0,0 +1,24 @@+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

@@ -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,23 @@+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)

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

@@ -0,0 +1,72 @@+Name: multiarg+Version: 0.1.0.0+Cabal-version: >=1.8+Build-Type: Simple+License: MIT+Copyright: 2011-2012 Omari Norman.+author: Omari Norman+maintainer: omari@smileystation.com+stability: Experimental+homepage: https://github.com/massysett/multiarg+bug-reports: omari@smileystation.com+Category: Console, Parsing+License-File: LICENSE+synopsis: Combinators to build command line parsers+extra-source-files:+        binaries/sample.hs++description: multiarg is a parser combinator library to build command+ line parsers. With it you can easily create parsers with options+ that take more than one option argument--for example, I created+ multiarg due to the apparent lack of such ability amongst other+ parsers. Its basic design is loosely inspired by Parsec.+ .+ Provides ParserT, a monad you use to build parsers. ParserT is a monad+ transformer, so you can layer it on top of other monads. For instance+ you could layer it on the IO monad so that your parser can perform IO.+ .+ It also has a simple, pre-built parser built with the underlying+ combinators, which works for many situtations and shields you from the+ underlying complexity if you don't need it.+ .+ See the documentation in the System.Console.MultiArg module for+ details.++Flag newbase+    Description: Builds package with base >= 4.4.0.0.++source-repository head+    type: git+    location: git://github.com/massysett/multiarg.git++Library+    Build-depends:+        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+    if flag(newbase)+        Build-depends:+            base >= 4.4 && < 5+    else+        Build-depends:+            base < 4.4,+            utf8-string == 0.3.7++    Exposed-modules:+        System.Console.MultiArg,+        System.Console.MultiArg.Combinator,+        System.Console.MultiArg.Error,+        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++    ghc-options: -Wall