packages feed

parsec 3.0.1 → 3.1.18.0

raw patch · 64 files changed

Files

+ ChangeLog.md view
@@ -0,0 +1,114 @@+### 3.1.18.0++- Drop support for GHCs prior 8.6.5++### 3.1.17.0++- Move `many1 :: ParsecT s u m a -> ParsecT s u m [a]` to `Text.Parsec.Prim`.+  Drop `Stream` constraint requirement.+- Change the position comparison in `mergeError` to not compare source names.+  This doesn't alter reported error positions when only a single source is parsed.+  This fixes performance issue caused by long source names.+- Add `Exception ParseError` instance++### 3.1.16.0++- Add `tokens'` and `string'` combinators which don't consume the prefix.++### 3.1.15.0++- Add `INLINABLE` pragmas to most overloaded combinators+- Support recent versions of dependencies+- Fix memory leak in `>>=` https://github.com/haskell/parsec/issues/127++### 3.1.14.0++- Add `parseFromFile` to `Text.Parsec.Text.Lazy` and `Text.Parsec.Text` (#103, #104).++- Clarify Haddock documentation in various places (#105,#101,#102).++- Add support for `base-4.13`.++### 3.1.13.0++- Add official support for [`SafeHaskell`](http://downloads.haskell.org/~ghc/latest/docs/html/users_guide/safe_haskell.html)++    **NOTE**: This is the first version whose `SafeHaskell` properties+    have become an intentional part of the API contract; previous+    versions were merely accidentally safe-inferred (or not depending+    on various factors; in other words, this was a fragile+    property). If you rely on `SafeHaskell` to consider module imports+    from `parsec` *safe*, this is the first version of `parsec` which+    actually guarantees a well-defined state; you can declare this+    requirement by either specifying++        build-depends: parsec >= 3.1.13.0 && < 3.2++    or, starting with `cabal-version:2.0`, via++        build-depends: parsec ^>= 3.1.13.0++- Drop support for GHC 7.0, GHC 7.2, and GHC 7.4.1; support window+  starts with GHC 7.4.2.++### 3.1.12.0++- Support limited to GHC 7.0 & GHC 7.2 only++- Add `MonadFail` instance for `ParsecT`+- Add `Semigroup`/`Monoid` instances for `ParsecT` (#80,#82)+- Fix space leak in Applicative/Monad interface (#37)+- Add `parserTrace` and `parserTraced` combinators for debugging.++### 3.1.11++- Include `README.md` in package.++### 3.1.10++- Most types now have a `Typeable` instance. Some instances are dropped from+  older versions of GHC (sorry about that!).+- The token-parser now rejects Unicode numeric escape sequences for characters+  outside the Unicode range.+- The token-parser now loses less precision when parsing literal doubles.+- Documentation fixes and corrections.+- We no longer test parsec builds on GHC 7.4.++### 3.1.9++- Many and various updates to documentation and package description (including+  the homepage links).+- Add an `Eq` instance for `ParseError`+- Fixed a regression from 3.1.6: `runP` is again exported from module+  Text.Parsec.++### 3.1.8++- Fix a regression from 3.1.6 related to exports from the main module.++### 3.1.7++- Fix a regression from 3.1.6 related to the reported position of error messages.+  See bug #9 for details.+- Reset the current error position on success of `lookAhead`.++### 3.1.6++- Export `Text` instances from Text.Parsec+- Make Text.Parsec exports more visible+- Re-arrange Text.Parsec exports+- Add functions `crlf` and `endOfLine` to Text.Parsec.Char for handling+  input streams that do not have normalized line terminators.+- Fix off-by-one error in Token.charControl++### 3.1.4++- Relax dependency on `text`++### 3.1.5++- Relax dependency on `text`++### 3.1.3++- Fix a regression introduced in 3.1.2 related to positions reported by error messages.
+ README.md view
@@ -0,0 +1,102 @@+Parsec [![Build Status](https://travis-ci.org/haskell/parsec.svg?branch=master)](https://travis-ci.org/haskell/parsec)+======++**Please refer to the [package description on Hackage](https://hackage.haskell.org/package/parsec#description) for more information.**++A monadic parser combinator library, written by Daan Leijen. Parsec is designed+from scratch as an industrial-strength parser library. It is simple, safe, well+documented, has extensive libraries, good error messages, and is fast.++Some links:++* [Parsec on Hackage](https://hackage.haskell.org/package/parsec),+  contains the generated documentation.+* The 2001 paper written by Daan Leijen, some what outdated+  ([PDF](https://web.archive.org/web/20140528151730/http://legacy.cs.uu.nl/daan/download/parsec/parsec.pdf),+  [HTML](https://web.archive.org/web/20140528151730/http://legacy.cs.uu.nl/daan/download/parsec/parsec.html),+  thanks to [archive.org](http://web.archive.org);+  and [PDF](https://research.microsoft.com/en-us/um/people/daan/download/parsec/parsec.pdf),+  thanks to Microsoft Research).+* [Using Parsec](http://book.realworldhaskell.org/read/using-parsec.html),+  chapter 16 of [Real World Haskell](http://book.realworldhaskell.org/).+* [An introduction to the Parsec library](https://www.kuniga.me/blog/2014/01/21/an-introduction-to-the-parsec-library.html)+  on Kunigami's blog.+* [An introduction to parsing text in Haskell with Parsec](https://jsdw.me/posts/haskell-parsec-basics/) on Wilson's blog.+* Differences between Parsec and+  [Attoparsec](http://hackage.haskell.org/package/attoparsec)+  (Haskell's other prominent parser library) as explained in+  [an answer on StackExchange](http://stackoverflow.com/a/19213247).+* Differences between Parsec and [Happy](http://www.haskell.org/happy)+  (Haskell's parser generator) as explained in two+  answers on separate StackExchange questions+  ([1](http://stackoverflow.com/a/7270904),+  [2](http://stackoverflow.com/a/14775331)).+* Differences between Parsec and+  [Megaparsec](http://hackage.haskell.org/package/megaparsec)+  (an advanced fork of Parsec) as explained in+  [Megaparsec's README](https://github.com/mrkkrp/megaparsec#megaparsec-vs-parsec).+++By analyzing [Parsec's reverse dependencies on Hackage](http://packdeps.haskellers.com/reverse/parsec)+we can find open source project that make use of Parsec.  For example+[bibtex](http://hackage.haskell.org/package/bibtex),+[ConfigFile](http://hackage.haskell.org/package/ConfigFile),+[csv](http://hackage.haskell.org/package/csv) and+[hjson](http://hackage.haskell.org/package/hjson).+++## Getting started++This requires a working version of `cabal` and `ghci`, which are part of+any modern installation of Haskell, such as+[Haskell Platform](https://www.haskell.org/platform).++First install Parsec.++    cabal install parsec++Below we show how a very simple parser that tests matching parentheses+was made from GHCI (the interactive GHC environment), which we started+with the `ghci` command).++```+Prelude> :m +Text.Parsec+Prelude Text.Parsec> let parenSet = char '(' >> many parenSet >> char ')' :: Parsec String () Char+Loading package transformers-0.3.0.0 ... linking ... done.+Loading package array-0.5.0.0 ... linking ... done.+Loading package deepseq-1.3.0.2 ... linking ... done.+Loading package bytestring-0.10.4.0 ... linking ... done.+Loading package mtl-2.1.3.1 ... linking ... done.+Loading package text-1.1.1.3 ... linking ... done.+Loading package parsec-3.1.5 ... linking ... done.+Prelude Text.Parsec> let parens = (many parenSet >> eof) <|> eof+Prelude Text.Parsec> parse parens "" "()"+Right ()+Prelude Text.Parsec> parse parens "" "()(())"+Right ()+Prelude Text.Parsec> parse parens "" "("+Left (line 1, column 2):+unexpected end of input+expecting "(" or ")"+```++The `Right ()` results indicate successes: the parentheses matched.+The `Left [...]` result indicates a parse failure, and is detailed+with an error message.++For a more thorough introduction to Parsec we recommend the links at+the top of this README file.+++## Contributing++Issues (bugs, feature requests or otherwise feedback) may be reported in+[the Github issue tracker for this project](https://github.com/haskell/parsec/issues).++Pull-requests are also welcome.+++## License++See the [LICENSE](https://github.com/haskell/parsec/blob/master/LICENSE)+file in the repository.
− Text/Parsec.hs 
@@ -1,36 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.Parsec--- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007--- License     :  BSD-style (see the LICENSE file)--- --- Maintainer  :  derek.a.elkins@gmail.com--- Stability   :  provisional--- Portability :  portable--- --------------------------------------------------------------------------------module Text.Parsec-    ( module Text.Parsec.Prim-    , module Text.Parsec.Char-    , module Text.Parsec.Combinator-    , module Text.Parsec.String-    , module Text.Parsec.ByteString-    , module Text.Parsec.ByteString.Lazy-    , ParseError-    , errorPos-    , SourcePos-    , SourceName, Line, Column-    , sourceName, sourceLine, sourceColumn-    , incSourceLine, incSourceColumn-    , setSourceLine, setSourceColumn, setSourceName-    ) where--import Text.Parsec.Pos-import Text.Parsec.Error-import Text.Parsec.Prim-import Text.Parsec.Char-import Text.Parsec.Combinator-import Text.Parsec.String           hiding ( Parser, GenParser, parseFromFile )-import Text.Parsec.ByteString       hiding ( Parser, GenParser, parseFromFile )-import Text.Parsec.ByteString.Lazy  hiding ( Parser, GenParser, parseFromFile )
− Text/Parsec/ByteString.hs 
@@ -1,46 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.Parsec.ByteString--- Copyright   :  (c) Paolo Martini 2007--- License     :  BSD-style (see the LICENSE file)--- --- Maintainer  :  derek.a.elkins@gmail.com--- Stability   :  provisional--- Portability :  portable--- --- Make strict ByteStrings an instance of 'Stream' with 'Char' token type.-----------------------------------------------------------------------------------{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Text.Parsec.ByteString-    ( Parser, GenParser, parseFromFile-    ) where--import Text.Parsec.Error-import Text.Parsec.Prim--import qualified Data.ByteString.Char8 as C--instance (Monad m) => Stream C.ByteString m Char where-    uncons = return . C.uncons--type Parser = Parsec C.ByteString ()-type GenParser t st = Parsec C.ByteString st---- | @parseFromFile p filePath@ runs a strict bytestring parser @p@ on the--- input read from @filePath@ using 'ByteString.Char8.readFile'. Returns either a 'ParseError'--- ('Left') or a value of type @a@ ('Right').------ >  main    = do{ result <- parseFromFile numbers "digits.txt"--- >              ; case result of--- >                  Left err  -> print err--- >                  Right xs  -> print (sum xs)--- >              }--parseFromFile :: Parser a -> String -> IO (Either ParseError a)-parseFromFile p fname-    = do input <- C.readFile fname-         return (runP p () fname input)
− Text/Parsec/ByteString/Lazy.hs 
@@ -1,45 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.Parsec.ByteString.Lazy--- Copyright   :  (c) Paolo Martini 2007--- License     :  BSD-style (see the LICENSE file)--- --- Maintainer  :  derek.a.elkins@gmail.com--- Stability   :  provisional--- Portability :  portable------ Make lazy ByteStrings an instance of 'Stream' with 'Char' token type.-----------------------------------------------------------------------------------{-# LANGUAGE FlexibleInstances #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Text.Parsec.ByteString.Lazy-    ( Parser, GenParser, parseFromFile-    ) where--import Text.Parsec.Error-import Text.Parsec.Prim--import qualified Data.ByteString.Lazy.Char8 as C--instance (Monad m) => Stream C.ByteString m Char where-    uncons = return . C.uncons--type Parser = Parsec C.ByteString ()-type GenParser t st = Parsec C.ByteString st---- | @parseFromFile p filePath@ runs a lazy bytestring parser @p@ on the--- input read from @filePath@ using 'ByteString.Lazy.Char8.readFile'. Returns either a 'ParseError'--- ('Left') or a value of type @a@ ('Right').------ >  main    = do{ result <- parseFromFile numbers "digits.txt"--- >              ; case result of--- >                  Left err  -> print err--- >                  Right xs  -> print (sum xs)--- >              }-parseFromFile :: Parser a -> String -> IO (Either ParseError a)-parseFromFile p fname-    = do input <- C.readFile fname-         return (runP p () fname input)
− Text/Parsec/Char.hs 
@@ -1,135 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.Parsec.Char--- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007--- License     :  BSD-style (see the LICENSE file)--- --- Maintainer  :  derek.a.elkins@gmail.com--- Stability   :  provisional--- Portability :  portable--- --- Commonly used character parsers.--- --------------------------------------------------------------------------------{-# LANGUAGE FlexibleContexts #-}--module Text.Parsec.Char where--import Data.Char-import Text.Parsec.Pos-import Text.Parsec.Prim---- | @oneOf cs@ succeeds if the current character is in the supplied--- list of characters @cs@. Returns the parsed character. See also--- 'satisfy'.--- --- >   vowel  = oneOf "aeiou"--oneOf :: (Stream s m Char) => [Char] -> ParsecT s u m Char-oneOf cs            = satisfy (\c -> elem c cs)---- | As the dual of 'oneOf', @noneOf cs@ succeeds if the current--- character /not/ in the supplied list of characters @cs@. Returns the--- parsed character.------ >  consonant = noneOf "aeiou"--noneOf :: (Stream s m Char) => [Char] -> ParsecT s u m Char-noneOf cs           = satisfy (\c -> not (elem c cs))---- | Skips /zero/ or more white space characters. See also 'skipMany'.--spaces :: (Stream s m Char) => ParsecT s u m ()-spaces              = skipMany space        <?> "white space"---- | Parses a white space character (any character which satisfies 'isSpace')--- Returns the parsed character. --space :: (Stream s m Char) => ParsecT s u m Char-space               = satisfy isSpace       <?> "space"---- | Parses a newline character (\'\\n\'). Returns a newline character. --newline :: (Stream s m Char) => ParsecT s u m Char-newline             = char '\n'             <?> "new-line"---- | Parses a tab character (\'\\t\'). Returns a tab character. --tab :: (Stream s m Char) => ParsecT s u m Char-tab                 = char '\t'             <?> "tab"---- | Parses an upper case letter (a character between \'A\' and \'Z\').--- Returns the parsed character. --upper :: (Stream s m Char) => ParsecT s u m Char-upper               = satisfy isUpper       <?> "uppercase letter"---- | Parses a lower case character (a character between \'a\' and \'z\').--- Returns the parsed character. --lower :: (Stream s m Char) => ParsecT s u m Char-lower               = satisfy isLower       <?> "lowercase letter"---- | Parses a letter or digit (a character between \'0\' and \'9\').--- Returns the parsed character. --alphaNum :: (Stream s m Char => ParsecT s u m Char)-alphaNum            = satisfy isAlphaNum    <?> "letter or digit"---- | Parses a letter (an upper case or lower case character). Returns the--- parsed character. --letter :: (Stream s m Char) => ParsecT s u m Char-letter              = satisfy isAlpha       <?> "letter"---- | Parses a digit. Returns the parsed character. --digit :: (Stream s m Char) => ParsecT s u m Char-digit               = satisfy isDigit       <?> "digit"---- | Parses a hexadecimal digit (a digit or a letter between \'a\' and--- \'f\' or \'A\' and \'F\'). Returns the parsed character. --hexDigit :: (Stream s m Char) => ParsecT s u m Char-hexDigit            = satisfy isHexDigit    <?> "hexadecimal digit"---- | Parses an octal digit (a character between \'0\' and \'7\'). Returns--- the parsed character. --octDigit :: (Stream s m Char) => ParsecT s u m Char-octDigit            = satisfy isOctDigit    <?> "octal digit"---- | @char c@ parses a single character @c@. Returns the parsed--- character (i.e. @c@).------ >  semiColon  = char ';'--char :: (Stream s m Char) => Char -> ParsecT s u m Char-char c              = satisfy (==c)  <?> show [c]---- | This parser succeeds for any character. Returns the parsed character. --anyChar :: (Stream s m Char) => ParsecT s u m Char-anyChar             = satisfy (const True)---- | The parser @satisfy f@ succeeds for any character for which the--- supplied function @f@ returns 'True'. Returns the character that is--- actually parsed.---- >  digit     = satisfy isDigit--- >  oneOf cs  = satisfy (\c -> c `elem` cs)--satisfy :: (Stream s m Char) => (Char -> Bool) -> ParsecT s u m Char-satisfy f           = tokenPrim (\c -> show [c])-                                (\pos c _cs -> updatePosChar pos c)-                                (\c -> if f c then Just c else Nothing)---- | @string s@ parses a sequence of characters given by @s@. Returns--- the parsed string (i.e. @s@).------ >  divOrMod    =   string "div" --- >              <|> string "mod"--string :: (Stream s m Char) => String -> ParsecT s u m String-string s            = tokens show updatePosString s
− Text/Parsec/Combinator.hs 
@@ -1,286 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.Parsec.Combinator--- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007--- License     :  BSD-style (see the LICENSE file)--- --- Maintainer  :  derek.a.elkins@gmail.com--- Stability   :  provisional--- Portability :  portable--- --- Commonly used generic combinators--- --------------------------------------------------------------------------------module Text.Parsec.Combinator-    ( choice-    , count-    , between-    , option, optionMaybe, optional-    , skipMany1-    , many1-    , sepBy, sepBy1-    , endBy, endBy1-    , sepEndBy, sepEndBy1-    , chainl, chainl1-    , chainr, chainr1-    , eof, notFollowedBy-    -- tricky combinators-    , manyTill, lookAhead, anyToken-    ) where--import Control.Monad-import Text.Parsec.Prim---- | @choice ps@ tries to apply the parsers in the list @ps@ in order,--- until one of them succeeds. Returns the value of the succeeding--- parser.--choice :: (Stream s m t) => [ParsecT s u m a] -> ParsecT s u m a-choice ps           = foldr (<|>) mzero ps---- | @option x p@ tries to apply parser @p@. If @p@ fails without--- consuming input, it returns the value @x@, otherwise the value--- returned by @p@.------ >  priority  = option 0 (do{ d <- digit--- >                          ; return (digitToInt d) --- >                          })--option :: (Stream s m t) => a -> ParsecT s u m a -> ParsecT s u m a-option x p          = p <|> return x---- | @option p@ tries to apply parser @p@.  If @p@ fails without--- consuming input, it return 'Nothing', otherwise it returns--- 'Just' the value returned by @p@.--optionMaybe :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (Maybe a)-optionMaybe p       = option Nothing (liftM Just p)---- | @optional p@ tries to apply parser @p@.  It will parse @p@ or nothing.--- It only fails if @p@ fails after consuming input. It discards the result--- of @p@.--optional :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m ()-optional p          = do{ p; return ()} <|> return ()---- | @between open close p@ parses @open@, followed by @p@ and @close@.--- Returns the value returned by @p@.------ >  braces  = between (symbol "{") (symbol "}")--between :: (Stream s m t) => ParsecT s u m open -> ParsecT s u m close-            -> ParsecT s u m a -> ParsecT s u m a-between open close p-                    = do{ open; x <- p; close; return x }---- | @skipMany1 p@ applies the parser @p@ /one/ or more times, skipping--- its result. --skipMany1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m ()-skipMany1 p         = do{ p; skipMany p }-{--skipMany p          = scan-                    where-                      scan  = do{ p; scan } <|> return ()--}---- | @many p@ applies the parser @p@ /one/ or more times. Returns a--- list of the returned values of @p@.------ >  word  = many1 letter--many1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m [a]-many1 p             = do{ x <- p; xs <- many p; return (x:xs) }-{--many p              = scan id-                    where-                      scan f    = do{ x <- p-                                    ; scan (\tail -> f (x:tail))-                                    }-                                <|> return (f [])--}----- | @sepBy p sep@ parses /zero/ or more occurrences of @p@, separated--- by @sep@. Returns a list of values returned by @p@.------ >  commaSep p  = p `sepBy` (symbol ",")--sepBy :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]-sepBy p sep         = sepBy1 p sep <|> return []---- | @sepBy1 p sep@ parses /one/ or more occurrences of @p@, separated--- by @sep@. Returns a list of values returned by @p@. --sepBy1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]-sepBy1 p sep        = do{ x <- p-                        ; xs <- many (sep >> p)-                        ; return (x:xs)-                        }----- | @sepEndBy1 p sep@ parses /one/ or more occurrences of @p@,--- separated and optionally ended by @sep@. Returns a list of values--- returned by @p@. --sepEndBy1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]-sepEndBy1 p sep     = do{ x <- p-                        ; do{ sep-                            ; xs <- sepEndBy p sep-                            ; return (x:xs)-                            }-                          <|> return [x]-                        }---- | @sepEndBy p sep@ parses /zero/ or more occurrences of @p@,--- separated and optionally ended by @sep@, ie. haskell style--- statements. Returns a list of values returned by @p@.------ >  haskellStatements  = haskellStatement `sepEndBy` semi--sepEndBy :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]-sepEndBy p sep      = sepEndBy1 p sep <|> return []----- | @endBy1 p sep@ parses /one/ or more occurrences of @p@, seperated--- and ended by @sep@. Returns a list of values returned by @p@. --endBy1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]-endBy1 p sep        = many1 (do{ x <- p; sep; return x })---- | @endBy p sep@ parses /zero/ or more occurrences of @p@, seperated--- and ended by @sep@. Returns a list of values returned by @p@.------ >   cStatements  = cStatement `endBy` semi--endBy :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]-endBy p sep         = many (do{ x <- p; sep; return x })---- | @count n p@ parses @n@ occurrences of @p@. If @n@ is smaller or--- equal to zero, the parser equals to @return []@. Returns a list of--- @n@ values returned by @p@. --count :: (Stream s m t) => Int -> ParsecT s u m a -> ParsecT s u m [a]-count n p           | n <= 0    = return []-                    | otherwise = sequence (replicate n p)---- | @chainr p op x@ parser /zero/ or more occurrences of @p@,--- separated by @op@ Returns a value obtained by a /right/ associative--- application of all functions returned by @op@ to the values returned--- by @p@. If there are no occurrences of @p@, the value @x@ is--- returned.--chainr :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> a -> ParsecT s u m a-chainr p op x       = chainr1 p op <|> return x---- | @chainl p op x@ parser /zero/ or more occurrences of @p@,--- separated by @op@. Returns a value obtained by a /left/ associative--- application of all functions returned by @op@ to the values returned--- by @p@. If there are zero occurrences of @p@, the value @x@ is--- returned.--chainl :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> a -> ParsecT s u m a-chainl p op x       = chainl1 p op <|> return x---- | @chainl1 p op x@ parser /one/ or more occurrences of @p@,--- separated by @op@ Returns a value obtained by a /left/ associative--- application of all functions returned by @op@ to the values returned--- by @p@. . This parser can for example be used to eliminate left--- recursion which typically occurs in expression grammars.------ >  expr    = term   `chainl1` mulop--- >  term    = factor `chainl1` addop--- >  factor  = parens expr <|> integer--- >--- >  mulop   =   do{ symbol "*"; return (*)   }--- >          <|> do{ symbol "/"; return (div) }--- >--- >  addop   =   do{ symbol "+"; return (+) }--- >          <|> do{ symbol "-"; return (-) }--chainl1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a-chainl1 p op        = do{ x <- p; rest x }-                    where-                      rest x    = do{ f <- op-                                    ; y <- p-                                    ; rest (f x y)-                                    }-                                <|> return x---- | @chainr1 p op x@ parser /one/ or more occurrences of |p|,--- separated by @op@ Returns a value obtained by a /right/ associative--- application of all functions returned by @op@ to the values returned--- by @p@.--chainr1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a-chainr1 p op        = scan-                    where-                      scan      = do{ x <- p; rest x }--                      rest x    = do{ f <- op-                                    ; y <- scan-                                    ; return (f x y)-                                    }-                                <|> return x---------------------------------------------------------------- Tricky combinators--------------------------------------------------------------- | The parser @anyToken@ accepts any kind of token. It is for example--- used to implement 'eof'. Returns the accepted token. --anyToken :: (Stream s m t, Show t) => ParsecT s u m t-anyToken            = tokenPrim show (\pos _tok _toks -> pos) Just---- | This parser only succeeds at the end of the input. This is not a--- primitive parser but it is defined using 'notFollowedBy'.------ >  eof  = notFollowedBy anyToken <?> "end of input"--eof :: (Stream s m t, Show t) => ParsecT s u m ()-eof                 = notFollowedBy anyToken <?> "end of input"---- | @notFollowedBy p@ only succeeds when parser @p@ fails. This parser--- does not consume any input. This parser can be used to implement the--- \'longest match\' rule. For example, when recognizing keywords (for--- example @let@), we want to make sure that a keyword is not followed--- by a legal identifier character, in which case the keyword is--- actually an identifier (for example @lets@). We can program this--- behaviour as follows:------ >  keywordLet  = try (do{ string "let"--- >                       ; notFollowedBy alphaNum--- >                       })--notFollowedBy :: (Stream s m t, Show t) => ParsecT s u m t -> ParsecT s u m ()-notFollowedBy p     = try (do{ c <- p; unexpected (show [c]) }-                           <|> return ()-                          )---- | @manyTill p end@ applies parser @p@ /zero/ or more times until--- parser @end@ succeeds. Returns the list of values returned by @p@.--- This parser can be used to scan comments:------ >  simpleComment   = do{ string "<!--"--- >                      ; manyTill anyChar (try (string "-->"))--- >                      }------    Note the overlapping parsers @anyChar@ and @string \"<!--\"@, and---    therefore the use of the 'try' combinator.--manyTill :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]-manyTill p end      = scan-                    where-                      scan  = do{ end; return [] }-                            <|>-                              do{ x <- p; xs <- scan; return (x:xs) }---- | @lookAhead p@ parses @p@ without consuming any input.--lookAhead :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m a-lookAhead p         = do{ state <- getParserState-                        ; x <- p-                        ; setParserState state-                        ; return x-                        }
− Text/Parsec/Error.hs 
@@ -1,197 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.Parsec.Error--- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007--- License     :  BSD-style (see the LICENSE file)--- --- Maintainer  :  derek.a.elkins@gmail.com--- Stability   :  provisional--- Portability :  portable--- --- Parse errors--- --------------------------------------------------------------------------------module Text.Parsec.Error-    ( Message ( SysUnExpect, UnExpect, Expect, Message )-    , messageString-    , ParseError, errorPos, errorMessages, errorIsUnknown-    , showErrorMessages-    , newErrorMessage, newErrorUnknown-    , addErrorMessage, setErrorPos, setErrorMessage-    , mergeError-    ) where--import Data.List ( nub, sort )--import Text.Parsec.Pos---- | This abstract data type represents parse error messages. There are--- four kinds of messages:------ >  data Message = SysUnExpect String--- >               | UnExpect String--- >               | Expect String--- >               | Message String--- --- The fine distinction between different kinds of parse errors allows--- the system to generate quite good error messages for the user. It--- also allows error messages that are formatted in different--- languages. Each kind of message is generated by different combinators:------     * A 'SysUnExpect' message is automatically generated by the---       'Text.Parsec.Combinator.satisfy' combinator. The argument is the---       unexpected input.------     * A 'UnExpect' message is generated by the 'Text.Parsec.Prim.unexpected'---       combinator. The argument describes the---       unexpected item.------     * A 'Expect' message is generated by the 'Text.Parsec.Prim.<?>'---       combinator. The argument describes the expected item.------     * A 'Message' message is generated by the 'fail'---       combinator. The argument is some general parser message. --data Message = SysUnExpect !String -- @ library generated unexpect-             | UnExpect    !String -- @ unexpected something-             | Expect      !String -- @ expecting something-             | Message     !String -- @ raw message--instance Enum Message where-    fromEnum (SysUnExpect _) = 0-    fromEnum (UnExpect    _) = 1-    fromEnum (Expect      _) = 2-    fromEnum (Message     _) = 3-    toEnum _ = error "toEnum is undefined for Message"---- < Return 'True' only when 'compare' would return 'EQ'.--instance Eq Message where--    m1 == m2 = fromEnum m1 == fromEnum m2---- < Compares two error messages without looking at their content. Only--- the constructors are compared where:--- --- > 'SysUnExpect' < 'UnExpect' < 'Expect' < 'Message'--instance Ord Message where-    compare msg1 msg2 = compare (fromEnum msg1) (fromEnum msg2)---- | Extract the message string from an error message --messageString :: Message -> String-messageString (SysUnExpect s) = s-messageString (UnExpect    s) = s-messageString (Expect      s) = s-messageString (Message     s) = s---- | The abstract data type @ParseError@ represents parse errors. It--- provides the source position ('SourcePos') of the error--- and a list of error messages ('Message'). A @ParseError@--- can be returned by the function 'Text.Parsec.Prim.parse'. @ParseError@ is an--- instance of the 'Show' class. --data ParseError = ParseError !SourcePos [Message]---- | Extracts the source position from the parse error--errorPos :: ParseError -> SourcePos-errorPos (ParseError pos _msgs)-    = pos---- | Extracts the list of error messages from the parse error--errorMessages :: ParseError -> [Message]-errorMessages (ParseError _pos msgs)-    = sort msgs--errorIsUnknown :: ParseError -> Bool-errorIsUnknown (ParseError _pos msgs)-    = null msgs---- < Create parse errors--newErrorUnknown :: SourcePos -> ParseError-newErrorUnknown pos-    = ParseError pos []--newErrorMessage :: Message -> SourcePos -> ParseError-newErrorMessage msg pos-    = ParseError pos [msg]--addErrorMessage :: Message -> ParseError -> ParseError-addErrorMessage msg (ParseError pos msgs)-    = ParseError pos (msg:msgs)--setErrorPos :: SourcePos -> ParseError -> ParseError-setErrorPos pos (ParseError _ msgs)-    = ParseError pos msgs--setErrorMessage :: Message -> ParseError -> ParseError-setErrorMessage msg (ParseError pos msgs)-    = ParseError pos (msg : filter (msg /=) msgs)--mergeError :: ParseError -> ParseError -> ParseError-mergeError (ParseError pos msgs1) (ParseError _ msgs2)-    = ParseError pos (msgs1 ++ msgs2)--instance Show ParseError where-    show err-        = show (errorPos err) ++ ":" ++-          showErrorMessages "or" "unknown parse error"-                            "expecting" "unexpected" "end of input"-                           (errorMessages err)---- Language independent show function----  TODO--- < The standard function for showing error messages. Formats a list of---    error messages in English. This function is used in the |Show|---    instance of |ParseError <#ParseError>|. The resulting string will be---    formatted like:------    |unexpected /{The first UnExpect or a SysUnExpect message}/;---    expecting /{comma separated list of Expect messages}/;---    /{comma separated list of Message messages}/--showErrorMessages ::-    String -> String -> String -> String -> String -> [Message] -> String-showErrorMessages msgOr msgUnknown msgExpecting msgUnExpected msgEndOfInput msgs-    | null msgs = msgUnknown-    | otherwise = concat $ map ("\n"++) $ clean $-                 [showSysUnExpect,showUnExpect,showExpect,showMessages]-    where-      (sysUnExpect,msgs1) = span ((SysUnExpect "") ==) msgs-      (unExpect,msgs2)    = span ((UnExpect    "") ==) msgs1-      (expect,messages)   = span ((Expect      "") ==) msgs2--      showExpect      = showMany msgExpecting expect-      showUnExpect    = showMany msgUnExpected unExpect-      showSysUnExpect | not (null unExpect) ||-                        null sysUnExpect = ""-                      | null firstMsg    = msgUnExpected ++ " " ++ msgEndOfInput-                      | otherwise        = msgUnExpected ++ " " ++ firstMsg-          where-              firstMsg  = messageString (head sysUnExpect)--      showMessages      = showMany "" messages--      -- helpers-      showMany pre msgs = case clean (map messageString msgs) of-                            [] -> ""-                            ms | null pre  -> commasOr ms-                               | otherwise -> pre ++ " " ++ commasOr ms--      commasOr []       = ""-      commasOr [m]      = m-      commasOr ms       = commaSep (init ms) ++ " " ++ msgOr ++ " " ++ last ms--      commaSep          = seperate ", " . clean--      seperate   _ []     = ""-      seperate   _ [m]    = m-      seperate sep (m:ms) = m ++ sep ++ seperate sep ms--      clean             = nub . filter (not . null)
− Text/Parsec/Expr.hs 
@@ -1,166 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.Parsec.Expr--- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007--- License     :  BSD-style (see the LICENSE file)--- --- Maintainer  :  derek.a.elkins@gmail.com--- Stability   :  provisional--- Portability :  non-portable--- --- A helper module to parse \"expressions\".--- Builds a parser given a table of operators and associativities.--- --------------------------------------------------------------------------------module Text.Parsec.Expr-    ( Assoc(..), Operator(..), OperatorTable-    , buildExpressionParser-    ) where--import Text.Parsec.Prim-import Text.Parsec.Combinator---------------------------------------------------------------- Assoc and OperatorTable---------------------------------------------------------------- |  This data type specifies the associativity of operators: left, right--- or none.--data Assoc                = AssocNone-                          | AssocLeft-                          | AssocRight---- | This data type specifies operators that work on values of type @a@.--- An operator is either binary infix or unary prefix or postfix. A--- binary operator has also an associated associativity.--data Operator s u m a   = Infix (ParsecT s u m (a -> a -> a)) Assoc-                        | Prefix (ParsecT s u m (a -> a))-                        | Postfix (ParsecT s u m (a -> a))---- | An @OperatorTable s u m a@ is a list of @Operator s u m a@--- lists. The list is ordered in descending--- precedence. All operators in one list have the same precedence (but--- may have a different associativity).--type OperatorTable s u m a = [[Operator s u m a]]---------------------------------------------------------------- Convert an OperatorTable and basic term parser into--- a full fledged expression parser---------------------------------------------------------------- | @buildExpressionParser table term@ builds an expression parser for--- terms @term@ with operators from @table@, taking the associativity--- and precedence specified in @table@ into account. Prefix and postfix--- operators of the same precedence can only occur once (i.e. @--2@ is--- not allowed if @-@ is prefix negate). Prefix and postfix operators--- of the same precedence associate to the left (i.e. if @++@ is--- postfix increment, than @-2++@ equals @-1@, not @-3@).------ The @buildExpressionParser@ takes care of all the complexity--- involved in building expression parser. Here is an example of an--- expression parser that handles prefix signs, postfix increment and--- basic arithmetic.------ >  expr    = buildExpressionParser table term--- >          <?> "expression"--- >--- >  term    =  parens expr --- >          <|> natural--- >          <?> "simple expression"--- >--- >  table   = [ [prefix "-" negate, prefix "+" id ]--- >            , [postfix "++" (+1)]--- >            , [binary "*" (*) AssocLeft, binary "/" (div) AssocLeft ]--- >            , [binary "+" (+) AssocLeft, binary "-" (-)   AssocLeft ]--- >            ]--- >          --- >  binary  name fun assoc = Infix (do{ reservedOp name; return fun }) assoc--- >  prefix  name fun       = Prefix (do{ reservedOp name; return fun })--- >  postfix name fun       = Postfix (do{ reservedOp name; return fun })--buildExpressionParser :: (Stream s m t)-                      => OperatorTable s u m a-                      -> ParsecT s u m a-                      -> ParsecT s u m a-buildExpressionParser operators simpleExpr-    = foldl (makeParser) simpleExpr operators-    where-      makeParser term ops-        = let (rassoc,lassoc,nassoc-               ,prefix,postfix)      = foldr splitOp ([],[],[],[],[]) ops--              rassocOp   = choice rassoc-              lassocOp   = choice lassoc-              nassocOp   = choice nassoc-              prefixOp   = choice prefix  <?> ""-              postfixOp  = choice postfix <?> ""--              ambigious assoc op= try $-                                  do{ op; fail ("ambiguous use of a " ++ assoc-                                                 ++ " associative operator")-                                    }--              ambigiousRight    = ambigious "right" rassocOp-              ambigiousLeft     = ambigious "left" lassocOp-              ambigiousNon      = ambigious "non" nassocOp--              termP      = do{ pre  <- prefixP-                             ; x    <- term-                             ; post <- postfixP-                             ; return (post (pre x))-                             }--              postfixP   = postfixOp <|> return id--              prefixP    = prefixOp <|> return id--              rassocP x  = do{ f <- rassocOp-                             ; y  <- do{ z <- termP; rassocP1 z }-                             ; return (f x y)-                             }-                           <|> ambigiousLeft-                           <|> ambigiousNon-                           -- <|> return x--              rassocP1 x = rassocP x  <|> return x--              lassocP x  = do{ f <- lassocOp-                             ; y <- termP-                             ; lassocP1 (f x y)-                             }-                           <|> ambigiousRight-                           <|> ambigiousNon-                           -- <|> return x--              lassocP1 x = lassocP x <|> return x--              nassocP x  = do{ f <- nassocOp-                             ; y <- termP-                             ;    ambigiousRight-                              <|> ambigiousLeft-                              <|> ambigiousNon-                              <|> return (f x y)-                             }-                           -- <|> return x--           in  do{ x <- termP-                 ; rassocP x <|> lassocP  x <|> nassocP x <|> return x-                   <?> "operator"-                 }---      splitOp (Infix op assoc) (rassoc,lassoc,nassoc,prefix,postfix)-        = case assoc of-            AssocNone  -> (rassoc,lassoc,op:nassoc,prefix,postfix)-            AssocLeft  -> (rassoc,op:lassoc,nassoc,prefix,postfix)-            AssocRight -> (op:rassoc,lassoc,nassoc,prefix,postfix)--      splitOp (Prefix op) (rassoc,lassoc,nassoc,prefix,postfix)-        = (rassoc,lassoc,nassoc,op:prefix,postfix)--      splitOp (Postfix op) (rassoc,lassoc,nassoc,prefix,postfix)-        = (rassoc,lassoc,nassoc,prefix,op:postfix)
− Text/Parsec/Language.hs 
@@ -1,150 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.Parsec.Language--- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007--- License     :  BSD-style (see the LICENSE file)--- --- Maintainer  :  derek.a.elkins@gmail.com--- Stability   :  provisional--- Portability :  non-portable (uses non-portable module Text.Parsec.Token)------ A helper module that defines some language definitions that can be used--- to instantiate a token parser (see "Text.Parsec.Token").--- --------------------------------------------------------------------------------module Text.Parsec.Language-    ( haskellDef, haskell-    , mondrianDef, mondrian-    , emptyDef-    , haskellStyle-    , javaStyle-    , LanguageDef-    , GenLanguageDef-    ) where--import Text.Parsec-import Text.Parsec.Token---------------------------------------------------------------- Styles: haskellStyle, javaStyle---------------------------------------------------------------- | This is a minimal token definition for Haskell style languages. It--- defines the style of comments, valid identifiers and case--- sensitivity. It does not define any reserved words or operators.--haskellStyle :: LanguageDef st-haskellStyle = emptyDef-                { commentStart   = "{-"-                , commentEnd     = "-}"-                , commentLine    = "--"-                , nestedComments = True-                , identStart     = letter-                , identLetter	 = alphaNum <|> oneOf "_'"-                , opStart	 = opLetter haskellStyle-                , opLetter	 = oneOf ":!#$%&*+./<=>?@\\^|-~"-                , reservedOpNames= []-                , reservedNames  = []-                , caseSensitive  = True-                }---- | This is a minimal token definition for Java style languages. It--- defines the style of comments, valid identifiers and case--- sensitivity. It does not define any reserved words or operators.--javaStyle  :: LanguageDef st-javaStyle   = emptyDef-		{ commentStart	 = "/*"-		, commentEnd	 = "*/"-		, commentLine	 = "//"-		, nestedComments = True-		, identStart	 = letter-		, identLetter	 = alphaNum <|> oneOf "_'"-		, reservedNames  = []-		, reservedOpNames= []-                , caseSensitive  = False-		}---------------------------------------------------------------- minimal language definition------------------------------------------------------------- TODO: This seems wrong--- < This is the most minimal token definition. It is recommended to use--- this definition as the basis for other definitions. @emptyDef@ has--- no reserved names or operators, is case sensitive and doesn't accept--- comments, identifiers or operators.--emptyDef   :: LanguageDef st-emptyDef    = LanguageDef-               { commentStart   = ""-               , commentEnd     = ""-               , commentLine    = ""-               , nestedComments = True-               , identStart     = letter <|> char '_'-               , identLetter    = alphaNum <|> oneOf "_'"-               , opStart        = opLetter emptyDef-               , opLetter       = oneOf ":!#$%&*+./<=>?@\\^|-~"-               , reservedOpNames= []-               , reservedNames  = []-               , caseSensitive  = True-               }------------------------------------------------------------------ Haskell---------------------------------------------------------------- | A lexer for the haskell language.--haskell :: TokenParser st-haskell      = makeTokenParser haskellDef---- | The language definition for the Haskell language.--haskellDef  :: LanguageDef st-haskellDef   = haskell98Def-	        { identLetter	 = identLetter haskell98Def <|> char '#'-	        , reservedNames	 = reservedNames haskell98Def ++-    				   ["foreign","import","export","primitive"-    				   ,"_ccall_","_casm_"-    				   ,"forall"-    				   ]-                }---- | The language definition for the language Haskell98.--haskell98Def :: LanguageDef st-haskell98Def = haskellStyle-                { reservedOpNames= ["::","..","=","\\","|","<-","->","@","~","=>"]-                , reservedNames  = ["let","in","case","of","if","then","else",-                                    "data","type",-                                    "class","default","deriving","do","import",-                                    "infix","infixl","infixr","instance","module",-                                    "newtype","where",-                                    "primitive"-                                    -- "as","qualified","hiding"-                                   ]-                }----------------------------------------------------------------- Mondrian---------------------------------------------------------------- | A lexer for the mondrian language.--mondrian :: TokenParser st-mondrian    = makeTokenParser mondrianDef---- | The language definition for the language Mondrian.--mondrianDef :: LanguageDef st-mondrianDef = javaStyle-		{ reservedNames = [ "case", "class", "default", "extends"-				  , "import", "in", "let", "new", "of", "package"-				  ]-                , caseSensitive  = True-		}
− Text/Parsec/Perm.hs 
@@ -1,181 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.Parsec.Perm--- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007--- License     :  BSD-style (see the file libraries/parsec/LICENSE)--- --- Maintainer  :  derek.a.elkins@gmail.com--- Stability   :  provisional--- Portability :  non-portable (uses existentially quantified data constructors)--- --- This module implements permutation parsers. The algorithm used--- is fairly complex since we push the type system to its limits :-)--- The algorithm is described in:--- --- /Parsing Permutation Phrases,/--- by Arthur Baars, Andres Loh and Doaitse Swierstra.--- Published as a functional pearl at the Haskell Workshop 2001.--- --------------------------------------------------------------------------------{-# LANGUAGE ExistentialQuantification #-}--module Text.Parsec.Perm-    ( PermParser-    , StreamPermParser -- abstract--    , permute-    , (<||>), (<$$>)-    , (<|?>), (<$?>)-    ) where--import Text.Parsec--import Control.Monad.Identity--infixl 1 <||>, <|?>-infixl 2 <$$>, <$?>---{----------------------------------------------------------------  test -- parse a permutation of-  * an optional string of 'a's-  * a required 'b'-  * an optional 'c'----------------------------------------------------------------}-{--test input-  = parse (do{ x <- ptest; eof; return x }) "" input--ptest :: Parser (String,Char,Char)-ptest-  = permute $-    (,,) <$?> ("",many1 (char 'a'))-         <||> char 'b'-         <|?> ('_',char 'c')--}--{----------------------------------------------------------------  Building a permutation parser----------------------------------------------------------------}---- | The expression @perm \<||> p@ adds parser @p@ to the permutation--- parser @perm@. The parser @p@ is not allowed to accept empty input ---- use the optional combinator ('<|?>') instead. Returns a--- new permutation parser that includes @p@. --(<||>) :: (Stream s Identity tok) => StreamPermParser s st (a -> b) -> Parsec s st a -> StreamPermParser s st b-(<||>) perm p     = add perm p---- | The expression @f \<$$> p@ creates a fresh permutation parser--- consisting of parser @p@. The the final result of the permutation--- parser is the function @f@ applied to the return value of @p@. The--- parser @p@ is not allowed to accept empty input - use the optional--- combinator ('<$?>') instead.------ If the function @f@ takes more than one parameter, the type variable--- @b@ is instantiated to a functional type which combines nicely with--- the adds parser @p@ to the ('<||>') combinator. This--- results in stylized code where a permutation parser starts with a--- combining function @f@ followed by the parsers. The function @f@--- gets its parameters in the order in which the parsers are specified,--- but actual input can be in any order.--(<$$>) :: (Stream s Identity tok) => (a -> b) -> Parsec s st a -> StreamPermParser s st b-(<$$>) f p        = newperm f <||> p---- | The expression @perm \<||> (x,p)@ adds parser @p@ to the--- permutation parser @perm@. The parser @p@ is optional - if it can--- not be applied, the default value @x@ will be used instead. Returns--- a new permutation parser that includes the optional parser @p@. --(<|?>) :: (Stream s Identity tok) => StreamPermParser s st (a -> b) -> (a, Parsec s st a) -> StreamPermParser s st b-(<|?>) perm (x,p) = addopt perm x p---- | The expression @f \<$?> (x,p)@ creates a fresh permutation parser--- consisting of parser @p@. The the final result of the permutation--- parser is the function @f@ applied to the return value of @p@. The--- parser @p@ is optional - if it can not be applied, the default value--- @x@ will be used instead. --(<$?>) :: (Stream s Identity tok) => (a -> b) -> (a, Parsec s st a) -> StreamPermParser s st b-(<$?>) f (x,p)    = newperm f <|?> (x,p)--{----------------------------------------------------------------  The permutation tree----------------------------------------------------------------}---- | Provided for backwards compatibility.  The tok type is ignored.--type PermParser tok st a = StreamPermParser String st a---- | The type @StreamPermParser s st a@ denotes a permutation parser that,--- when converted by the 'permute' function, parses --- @s@ streams with user state @st@ and returns a value of--- type @a@ on success.------ Normally, a permutation parser is first build with special operators--- like ('<||>') and than transformed into a normal parser--- using 'permute'.--data StreamPermParser s st a = Perm (Maybe a) [StreamBranch s st a]---- type Branch st a = StreamBranch String st a--data StreamBranch s st a = forall b. Branch (StreamPermParser s st (b -> a)) (Parsec s st b)---- | The parser @permute perm@ parses a permutation of parser described--- by @perm@. For example, suppose we want to parse a permutation of:--- an optional string of @a@'s, the character @b@ and an optional @c@.--- This can be described by:------ >  test  = permute (tuple <$?> ("",many1 (char 'a'))--- >                         <||> char 'b' --- >                         <|?> ('_',char 'c'))--- >        where--- >          tuple a b c  = (a,b,c)---- transform a permutation tree into a normal parser-permute :: (Stream s Identity tok) => StreamPermParser s st a -> Parsec s st a-permute (Perm def xs)-  = choice (map branch xs ++ empty)-  where-    empty-      = case def of-          Nothing -> []-          Just x  -> [return x]--    branch (Branch perm p)-      = do{ x <- p-          ; f <- permute perm-          ; return (f x)-          }---- build permutation trees-newperm :: (Stream s Identity tok) => (a -> b) -> StreamPermParser s st (a -> b)-newperm f-  = Perm (Just f) []--add :: (Stream s Identity tok) => StreamPermParser s st (a -> b) -> Parsec s st a -> StreamPermParser s st b-add perm@(Perm _mf fs) p-  = Perm Nothing (first:map insert fs)-  where-    first   = Branch perm p-    insert (Branch perm' p')-            = Branch (add (mapPerms flip perm') p) p'--addopt :: (Stream s Identity tok) => StreamPermParser s st (a -> b) -> a -> Parsec s st a -> StreamPermParser s st b-addopt perm@(Perm mf fs) x p-  = Perm (fmap ($ x) mf) (first:map insert fs)-  where-    first   = Branch perm p-    insert (Branch perm' p')-            = Branch (addopt (mapPerms flip perm') x p) p'---mapPerms :: (Stream s Identity tok) => (a -> b) -> StreamPermParser s st a -> StreamPermParser s st b-mapPerms f (Perm x xs)-  = Perm (fmap f x) (map mapBranch xs)-  where-    mapBranch (Branch perm p)-      = Branch (mapPerms (f.) perm) p
− Text/Parsec/Pos.hs 
@@ -1,125 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.Parsec.Pos--- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007--- License     :  BSD-style (see the LICENSE file)--- --- Maintainer  :  derek.a.elkins@gmail.com--- Stability   :  provisional--- Portability :  portable--- --- Textual source positions.--- --------------------------------------------------------------------------------module Text.Parsec.Pos-    ( SourceName, Line, Column-    , SourcePos-    , sourceLine, sourceColumn, sourceName-    , incSourceLine, incSourceColumn-    , setSourceLine, setSourceColumn, setSourceName-    , newPos, initialPos-    , updatePosChar, updatePosString-    ) where--import Data.Generics---- < Source positions: a file name, a line and a column--- upper left is (1,1)--type SourceName = String-type Line       = Int-type Column     = Int---- | The abstract data type @SourcePos@ represents source positions. It--- contains the name of the source (i.e. file name), a line number and--- a column number. @SourcePos@ is an instance of the 'Show', 'Eq' and--- 'Ord' class. --data SourcePos  = SourcePos SourceName !Line !Column-    deriving ( Eq, Ord, Data, Typeable)---- | Create a new 'SourcePos' with the given source name,--- line number and column number.--newPos :: SourceName -> Line -> Column -> SourcePos-newPos name line column-    = SourcePos name line column---- | Create a new 'SourcePos' with the given source name,--- and line number and column number set to 1, the upper left.--initialPos :: SourceName -> SourcePos-initialPos name-    = newPos name 1 1---- | Extracts the name of the source from a source position. --sourceName :: SourcePos -> SourceName-sourceName (SourcePos name _line _column) = name---- | Extracts the line number from a source position. --sourceLine :: SourcePos -> Line-sourceLine (SourcePos _name line _column) = line---- | Extracts the column number from a source position. --sourceColumn :: SourcePos -> Column-sourceColumn (SourcePos _name _line column) = column---- | Increments the line number of a source position. --incSourceLine :: SourcePos -> Line -> SourcePos-incSourceLine (SourcePos name line column) n = SourcePos name (line+n) column---- | Increments the column number of a source position. --incSourceColumn :: SourcePos -> Column -> SourcePos-incSourceColumn (SourcePos name line column) n = SourcePos name line (column+n)---- | Set the name of the source.--setSourceName :: SourcePos -> SourceName -> SourcePos-setSourceName (SourcePos _name line column) n = SourcePos n line column---- | Set the line number of a source position. --setSourceLine :: SourcePos -> Line -> SourcePos-setSourceLine (SourcePos name _line column) n = SourcePos name n column---- | Set the column number of a source position. --setSourceColumn :: SourcePos -> Column -> SourcePos-setSourceColumn (SourcePos name line _column) n = SourcePos name line n---- | The expression @updatePosString pos s@ updates the source position--- @pos@ by calling 'updatePosChar' on every character in @s@, ie.--- @foldl updatePosChar pos string@. --updatePosString :: SourcePos -> String -> SourcePos-updatePosString pos string-    = foldl updatePosChar pos string---- | Update a source position given a character. If the character is a--- newline (\'\\n\') or carriage return (\'\\r\') the line number is--- incremented by 1. If the character is a tab (\'\t\') the column--- number is incremented to the nearest 8'th column, ie. @column + 8 ---- ((column-1) \`mod\` 8)@. In all other cases, the column is--- incremented by 1. --updatePosChar   :: SourcePos -> Char -> SourcePos-updatePosChar (SourcePos name line column) c-    = case c of-        '\n' -> SourcePos name (line+1) 1-        '\t' -> SourcePos name line (column + 8 - ((column-1) `mod` 8))-        _    -> SourcePos name line (column + 1)--instance Show SourcePos where-  show (SourcePos name line column)-    | null name = showLineColumn-    | otherwise = "\"" ++ name ++ "\" " ++ showLineColumn-    where-      showLineColumn    = "(line " ++ show line ++-                          ", column " ++ show column ++-                          ")"
− Text/Parsec/Prim.hs 
@@ -1,672 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.Parsec.Prim--- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007--- License     :  BSD-style (see the LICENSE file)--- --- Maintainer  :  derek.a.elkins@gmail.com--- Stability   :  provisional--- Portability :  portable--- --- The primitive parser combinators.--- ------------------------------------------------------------------------------   --{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts,-             UndecidableInstances #-}--module Text.Parsec.Prim where--import qualified Control.Applicative as Applicative ( Applicative(..), Alternative(..) )-import Control.Monad()-import Control.Monad.Trans-import Control.Monad.Identity--import Control.Monad.Reader.Class-import Control.Monad.State.Class-import Control.Monad.Cont.Class-import Control.Monad.Error.Class--import Text.Parsec.Pos-import Text.Parsec.Error--unknownError :: State s u -> ParseError-unknownError state        = newErrorUnknown (statePos state)--sysUnExpectError :: String -> SourcePos -> Reply s u a-sysUnExpectError msg pos  = Error (newErrorMessage (SysUnExpect msg) pos)---- | The parser @unexpected msg@ always fails with an unexpected error--- message @msg@ without consuming any input.------ The parsers 'fail', ('<?>') and @unexpected@ are the three parsers--- used to generate error messages. Of these, only ('<?>') is commonly--- used. For an example of the use of @unexpected@, see the definition--- of 'Text.Parsec.Combinator.notFollowedBy'.--unexpected :: (Stream s m t) => String -> ParsecT s u m a-unexpected msg-    = ParsecT $ \s -> return $ Empty $ return $ -                        Error (newErrorMessage (UnExpect msg) (statePos s))---- | ParserT monad transformer and Parser type---- | @ParsecT s u m a@ is a parser with stream type @s@, user state type @u@,--- underlying monad @m@ and return type @a@.  Parsec is strict in the user state.--- If this is undesirable, simply used a data type like @data Box a = Box a@ and--- the state type @Box YourStateType@ to add a level of indirection.--data ParsecT s u m a-    = ParsecT { runParsecT :: State s u -> m (Consumed (m (Reply s u a))) }--type Parsec s u = ParsecT s u Identity--data Consumed a  = Consumed a-                 | Empty !a--data Reply s u a = Ok a !(State s u) ParseError-                 | Error ParseError--data State s u = State {-      stateInput :: s,-      statePos   :: !SourcePos,-      stateUser  :: !u-    }--instance Functor Consumed where-    fmap f (Consumed x) = Consumed (f x)-    fmap f (Empty x)    = Empty (f x)--instance Functor (Reply s u) where-    fmap f (Ok x s e) = Ok (f x) s e-    fmap _ (Error e) = Error e -- XXX--instance (Monad m) => Functor (ParsecT s u m) where-    fmap f p = parsecMap f p--parsecMap :: (Monad m) => (a -> b) -> ParsecT s u m a -> ParsecT s u m b-parsecMap f p-    = ParsecT $ \s -> liftM (fmap (liftM (fmap f))) (runParsecT p s)--instance (Monad m) => Applicative.Applicative (ParsecT s u m) where-    pure = return-    (<*>) = ap -- TODO: Can this be optimized?--instance (Monad m) => Applicative.Alternative (ParsecT s u m) where-    empty = mzero-    (<|>) = mplus--instance (Monad m) => Monad (ParsecT s u m) where-    return x = parserReturn x-    p >>= f  = parserBind p f-    fail msg = parserFail msg--instance (MonadIO m) => MonadIO (ParsecT s u m) where-    liftIO = lift . liftIO--instance (MonadReader r m) => MonadReader r (ParsecT s u m) where-    ask = lift ask-    local f p = ParsecT $ \s -> local f (runParsecT p s)---- I'm presuming the user might want a separate, non-backtracking--- state aside from the Parsec user state.-instance (MonadState s m) => MonadState s (ParsecT s' u m) where-    get = lift get-    put = lift . put--instance (MonadCont m) => MonadCont (ParsecT s u m) where-    callCC f = ParsecT $ \s ->-          callCC $ \c ->-          runParsecT (f (\a -> ParsecT $ \s' -> c (pack s' a))) s--     where pack s a= Empty $ return (Ok a s (unknownError s))--instance (MonadError e m) => MonadError e (ParsecT s u m) where-    throwError = lift . throwError-    p `catchError` h = ParsecT $ \s ->-        runParsecT p s `catchError` \e ->-            runParsecT (h e) s--parserReturn :: (Monad m) => a -> ParsecT s u m a-parserReturn x-    = ParsecT $ \s -> return $ Empty $ return (Ok x s (unknownError s))--parserBind :: (Monad m)-           => ParsecT s u m a -> (a -> ParsecT s u m b) -> ParsecT s u m b--parserBind p f-    = ParsecT $ \s -> do -- TODO: This was \s@(State _ u _) ???-        res1 <- runParsecT p s-        case res1 of--          Empty mReply1-            -> do reply1 <- mReply1-                  case reply1 of-                    Ok x s' err1 -> do-                      res2 <- runParsecT (f x) s'-                      case res2 of-                        Empty mReply2-                          -> do reply2 <- mReply2-                                return $ Empty $-                                            return $ mergeErrorReply err1 reply2-                        other-                          -> do return $ other-                    Error err1 -> return $ Empty $ return $ Error err1--          Consumed mReply1-            -> do reply1 <- mReply1-                  return $ Consumed $ -- `early' returning-                    case reply1 of-                      Ok x s' err1 -> do-                        res2 <- runParsecT (f x) s'-                        case res2 of-                          Empty mReply2-                            -> do reply2 <- mReply2-                                  return $ mergeErrorReply err1 reply2-                          Consumed reply2 -> reply2-                      Error err1   -> return $ Error err1---mergeErrorReply :: ParseError -> Reply s u a -> Reply s u a-mergeErrorReply err1 reply -- XXX where to put it?-    = case reply of-        Ok x state err2 -> Ok x state (mergeError err1 err2)-        Error err2      -> Error (mergeError err1 err2)--parserFail :: (Monad m) => String -> ParsecT s u m a-parserFail msg-    = ParsecT $ \s -> return $ Empty $ return $-        Error (newErrorMessage (Message msg) (statePos s))--instance (Monad m) => MonadPlus (ParsecT s u m) where-    mzero = parserZero-    mplus p1 p2 = parserPlus p1 p2---- | @parserZero@ always fails without consuming any input. @parserZero@ is defined--- equal to the 'mzero' member of the 'MonadPlus' class and to the 'Control.Applicative.empty' member --- of the 'Control.Applicative.Applicative' class.--parserZero :: (Monad m) => ParsecT s u m a-parserZero-    = ParsecT $ \s -> return $ Empty $ return $ Error (unknownError s)--parserPlus :: (Monad m)-           => ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a-parserPlus (ParsecT p1) (ParsecT p2)-    = ParsecT $ \s -> do-        c1 <- p1 s-        case c1 of-          Empty mReply1-            -> do r1 <- mReply1-                  case r1 of-                    Error err -> do-                      c2 <- p2 s-                      case c2 of-                        Empty mReply2-                          -> do reply2 <- mReply2-                                return $ Empty $ return (mergeErrorReply err reply2)-                        consumed-                          -> return $ consumed-                    other -> return $ Empty $ return $ other-          other -> return $ other--instance MonadTrans (ParsecT s u) where-    lift amb = ParsecT $ \s -> do-                 a <- amb-                 return $ Empty $ return $ Ok a s (unknownError s)--infix  0 <?>-infixr 1 <|>---- | The parser @p <?> msg@ behaves as parser @p@, but whenever the--- parser @p@ fails /without consuming any input/, it replaces expect--- error messages with the expect error message @msg@.------ This is normally used at the end of a set alternatives where we want--- to return an error message in terms of a higher level construct--- rather than returning all possible characters. For example, if the--- @expr@ parser from the 'try' example would fail, the error--- message is: '...: expecting expression'. Without the @(\<?>)@--- combinator, the message would be like '...: expecting \"let\" or--- letter', which is less friendly.--(<?>) :: (Monad m)-      => (ParsecT s u m a) -> String -> (ParsecT s u m a)-p <?> msg = label p msg---- | This combinator implements choice. The parser @p \<|> q@ first--- applies @p@. If it succeeds, the value of @p@ is returned. If @p@--- fails /without consuming any input/, parser @q@ is tried. This--- combinator is defined equal to the 'mplus' member of the 'MonadPlus'--- class and the ('Control.Applicative.<|>') member of 'Control.Applicative.Alternative'.------ The parser is called /predictive/ since @q@ is only tried when--- parser @p@ didn't consume any input (i.e.. the look ahead is 1).--- This non-backtracking behaviour allows for both an efficient--- implementation of the parser combinators and the generation of good--- error messages.--(<|>) :: (Monad m)-      => (ParsecT s u m a) -> (ParsecT s u m a) -> (ParsecT s u m a)-p1 <|> p2 = mplus p1 p2--label :: (Monad m) => ParsecT s u m a -> String -> ParsecT s u m a-label p msg-  = labels p [msg]--labels :: (Monad m) => ParsecT s u m a -> [String] -> ParsecT s u m a-labels p msgs-    = ParsecT $ \s -> do-        r <- runParsecT p s-        case r of-          Empty mReply -> do-            reply <- mReply-            return $ Empty $ case reply of-              Error err-                -> return $ Error (setExpectErrors err msgs)-              Ok x s' err-                | errorIsUnknown err -> return $ reply-                | otherwise -> return (Ok x s' (setExpectErrors err msgs))-          other        -> return $ other-    where-        setExpectErrors err []         = setErrorMessage (Expect "") err-        setExpectErrors err [msg]      = setErrorMessage (Expect msg) err-        setExpectErrors err (msg:msgs)-            = foldr (\msg' err' -> addErrorMessage (Expect msg') err')-                    (setErrorMessage (Expect msg) err) msgs---- TODO: There should be a stronger statement that can be made about this---- | An instance of @Stream@ has stream type @s@, underlying monad @m@ and token type @t@ determined by the stream--- --- Some rough guidelines for a \"correct\" instance of Stream:------    * unfoldM uncons gives the [t] corresponding to the stream------    * A @Stream@ instance is responsible for maintaining the \"position within the stream\" in the stream state @s@.  This is trivial unless you are using the monad in a non-trivial way.--class (Monad m) => Stream s m t | s -> t where-    uncons :: s -> m (Maybe (t,s))--tokens :: (Stream s m t, Eq t)-       => ([t] -> String)      -- Pretty print a list of tokens-       -> (SourcePos -> [t] -> SourcePos)-       -> [t]                  -- List of tokens to parse-       -> ParsecT s u m [t]-tokens _ _ []-    = ParsecT $ \s -> return $ Empty $ return $ Ok [] s (unknownError s)-tokens showTokens nextposs tts@(tok:toks)-    = ParsecT $ \(State input pos u) -> -    let-        errEof = return $ Error (setErrorMessage (Expect (showTokens tts))-                                 (newErrorMessage (SysUnExpect "") pos))-        errExpect x = return $ Error (setErrorMessage (Expect (showTokens tts))-                                 (newErrorMessage (SysUnExpect (showTokens [x])) pos))-        walk []     rs = return (ok rs)-        walk (t:ts) rs = do-          sr <- uncons rs-          case sr of-            Nothing                 -> errEof-            Just (x,xs) | t == x    -> walk ts xs-                        | otherwise -> errExpect x-        ok rs = let pos' = nextposs pos tts-                    s' = State rs pos' u-                in Ok tts s' (newErrorUnknown pos')-    in do-        sr <- uncons input-        return $ case sr of-            Nothing         -> Empty    $ errEof-            Just (x,xs)-                | tok == x    -> Consumed $ walk toks xs-                | otherwise -> Empty    $ errExpect x-        --- | The parser @try p@ behaves like parser @p@, except that it--- pretends that it hasn't consumed any input when an error occurs.------ This combinator is used whenever arbitrary look ahead is needed.--- Since it pretends that it hasn't consumed any input when @p@ fails,--- the ('<|>') combinator will try its second alternative even when the--- first parser failed while consuming input.------ The @try@ combinator can for example be used to distinguish--- identifiers and reserved words. Both reserved words and identifiers--- are a sequence of letters. Whenever we expect a certain reserved--- word where we can also expect an identifier we have to use the @try@--- combinator. Suppose we write:------ >  expr        = letExpr <|> identifier <?> "expression"--- >--- >  letExpr     = do{ string "let"; ... }--- >  identifier  = many1 letter------ If the user writes \"lexical\", the parser fails with: @unexpected--- \'x\', expecting \'t\' in \"let\"@. Indeed, since the ('<|>') combinator--- only tries alternatives when the first alternative hasn't consumed--- input, the @identifier@ parser is never tried (because the prefix--- \"le\" of the @string \"let\"@ parser is already consumed). The--- right behaviour can be obtained by adding the @try@ combinator:------ >  expr        = letExpr <|> identifier <?> "expression"--- >--- >  letExpr     = do{ try (string "let"); ... }--- >  identifier  = many1 letter--try :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m a-try (ParsecT p)-    = ParsecT $ \s@(State _ pos _) -> do-        res <- p s-        case res of-          Consumed rep -> do r <- rep-                             case r of-                               Error err -> return $ Empty $ return $ Error-                                                         (setErrorPos pos err)-                               ok        -> return $ Consumed $ return $ ok-          empty        -> return $ empty---- | The parser @token showTok posFromTok testTok@ accepts a token @t@--- with result @x@ when the function @testTok t@ returns @'Just' x@. The--- source position of the @t@ should be returned by @posFromTok t@ and--- the token can be shown using @showTok t@.------ This combinator is expressed in terms of 'tokenPrim'.--- It is used to accept user defined token streams. For example,--- suppose that we have a stream of basic tokens tupled with source--- positions. We can than define a parser that accepts single tokens as:------ >  mytoken x--- >    = token showTok posFromTok testTok--- >    where--- >      showTok (pos,t)     = show t--- >      posFromTok (pos,t)  = pos--- >      testTok (pos,t)     = if x == t then Just t else Nothing--token :: (Stream s Identity t)-      => (t -> String)            -- ^ Token pretty-printing function.-      -> (t -> SourcePos)         -- ^ Computes the position of a token.-      -> (t -> Maybe a)           -- ^ Matching function for the token to parse.-      -> Parsec s u a-token showToken tokpos test = tokenPrim showToken nextpos test-    where-        nextpos _ tok ts = case runIdentity (uncons ts) of-                             Nothing -> tokpos tok-                             Just (tok',_) -> tokpos tok'---- | The parser @token showTok nextPos testTok@ accepts a token @t@--- with result @x@ when the function @testTok t@ returns @'Just' x@. The--- token can be shown using @showTok t@. The position of the /next/--- token should be returned when @nextPos@ is called with the current--- source position @pos@, the current token @t@ and the rest of the--- tokens @toks@, @nextPos pos t toks@.------ This is the most primitive combinator for accepting tokens. For--- example, the 'Text.Parsec.Char.char' parser could be implemented as:------ >  char c--- >    = tokenPrim showChar nextPos testChar--- >    where--- >      showChar x        = "'" ++ x ++ "'"--- >      testChar x        = if x == c then Just x else Nothing--- >      nextPos pos x xs  = updatePosChar pos x--tokenPrim :: (Stream s m t)-          => (t -> String)                      -- ^ Token pretty-printing function.-          -> (SourcePos -> t -> s -> SourcePos) -- ^ Next position calculating function.-          -> (t -> Maybe a)                     -- ^ Matching function for the token to parse.-          -> ParsecT s u m a-tokenPrim showToken nextpos test = tokenPrimEx showToken nextpos Nothing test--tokenPrimEx :: (Stream s m t)-            => (t -> String)      -            -> (SourcePos -> t -> s -> SourcePos)-            -> Maybe (SourcePos -> t -> s -> u -> u)-            -> (t -> Maybe a)     -            -> ParsecT s u m a-tokenPrimEx showToken nextpos mbNextState test-    = case mbNextState of-        Nothing-          -> ParsecT $ \(State input pos user) -> do-              r <- uncons input-              case r of-                Nothing -> return $ Empty $ return (sysUnExpectError "" pos)-                Just (c,cs)-                  -> case test c of-                       Just x  -> let newpos   = nextpos pos c cs-                                      newstate = State cs newpos user-                                  in seq newpos $ seq newstate $-                                     return $ Consumed $ return $-                                       (Ok x newstate (newErrorUnknown newpos))-                       Nothing -> return $ Empty $ return $-                                    (sysUnExpectError (showToken c) pos)-        Just nextState-          -> ParsecT $ \(State input pos user) -> do-              r <- uncons input-              case r of-                Nothing -> return $ Empty $ return (sysUnExpectError "" pos)-                Just (c,cs)-                  -> case test c of-                       Just x  -> let newpos   = nextpos pos c cs-                                      newuser  = nextState pos c cs user-                                      newstate = State cs newpos newuser-                                  in seq newpos $ seq newstate $-                                     return $ Consumed $ return $-                                       (Ok x newstate (newErrorUnknown newpos))-                       Nothing -> return $ Empty $ return $-                                    (sysUnExpectError (showToken c) pos)---- | @many p@ applies the parser @p@ /zero/ or more times. Returns a---    list of the returned values of @p@.------ >  identifier  = do{ c  <- letter--- >                  ; cs <- many (alphaNum <|> char '_')--- >                  ; return (c:cs)--- >                  }--many :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m [a]-many p-  = do xs <- manyAccum (:) p-       return (reverse xs)---- | @skipMany p@ applies the parser @p@ /zero/ or more times, skipping--- its result.------ >  spaces  = skipMany space--skipMany :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m ()-skipMany p-  = do manyAccum (\_ _ -> []) p-       return ()--manyAccum :: (Stream s m t)-          => (a -> [a] -> [a])-          -> ParsecT s u m a-          -> ParsecT s u m [a]-manyAccum accum p-    = ParsecT $ \s ->-        let walk xs state mr-              = do r <- mr-                   case r of-                     Empty mReply-                         -> do reply <- mReply-                               case reply of-                                 Error err -> return $ Ok xs state err-                                 _         -> error "Text.Parsec.Prim.many: combinator 'many' is applied to a parser that accepts an empty string."-                     Consumed mReply-                         -> do reply <- mReply-                               case reply of-                                 Error err-                                     -> return $ Error err-                                 Ok x s' _err-                                     -> let ys = accum x xs-                                        in seq ys (walk ys s' (runParsecT p s'))-        in do r <- runParsecT p s-              case r of-                Empty mReply-                    -> do reply <- mReply-                          case reply of-                            Ok _ _ _-                                -> error "Text.ParserCombinators.Parsec.Prim.many: combinator 'many' is applied to a parser that accepts an empty string."-                            Error err-                                -> return $ Empty $ return (Ok [] s err)-                consumed-                    -> return $ Consumed $ walk [] s (return consumed)----- < Running a parser: monadic (runPT) and pure (runP)--runPT :: (Stream s m t)-      => ParsecT s u m a -> u -> SourceName -> s -> m (Either ParseError a)-runPT p u name s-    = do res <- runParsecT p (State s (initialPos name) u)-         r <- parserReply res-         case r of-           Ok x _ _  -> return (Right x)-           Error err -> return (Left err)-    where-        parserReply res-            = case res of-                Consumed r -> r-                Empty    r -> r--runP :: (Stream s Identity t)-     => Parsec s u a -> u -> SourceName -> s -> Either ParseError a-runP p u name s = runIdentity $ runPT p u name s---- | The most general way to run a parser. @runParserT p state filePath--- input@ runs parser @p@ on the input list of tokens @input@,--- obtained from source @filePath@ with the initial user state @st@.--- The @filePath@ is only used in error messages and may be the empty--- string. Returns a computation in the underlying monad @m@ that return either a 'ParseError' ('Left') or a--- value of type @a@ ('Right').--runParserT :: (Stream s m t)-           => ParsecT s u m a -> u -> SourceName -> s -> m (Either ParseError a)-runParserT = runPT---- | The most general way to run a parser over the Identity monad. @runParser p state filePath--- input@ runs parser @p@ on the input list of tokens @input@,--- obtained from source @filePath@ with the initial user state @st@.--- The @filePath@ is only used in error messages and may be the empty--- string. Returns either a 'ParseError' ('Left') or a--- value of type @a@ ('Right').------ >  parseFromFile p fname--- >    = do{ input <- readFile fname--- >        ; return (runParser p () fname input)--- >        }--runParser :: (Stream s Identity t)-          => Parsec s u a -> u -> SourceName -> s -> Either ParseError a-runParser = runP---- | @parse p filePath input@ runs a parser @p@ over Identity without user--- state. The @filePath@ is only used in error messages and may be the--- empty string. Returns either a 'ParseError' ('Left')--- or a value of type @a@ ('Right').------ >  main    = case (parse numbers "" "11, 2, 43") of--- >             Left err  -> print err--- >             Right xs  -> print (sum xs)--- >--- >  numbers = commaSep integer--parse :: (Stream s Identity t)-      => Parsec s () a -> SourceName -> s -> Either ParseError a-parse p = runP p ()---- | The expression @parseTest p input@ applies a parser @p@ against--- input @input@ and prints the result to stdout. Used for testing--- parsers.--parseTest :: (Stream s Identity t, Show a)-          => Parsec s () a -> s -> IO ()-parseTest p input-    = case parse p "" input of-        Left err -> do putStr "parse error at "-                       print err-        Right x  -> print x---- < Parser state combinators---- | Returns the current source position. See also 'SourcePos'.--getPosition :: (Monad m) => ParsecT s u m SourcePos-getPosition = do state <- getParserState-                 return (statePos state)---- | Returns the current input --getInput :: (Monad m) => ParsecT s u m s-getInput = do state <- getParserState-              return (stateInput state)---- | @setPosition pos@ sets the current source position to @pos@. --setPosition :: (Monad m) => SourcePos -> ParsecT s u m ()-setPosition pos-    = do updateParserState (\(State input _ user) -> State input pos user)-         return ()---- | @setInput input@ continues parsing with @input@. The 'getInput' and--- @setInput@ functions can for example be used to deal with #include--- files. --setInput :: (Monad m) => s -> ParsecT s u m ()-setInput input-    = do updateParserState (\(State _ pos user) -> State input pos user)-         return ()---- | Returns the full parser state as a 'State' record.--getParserState :: (Monad m) => ParsecT s u m (State s u)-getParserState = updateParserState id---- | @setParserState st@ set the full parser state to @st@. --setParserState :: (Monad m) => State s u -> ParsecT s u m (State s u)-setParserState st = updateParserState (const st)---- | @updateParserState f@ applies function @f@ to the parser state.--updateParserState :: (Monad m)-                  => (State s u -> State s u) -> ParsecT s u m (State s u)-updateParserState f-    = ParsecT $ \s -> let s' = f s-                      in return $ Empty $ return (Ok s' s' (unknownError s'))---- < User state combinators---- | Returns the current user state. --getState :: (Monad m) => ParsecT s u m u-getState = stateUser `liftM` getParserState---- | @putState st@ set the user state to @st@. --putState :: (Monad m) => u -> ParsecT s u m ()-putState u = do updateParserState $ \s -> s { stateUser = u }-                return ()---- | @updateState f@ applies function @f@ to the user state. Suppose--- that we want to count identifiers in a source, we could use the user--- state as:------ >  expr  = do{ x <- identifier--- >            ; updateState (+1)--- >            ; return (Id x)--- >            }--modifyState :: (Monad m) => (u -> u) -> ParsecT s u m ()-modifyState f = do updateParserState $ \s -> s { stateUser = f (stateUser s) }-                   return ()---- XXX Compat---- | An alias for putState for backwards compatibility.--setState :: (Monad m) => u -> ParsecT s u m ()-setState = putState---- | An alias for modifyState for backwards compatibility.--updateState :: (Monad m) => (u -> u) -> ParsecT s u m ()-updateState = modifyState
− Text/Parsec/String.hs 
@@ -1,44 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.Parsec.String--- Copyright   :  (c) Paolo Martini 2007--- License     :  BSD-style (see the file libraries/parsec/LICENSE)--- --- Maintainer  :  derek.a.elkins@gmail.com--- Stability   :  provisional--- Portability :  portable--- --- Make Strings an instance of 'Stream' with 'Char' token type.-----------------------------------------------------------------------------------{-# LANGUAGE FlexibleInstances #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Text.Parsec.String-    ( Parser, GenParser, parseFromFile-    ) where--import Text.Parsec.Error-import Text.Parsec.Prim--instance (Monad m) => Stream [tok] m tok where-    uncons []     = return $ Nothing-    uncons (t:ts) = return $ Just (t,ts)--type Parser = Parsec String ()-type GenParser tok st = Parsec [tok] st---- | @parseFromFile p filePath@ runs a string parser @p@ on the--- input read from @filePath@ using 'Prelude.readFile'. Returns either a 'ParseError'--- ('Left') or a value of type @a@ ('Right').------ >  main    = do{ result <- parseFromFile numbers "digits.txt"--- >              ; case result of--- >                  Left err  -> print err--- >                  Right xs  -> print (sum xs)--- >              }-parseFromFile :: Parser a -> String -> IO (Either ParseError a)-parseFromFile p fname-    = do input <- readFile fname-         return (runP p () fname input)
− Text/Parsec/Token.hs 
@@ -1,722 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.Parsec.Token--- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007--- License     :  BSD-style (see the LICENSE file)--- --- Maintainer  :  derek.a.elkins@gmail.com--- Stability   :  provisional--- Portability :  non-portable (uses local universal quantification: PolymorphicComponents)--- --- A helper module to parse lexical elements (tokens). See 'makeTokenParser'--- for a description of how to use it.--- --------------------------------------------------------------------------------{-# LANGUAGE PolymorphicComponents #-}-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}--module Text.Parsec.Token-    ( LanguageDef-    , GenLanguageDef (..)-    , TokenParser-    , GenTokenParser (..)-    , makeTokenParser-    ) where--import Data.Char ( isAlpha, toLower, toUpper, isSpace, digitToInt )-import Data.List ( nub, sort )-import Control.Monad.Identity-import Text.Parsec.Prim-import Text.Parsec.Char-import Text.Parsec.Combinator---------------------------------------------------------------- Language Definition--------------------------------------------------------------type LanguageDef st = GenLanguageDef String st Identity---- | The @GenLanguageDef@ type is a record that contains all parameterizable--- features of the 'Text.Parsec.Token' module. The module 'Text.Parsec.Language'--- contains some default definitions.--data GenLanguageDef s u m-    = LanguageDef { -    -    -- | Describes the start of a block comment. Use the empty string if the-    -- language doesn't support block comments. For example \"\/*\". --    commentStart   :: String,--    -- | Describes the end of a block comment. Use the empty string if the-    -- language doesn't support block comments. For example \"*\/\". --    commentEnd     :: String,--    -- | Describes the start of a line comment. Use the empty string if the-    -- language doesn't support line comments. For example \"\/\/\". --    commentLine    :: String,--    -- | Set to 'True' if the language supports nested block comments. --    nestedComments :: Bool,--    -- | This parser should accept any start characters of identifiers. For-    -- example @letter \<|> char \"_\"@. --    identStart     :: ParsecT s u m Char,--    -- | This parser should accept any legal tail characters of identifiers.-    -- For example @alphaNum \<|> char \"_\"@. --    identLetter    :: ParsecT s u m Char,--    -- | This parser should accept any start characters of operators. For-    -- example @oneOf \":!#$%&*+.\/\<=>?\@\\\\^|-~\"@ --    opStart        :: ParsecT s u m Char,--    -- | This parser should accept any legal tail characters of operators.-    -- Note that this parser should even be defined if the language doesn't-    -- support user-defined operators, or otherwise the 'reservedOp'-    -- parser won't work correctly. --    opLetter       :: ParsecT s u m Char,--    -- | The list of reserved identifiers. --    reservedNames  :: [String],--    -- | The list of reserved operators. --    reservedOpNames:: [String],--    -- | Set to 'True' if the language is case sensitive. --    caseSensitive  :: Bool--    }---------------------------------------------------------------- A first class module: TokenParser--------------------------------------------------------------type TokenParser st = GenTokenParser String st Identity---- | The type of the record that holds lexical parsers that work on--- @s@ streams with state @u@ over a monad @m@.--data GenTokenParser s u m-    = TokenParser {--        -- | This lexeme parser parses a legal identifier. Returns the identifier-        -- string. This parser will fail on identifiers that are reserved-        -- words. Legal identifier (start) characters and reserved words are-        -- defined in the 'LanguageDef' that is passed to-        -- 'makeTokenParser'. An @identifier@ is treated as-        -- a single token using 'try'.--        identifier       :: ParsecT s u m String,-        -        -- | The lexeme parser @reserved name@ parses @symbol -        -- name@, but it also checks that the @name@ is not a prefix of a-        -- valid identifier. A @reserved@ word is treated as a single token-        -- using 'try'. --        reserved         :: String -> ParsecT s u m (),--        -- | This lexeme parser parses a legal operator. Returns the name of the-        -- operator. This parser will fail on any operators that are reserved-        -- operators. Legal operator (start) characters and reserved operators-        -- are defined in the 'LanguageDef' that is passed to-        -- 'makeTokenParser'. An @operator@ is treated as a-        -- single token using 'try'. --        operator         :: ParsecT s u m String,--        -- |The lexeme parser @reservedOp name@ parses @symbol-        -- name@, but it also checks that the @name@ is not a prefix of a-        -- valid operator. A @reservedOp@ is treated as a single token using-        -- 'try'. --        reservedOp       :: String -> ParsecT s u m (),---        -- | This lexeme parser parses a single literal character. Returns the-        -- literal character value. This parsers deals correctly with escape-        -- sequences. The literal character is parsed according to the grammar-        -- rules defined in the Haskell report (which matches most programming-        -- languages quite closely). --        charLiteral      :: ParsecT s u m Char,--        -- | This lexeme parser parses a literal string. Returns the literal-        -- string value. This parsers deals correctly with escape sequences and-        -- gaps. The literal string is parsed according to the grammar rules-        -- defined in the Haskell report (which matches most programming-        -- languages quite closely). --        stringLiteral    :: ParsecT s u m String,--        -- | This lexeme parser parses a natural number (a positive whole-        -- number). Returns the value of the number. The number can be-        -- specified in 'decimal', 'hexadecimal' or-        -- 'octal'. The number is parsed according to the grammar-        -- rules in the Haskell report. --        natural          :: ParsecT s u m Integer,--        -- | This lexeme parser parses an integer (a whole number). This parser-        -- is like 'natural' except that it can be prefixed with-        -- sign (i.e. \'-\' or \'+\'). Returns the value of the number. The-        -- number can be specified in 'decimal', 'hexadecimal'-        -- or 'octal'. The number is parsed according-        -- to the grammar rules in the Haskell report. -        -        integer          :: ParsecT s u m Integer,--        -- | This lexeme parser parses a floating point value. Returns the value-        -- of the number. The number is parsed according to the grammar rules-        -- defined in the Haskell report. --        float            :: ParsecT s u m Double,--        -- | This lexeme parser parses either 'natural' or a 'float'.-        -- Returns the value of the number. This parsers deals with-        -- any overlap in the grammar rules for naturals and floats. The number-        -- is parsed according to the grammar rules defined in the Haskell report. --        naturalOrFloat   :: ParsecT s u m (Either Integer Double),--        -- | Parses a positive whole number in the decimal system. Returns the-        -- value of the number. --        decimal          :: ParsecT s u m Integer,--        -- | Parses a positive whole number in the hexadecimal system. The number-        -- should be prefixed with \"0x\" or \"0X\". Returns the value of the-        -- number. --        hexadecimal      :: ParsecT s u m Integer,--        -- | Parses a positive whole number in the octal system. The number-        -- should be prefixed with \"0o\" or \"0O\". Returns the value of the-        -- number. --        octal            :: ParsecT s u m Integer,--        -- | Lexeme parser @symbol s@ parses 'string' @s@ and skips-        -- trailing white space. --        symbol           :: String -> ParsecT s u m String,--        -- | @lexeme p@ first applies parser @p@ and than the 'whiteSpace'-        -- parser, returning the value of @p@. Every lexical-        -- token (lexeme) is defined using @lexeme@, this way every parse-        -- starts at a point without white space. Parsers that use @lexeme@ are-        -- called /lexeme/ parsers in this document.-        -- -        -- The only point where the 'whiteSpace' parser should be-        -- called explicitly is the start of the main parser in order to skip-        -- any leading white space.-        ---        -- >    mainParser  = do{ whiteSpace-        -- >                     ; ds <- many (lexeme digit)-        -- >                     ; eof-        -- >                     ; return (sum ds)-        -- >                     }--        lexeme           :: forall a. ParsecT s u m a -> ParsecT s u m a,--        -- | Parses any white space. White space consists of /zero/ or more-        -- occurrences of a 'space', a line comment or a block (multi-        -- line) comment. Block comments may be nested. How comments are-        -- started and ended is defined in the 'LanguageDef'-        -- that is passed to 'makeTokenParser'. --        whiteSpace       :: ParsecT s u m (),--        -- | Lexeme parser @parens p@ parses @p@ enclosed in parenthesis,-        -- returning the value of @p@.--        parens           :: forall a. ParsecT s u m a -> ParsecT s u m a,--        -- | Lexeme parser @braces p@ parses @p@ enclosed in braces (\'{\' and-        -- \'}\'), returning the value of @p@. --        braces           :: forall a. ParsecT s u m a -> ParsecT s u m a,--        -- | Lexeme parser @angles p@ parses @p@ enclosed in angle brackets (\'\<\'-        -- and \'>\'), returning the value of @p@. --        angles           :: forall a. ParsecT s u m a -> ParsecT s u m a,--        -- | Lexeme parser @brackets p@ parses @p@ enclosed in brackets (\'[\'-        -- and \']\'), returning the value of @p@. --        brackets         :: forall a. ParsecT s u m a -> ParsecT s u m a,--        -- | DEPRECATED: Use 'brackets'.--        squares          :: forall a. ParsecT s u m a -> ParsecT s u m a,--        -- | Lexeme parser |semi| parses the character \';\' and skips any-        -- trailing white space. Returns the string \";\". --        semi             :: ParsecT s u m String,--        -- | Lexeme parser @comma@ parses the character \',\' and skips any-        -- trailing white space. Returns the string \",\". --        comma            :: ParsecT s u m String,--        -- | Lexeme parser @colon@ parses the character \':\' and skips any-        -- trailing white space. Returns the string \":\". --        colon            :: ParsecT s u m String,--        -- | Lexeme parser @dot@ parses the character \'.\' and skips any-        -- trailing white space. Returns the string \".\". --        dot              :: ParsecT s u m String,--        -- | Lexeme parser @semiSep p@ parses /zero/ or more occurrences of @p@-        -- separated by 'semi'. Returns a list of values returned by-        -- @p@.--        semiSep          :: forall a . ParsecT s u m a -> ParsecT s u m [a],--        -- | Lexeme parser @semiSep1 p@ parses /one/ or more occurrences of @p@-        -- separated by 'semi'. Returns a list of values returned by @p@. --        semiSep1         :: forall a . ParsecT s u m a -> ParsecT s u m [a],--        -- | Lexeme parser @commaSep p@ parses /zero/ or more occurrences of-        -- @p@ separated by 'comma'. Returns a list of values returned-        -- by @p@. --        commaSep         :: forall a . ParsecT s u m a -> ParsecT s u m [a],--        -- | Lexeme parser @commaSep1 p@ parses /one/ or more occurrences of-        -- @p@ separated by 'comma'. Returns a list of values returned-        -- by @p@. --        commaSep1        :: forall a . ParsecT s u m a -> ParsecT s u m [a]-    }---------------------------------------------------------------- Given a LanguageDef, create a token parser.---------------------------------------------------------------- | The expression @makeTokenParser language@ creates a 'GenTokenParser'--- record that contains lexical parsers that are--- defined using the definitions in the @language@ record.------ The use of this function is quite stylized - one imports the--- appropiate language definition and selects the lexical parsers that--- are needed from the resulting 'GenTokenParser'.------ >  module Main where--- >--- >  import Text.Parsec--- >  import qualified Text.Parsec.Token as P--- >  import Text.Parsec.Language (haskellDef)--- >--- >  -- The parser--- >  ...--- >--- >  expr  =   parens expr--- >        <|> identifier--- >        <|> ...--- >       --- >--- >  -- The lexer--- >  lexer       = P.makeTokenParser haskellDef    --- >      --- >  parens      = P.parens lexer--- >  braces      = P.braces lexer--- >  identifier  = P.identifier lexer--- >  reserved    = P.reserved lexer--- >  ...--makeTokenParser :: (Stream s m Char)-                => GenLanguageDef s u m -> GenTokenParser s u m-makeTokenParser languageDef-    = TokenParser{ identifier = identifier-                 , reserved = reserved-                 , operator = operator-                 , reservedOp = reservedOp--                 , charLiteral = charLiteral-                 , stringLiteral = stringLiteral-                 , natural = natural-                 , integer = integer-                 , float = float-                 , naturalOrFloat = naturalOrFloat-                 , decimal = decimal-                 , hexadecimal = hexadecimal-                 , octal = octal--                 , symbol = symbol-                 , lexeme = lexeme-                 , whiteSpace = whiteSpace--                 , parens = parens-                 , braces = braces-                 , angles = angles-                 , brackets = brackets-                 , squares = brackets-                 , semi = semi-                 , comma = comma-                 , colon = colon-                 , dot = dot-                 , semiSep = semiSep-                 , semiSep1 = semiSep1-                 , commaSep = commaSep-                 , commaSep1 = commaSep1-                 }-    where--    ------------------------------------------------------------    -- Bracketing-    ------------------------------------------------------------    parens p        = between (symbol "(") (symbol ")") p-    braces p        = between (symbol "{") (symbol "}") p-    angles p        = between (symbol "<") (symbol ">") p-    brackets p      = between (symbol "[") (symbol "]") p--    semi            = symbol ";"-    comma           = symbol ","-    dot             = symbol "."-    colon           = symbol ":"--    commaSep p      = sepBy p comma-    semiSep p       = sepBy p semi--    commaSep1 p     = sepBy1 p comma-    semiSep1 p      = sepBy1 p semi---    ------------------------------------------------------------    -- Chars & Strings-    ------------------------------------------------------------    charLiteral     = lexeme (between (char '\'')-                                      (char '\'' <?> "end of character")-                                      characterChar )-                    <?> "character"--    characterChar   = charLetter <|> charEscape-                    <?> "literal character"--    charEscape      = do{ char '\\'; escapeCode }-    charLetter      = satisfy (\c -> (c /= '\'') && (c /= '\\') && (c > '\026'))----    stringLiteral   = lexeme (-                      do{ str <- between (char '"')-                                         (char '"' <?> "end of string")-                                         (many stringChar)-                        ; return (foldr (maybe id (:)) "" str)-                        }-                      <?> "literal string")--    stringChar      =   do{ c <- stringLetter; return (Just c) }-                    <|> stringEscape-                    <?> "string character"--    stringLetter    = satisfy (\c -> (c /= '"') && (c /= '\\') && (c > '\026'))--    stringEscape    = do{ char '\\'-                        ;     do{ escapeGap  ; return Nothing }-                          <|> do{ escapeEmpty; return Nothing }-                          <|> do{ esc <- escapeCode; return (Just esc) }-                        }--    escapeEmpty     = char '&'-    escapeGap       = do{ many1 space-                        ; char '\\' <?> "end of string gap"-                        }----    -- escape codes-    escapeCode      = charEsc <|> charNum <|> charAscii <|> charControl-                    <?> "escape code"--    charControl     = do{ char '^'-                        ; code <- upper-                        ; return (toEnum (fromEnum code - fromEnum 'A'))-                        }--    charNum         = do{ code <- decimal-                                  <|> do{ char 'o'; number 8 octDigit }-                                  <|> do{ char 'x'; number 16 hexDigit }-                        ; return (toEnum (fromInteger code))-                        }--    charEsc         = choice (map parseEsc escMap)-                    where-                      parseEsc (c,code)     = do{ char c; return code }--    charAscii       = choice (map parseAscii asciiMap)-                    where-                      parseAscii (asc,code) = try (do{ string asc; return code })---    -- escape code tables-    escMap          = zip ("abfnrtv\\\"\'") ("\a\b\f\n\r\t\v\\\"\'")-    asciiMap        = zip (ascii3codes ++ ascii2codes) (ascii3 ++ ascii2)--    ascii2codes     = ["BS","HT","LF","VT","FF","CR","SO","SI","EM",-                       "FS","GS","RS","US","SP"]-    ascii3codes     = ["NUL","SOH","STX","ETX","EOT","ENQ","ACK","BEL",-                       "DLE","DC1","DC2","DC3","DC4","NAK","SYN","ETB",-                       "CAN","SUB","ESC","DEL"]--    ascii2          = ['\BS','\HT','\LF','\VT','\FF','\CR','\SO','\SI',-                       '\EM','\FS','\GS','\RS','\US','\SP']-    ascii3          = ['\NUL','\SOH','\STX','\ETX','\EOT','\ENQ','\ACK',-                       '\BEL','\DLE','\DC1','\DC2','\DC3','\DC4','\NAK',-                       '\SYN','\ETB','\CAN','\SUB','\ESC','\DEL']---    ------------------------------------------------------------    -- Numbers-    ------------------------------------------------------------    naturalOrFloat  = lexeme (natFloat) <?> "number"--    float           = lexeme floating   <?> "float"-    integer         = lexeme int        <?> "integer"-    natural         = lexeme nat        <?> "natural"---    -- floats-    floating        = do{ n <- decimal-                        ; fractExponent n-                        }---    natFloat        = do{ char '0'-                        ; zeroNumFloat-                        }-                      <|> decimalFloat--    zeroNumFloat    =  do{ n <- hexadecimal <|> octal-                         ; return (Left n)-                         }-                    <|> decimalFloat-                    <|> fractFloat 0-                    <|> return (Left 0)--    decimalFloat    = do{ n <- decimal-                        ; option (Left n)-                                 (fractFloat n)-                        }--    fractFloat n    = do{ f <- fractExponent n-                        ; return (Right f)-                        }--    fractExponent n = do{ fract <- fraction-                        ; expo  <- option 1.0 exponent'-                        ; return ((fromInteger n + fract)*expo)-                        }-                    <|>-                      do{ expo <- exponent'-                        ; return ((fromInteger n)*expo)-                        }--    fraction        = do{ char '.'-                        ; digits <- many1 digit <?> "fraction"-                        ; return (foldr op 0.0 digits)-                        }-                      <?> "fraction"-                    where-                      op d f    = (f + fromIntegral (digitToInt d))/10.0--    exponent'       = do{ oneOf "eE"-                        ; f <- sign-                        ; e <- decimal <?> "exponent"-                        ; return (power (f e))-                        }-                      <?> "exponent"-                    where-                       power e  | e < 0      = 1.0/power(-e)-                                | otherwise  = fromInteger (10^e)---    -- integers and naturals-    int             = do{ f <- lexeme sign-                        ; n <- nat-                        ; return (f n)-                        }--    sign            =   (char '-' >> return negate)-                    <|> (char '+' >> return id)-                    <|> return id--    nat             = zeroNumber <|> decimal--    zeroNumber      = do{ char '0'-                        ; hexadecimal <|> octal <|> decimal <|> return 0-                        }-                      <?> ""--    decimal         = number 10 digit-    hexadecimal     = do{ oneOf "xX"; number 16 hexDigit }-    octal           = do{ oneOf "oO"; number 8 octDigit  }--    number base baseDigit-        = do{ digits <- many1 baseDigit-            ; let n = foldl (\x d -> base*x + toInteger (digitToInt d)) 0 digits-            ; seq n (return n)-            }--    ------------------------------------------------------------    -- Operators & reserved ops-    ------------------------------------------------------------    reservedOp name =-        lexeme $ try $-        do{ string name-          ; notFollowedBy (opLetter languageDef) <?> ("end of " ++ show name)-          }--    operator =-        lexeme $ try $-        do{ name <- oper-          ; if (isReservedOp name)-             then unexpected ("reserved operator " ++ show name)-             else return name-          }--    oper =-        do{ c <- (opStart languageDef)-          ; cs <- many (opLetter languageDef)-          ; return (c:cs)-          }-        <?> "operator"--    isReservedOp name =-        isReserved (sort (reservedOpNames languageDef)) name---    ------------------------------------------------------------    -- Identifiers & Reserved words-    ------------------------------------------------------------    reserved name =-        lexeme $ try $-        do{ caseString name-          ; notFollowedBy (identLetter languageDef) <?> ("end of " ++ show name)-          }--    caseString name-        | caseSensitive languageDef  = string name-        | otherwise               = do{ walk name; return name }-        where-          walk []     = return ()-          walk (c:cs) = do{ caseChar c <?> msg; walk cs }--          caseChar c  | isAlpha c  = char (toLower c) <|> char (toUpper c)-                      | otherwise  = char c--          msg         = show name---    identifier =-        lexeme $ try $-        do{ name <- ident-          ; if (isReservedName name)-             then unexpected ("reserved word " ++ show name)-             else return name-          }---    ident-        = do{ c <- identStart languageDef-            ; cs <- many (identLetter languageDef)-            ; return (c:cs)-            }-        <?> "identifier"--    isReservedName name-        = isReserved theReservedNames caseName-        where-          caseName      | caseSensitive languageDef  = name-                        | otherwise               = map toLower name---    isReserved names name-        = scan names-        where-          scan []       = False-          scan (r:rs)   = case (compare r name) of-                            LT  -> scan rs-                            EQ  -> True-                            GT  -> False--    theReservedNames-        | caseSensitive languageDef  = sortedNames-        | otherwise               = map (map toLower) sortedNames-        where-          sortedNames   = sort (reservedNames languageDef)----    ------------------------------------------------------------    -- White space & symbols-    ------------------------------------------------------------    symbol name-        = lexeme (string name)--    lexeme p-        = do{ x <- p; whiteSpace; return x  }---    --whiteSpace-    whiteSpace-        | noLine && noMulti  = skipMany (simpleSpace <?> "")-        | noLine             = skipMany (simpleSpace <|> multiLineComment <?> "")-        | noMulti            = skipMany (simpleSpace <|> oneLineComment <?> "")-        | otherwise          = skipMany (simpleSpace <|> oneLineComment <|> multiLineComment <?> "")-        where-          noLine  = null (commentLine languageDef)-          noMulti = null (commentStart languageDef)---    simpleSpace =-        skipMany1 (satisfy isSpace)--    oneLineComment =-        do{ try (string (commentLine languageDef))-          ; skipMany (satisfy (/= '\n'))-          ; return ()-          }--    multiLineComment =-        do { try (string (commentStart languageDef))-           ; inComment-           }--    inComment-        | nestedComments languageDef  = inCommentMulti-        | otherwise                = inCommentSingle--    inCommentMulti-        =   do{ try (string (commentEnd languageDef)) ; return () }-        <|> do{ multiLineComment                     ; inCommentMulti }-        <|> do{ skipMany1 (noneOf startEnd)          ; inCommentMulti }-        <|> do{ oneOf startEnd                       ; inCommentMulti }-        <?> "end of comment"-        where-          startEnd   = nub (commentEnd languageDef ++ commentStart languageDef)--    inCommentSingle-        =   do{ try (string (commentEnd languageDef)); return () }-        <|> do{ skipMany1 (noneOf startEnd)         ; inCommentSingle }-        <|> do{ oneOf startEnd                      ; inCommentSingle }-        <?> "end of comment"-        where-          startEnd   = nub (commentEnd languageDef ++ commentStart languageDef)
− Text/ParserCombinators/Parsec.hs 
@@ -1,41 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.ParserCombinators.Parsec--- Copyright   :  (c) Paolo Martini 2007--- License     :  BSD-style (see the LICENSE file)--- --- Maintainer  :  derek.a.elkins@gmail.com--- Stability   :  provisional--- Portability :  portable--- --- Parsec compatibility module--- --------------------------------------------------------------------------------module Text.ParserCombinators.Parsec-    ( -- complete modules-      module Text.ParserCombinators.Parsec.Prim-    , module Text.ParserCombinators.Parsec.Combinator-    , module Text.ParserCombinators.Parsec.Char--    -- module Text.ParserCombinators.Parsec.Error-    , ParseError-    , errorPos--    -- module Text.ParserCombinators.Parsec.Pos-    , SourcePos-    , SourceName, Line, Column-    , sourceName, sourceLine, sourceColumn-    , incSourceLine, incSourceColumn-    , setSourceLine, setSourceColumn, setSourceName--    ) where--import Text.Parsec.String()--import Text.ParserCombinators.Parsec.Prim-import Text.ParserCombinators.Parsec.Combinator-import Text.ParserCombinators.Parsec.Char--import Text.ParserCombinators.Parsec.Error-import Text.ParserCombinators.Parsec.Pos
− Text/ParserCombinators/Parsec/Char.hs 
@@ -1,40 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.ParserCombinators.Parsec.Char--- Copyright   :  (c) Paolo Martini 2007--- License     :  BSD-style (see the LICENSE file)--- --- Maintainer  :  derek.a.elkins@gmail.com--- Stability   :  provisional--- Portability :  portable--- --- Parsec compatibility module--- --------------------------------------------------------------------------------module Text.ParserCombinators.Parsec.Char-    ( CharParser,-      spaces,-      space,-      newline,-      tab,-      upper,-      lower,-      alphaNum,-      letter,-      digit,-      hexDigit,-      octDigit,-      char,-      string,-      anyChar,-      oneOf,-      noneOf,-      satisfy-    ) where---import Text.Parsec.Char-import Text.Parsec.String--type CharParser st = GenParser Char st
− Text/ParserCombinators/Parsec/Combinator.hs 
@@ -1,42 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.ParserCombinators.Parsec.Combinator--- Copyright   :  (c) Paolo Martini 2007--- License     :  BSD-style (see the LICENSE file)--- --- Maintainer  :  derek.a.elkins@gmail.com--- Stability   :  provisional--- Portability :  portable--- --- Parsec compatibility module--- --------------------------------------------------------------------------------module Text.ParserCombinators.Parsec.Combinator-    ( choice,-      count,-      between,-      option,-      optionMaybe,-      optional,-      skipMany1,-      many1,-      sepBy,-      sepBy1,-      endBy,-      endBy1,-      sepEndBy,-      sepEndBy1,-      chainl,-      chainl1,-      chainr,-      chainr1,-      eof,-      notFollowedBy,-      manyTill,-      lookAhead,-      anyToken-    ) where---import Text.Parsec.Combinator
− Text/ParserCombinators/Parsec/Error.hs 
@@ -1,40 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.ParserCombinators.Parsec.Error--- Copyright   :  (c) Paolo Martini 2007--- License     :  BSD-style (see the LICENSE file)--- --- Maintainer  :  derek.a.elkins@gmail.com--- Stability   :  provisional--- Portability :  portable--- --- Parsec compatibility module--- --------------------------------------------------------------------------------module Text.ParserCombinators.Parsec.Error-    ( Message (SysUnExpect,UnExpect,Expect,Message),-      messageString,-      messageCompare,-      messageEq,-      ParseError,-      errorPos,-      errorMessages,-      errorIsUnknown,-      showErrorMessages,-      newErrorMessage,-      newErrorUnknown,-      addErrorMessage,-      setErrorPos,-      setErrorMessage,-      mergeError-    ) where--import Text.Parsec.Error---messageCompare :: Message -> Message -> Ordering-messageCompare = compare--messageEq :: Message -> Message -> Bool-messageEq = (==)
− Text/ParserCombinators/Parsec/Expr.hs 
@@ -1,42 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.ParserCombinators.Parsec.Expr--- Copyright   :  (c) Paolo Martini 2007--- License     :  BSD-style (see the LICENSE file)--- --- Maintainer  :  derek.a.elkins@gmail.com--- Stability   :  provisional--- Portability :  portable--- --- Parsec compatibility module--- --------------------------------------------------------------------------------module Text.ParserCombinators.Parsec.Expr-    ( Assoc (AssocNone,AssocLeft,AssocRight),-      Operator(..),-      OperatorTable,-      buildExpressionParser-    ) where--import Text.Parsec.Expr(Assoc(..))-import qualified Text.Parsec.Expr as N-import Text.ParserCombinators.Parsec(GenParser)--import Control.Monad.Identity--data Operator tok st a   = Infix  (GenParser tok st (a -> a -> a)) Assoc-                         | Prefix (GenParser tok st (a -> a))-                         | Postfix (GenParser tok st (a -> a))--type OperatorTable tok st a = [[Operator tok st a]]--convert :: Operator tok st a -> N.Operator [tok] st Identity a-convert (Infix p a) = N.Infix p a-convert (Prefix p)  = N.Prefix p-convert (Postfix p)  = N.Postfix p--buildExpressionParser :: OperatorTable tok st a-                      -> GenParser tok st a-                      -> GenParser tok st a-buildExpressionParser = N.buildExpressionParser . map (map convert)
− Text/ParserCombinators/Parsec/Language.hs 
@@ -1,28 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.ParserCombinators.Parsec.Language--- Copyright   :  (c) Paolo Martini 2007--- License     :  BSD-style (see the LICENSE file)--- --- Maintainer  :  derek.a.elkins@gmail.com--- Stability   :  provisional--- Portability :  portable--- --- Parsec compatibility module--- --------------------------------------------------------------------------------module Text.ParserCombinators.Parsec.Language-    ( haskellDef,-      haskell,-      mondrianDef,-      mondrian,-      emptyDef,-      haskellStyle,-      javaStyle,-      LanguageDef,-      GenLanguageDef(..),-    ) where--import Text.Parsec.Token-import Text.Parsec.Language
− Text/ParserCombinators/Parsec/Perm.hs 
@@ -1,24 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.ParserCombinators.Parsec.Perm--- Copyright   :  (c) Paolo Martini 2007--- License     :  BSD-style (see the LICENSE file)--- --- Maintainer  :  derek.a.elkins@gmail.com--- Stability   :  provisional--- Portability :  portable--- --- Parsec compatibility module--- --------------------------------------------------------------------------------module Text.ParserCombinators.Parsec.Perm-    ( PermParser,-      permute,-      (<||>),-      (<$$>),-      (<|?>),-      (<$?>)-    ) where--import Text.Parsec.Perm
− Text/ParserCombinators/Parsec/Pos.hs 
@@ -1,35 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.ParserCombinators.Parsec.Pos--- Copyright   :  (c) Paolo Martini 2007--- License     :  BSD-style (see the LICENSE file)--- --- Maintainer  :  derek.a.elkins@gmail.com--- Stability   :  provisional--- Portability :  portable--- --- Parsec compatibility module--- --------------------------------------------------------------------------------module Text.ParserCombinators.Parsec.Pos-    ( SourceName,-      Line,-      Column,-      SourcePos,-      sourceLine,-      sourceColumn,-      sourceName,-      incSourceLine,-      incSourceColumn,-      setSourceLine,-      setSourceColumn,-      setSourceName,-      newPos,-      initialPos,-      updatePosChar,-      updatePosString-    ) where-      --import Text.Parsec.Pos
− Text/ParserCombinators/Parsec/Prim.hs 
@@ -1,65 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.ParserCombinators.Parsec.Prim--- Copyright   :  (c) Paolo Martini 2007--- License     :  BSD-style (see the LICENSE file)--- --- Maintainer  :  derek.a.elkins@gmail.com--- Stability   :  provisional--- Portability :  portable--- --- Parsec compatibility module--- --------------------------------------------------------------------------------module Text.ParserCombinators.Parsec.Prim-    ( (<?>),-      (<|>),-      Parser,-      GenParser,-      runParser,-      parse,-      parseFromFile,-      parseTest,-      token,-      tokens,-      tokenPrim,-      tokenPrimEx,-      try,-      label,-      labels,-      unexpected,-      pzero,-      many,-      skipMany,-      getState,-      setState,-      updateState,-      getPosition,-      setPosition,-      getInput,-      setInput,-      State(..),-      getParserState,-      setParserState-    ) where--import Text.Parsec.Prim hiding (runParser, try)-import qualified Text.Parsec.Prim as N -- 'N' for 'New'-import Text.Parsec.String--import Text.Parsec.Error-import Text.Parsec.Pos--pzero :: GenParser tok st a-pzero = parserZero--runParser :: GenParser tok st a-          -> st-          -> SourceName-          -> [tok]-          -> Either ParseError a-runParser = N.runParser--try :: GenParser tok st a -> GenParser tok st a-try = N.try
− Text/ParserCombinators/Parsec/Token.hs 
@@ -1,23 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Text.ParserCombinators.Parsec.Token--- Copyright   :  (c) Paolo Martini 2007--- License     :  BSD-style (see the LICENSE file)--- --- Maintainer  :  derek.a.elkins@gmail.com--- Stability   :  provisional--- Portability :  portable--- --- Parsec compatibility module--- --------------------------------------------------------------------------------module Text.ParserCombinators.Parsec.Token-    ( LanguageDef,-      GenLanguageDef(..),-      TokenParser,-      GenTokenParser(..),-      makeTokenParser-    ) where--import Text.Parsec.Token
parsec.cabal view
@@ -1,56 +1,179 @@-name:		parsec-version:	3.0.1-cabal-version: >= 1.2.3-license:	BSD3-license-file:	LICENSE-author:		Daan Leijen <daan@cs.uu.nl>, Paolo Martini <paolo@nemail.it>-maintainer:	Derek Elkins <derek.a.elkins@gmail.com>-homepage:	http://www.cs.uu.nl/~daan/parsec.html-category:	Parsing-synopsis:	Monadic parser combinators-build-type: Simple+cabal-version:      1.12+name:               parsec+version:            3.1.18.0+synopsis:           Monadic parser combinators description:-	Parsec is designed from scratch as an industrial-strength parser-	library.  It is simple, safe, well documented (on the package-	homepage), has extensive libraries and good error messages,-	and is also fast.  It is defined as a monad transformer that can be-	stacked on arbitrary monads, and it is also parametric in the-	input stream type.+  Parsec is designed from scratch as an industrial-strength parser+  library.  It is simple, safe, well documented (on the package+  homepage), has extensive libraries, good error messages,+  and is fast.  It is defined as a monad transformer that can be+  stacked on arbitrary monads, and it is also parametric in the+  input stream type.+  .+  The main entry point is the "Text.Parsec" module which provides+  defaults for parsing 'Char'acter data.+  .+  The "Text.ParserCombinators.Parsec" module hierarchy contains+  the legacy @parsec-2@ API and may be removed at some point in+  the future. -flag base4-    Description: Use base-4.*-    Default:    True+license:            BSD2+license-file:       LICENSE+author:+  Daan Leijen <daan@microsoft.com>, Paolo Martini <paolo@nemail.it>, Antoine Latter <aslatter@gmail.com> -library    -    exposed-modules:-        Text.Parsec,-        Text.Parsec.String,-        Text.Parsec.ByteString,-        Text.Parsec.ByteString.Lazy,-        Text.Parsec.Pos,-        Text.Parsec.Error,-        Text.Parsec.Prim,-        Text.Parsec.Char,-        Text.Parsec.Combinator,-        Text.Parsec.Token,-        Text.Parsec.Expr,-        Text.Parsec.Language,-        Text.Parsec.Perm,-        Text.ParserCombinators.Parsec,-        Text.ParserCombinators.Parsec.Char,-        Text.ParserCombinators.Parsec.Combinator,-        Text.ParserCombinators.Parsec.Error,-        Text.ParserCombinators.Parsec.Expr,-        Text.ParserCombinators.Parsec.Language,-        Text.ParserCombinators.Parsec.Perm,-        Text.ParserCombinators.Parsec.Pos,-        Text.ParserCombinators.Parsec.Prim,-        Text.ParserCombinators.Parsec.Token-    if flag(base4)-        build-depends: base >= 4 && < 5, syb-    else-        build-depends: base >= 3.0.3 && < 4-    build-depends: mtl, bytestring-    extensions:	ExistentialQuantification, PolymorphicComponents, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, DeriveDataTypeable-    ghc-options:	-O2-    ghc-prof-options:	-auto-all+maintainer:+  Oleg Grenrus <oleg.grenrus@iki.fi>, Herbert Valerio Riedel <hvr@gnu.org>++homepage:           https://github.com/haskell/parsec+bug-reports:        https://github.com/haskell/parsec/issues+category:           Parsing+build-type:         Simple+tested-with:+  GHC ==8.6.5+   || ==8.8.4+   || ==8.10.7+   || ==9.0.2+   || ==9.2.8+   || ==9.4.8+   || ==9.6.4+   || ==9.8.2+   || ==9.10.1+   || ==9.12.1++extra-source-files:+  ChangeLog.md+  README.md++source-repository head+  type:     git+  location: https://github.com/haskell/parsec++library+  hs-source-dirs:   src+  exposed-modules:+    Text.Parsec+    Text.Parsec.ByteString+    Text.Parsec.ByteString.Lazy+    Text.Parsec.Char+    Text.Parsec.Combinator+    Text.Parsec.Error+    Text.Parsec.Expr+    Text.Parsec.Language+    Text.Parsec.Perm+    Text.Parsec.Pos+    Text.Parsec.Prim+    Text.Parsec.String+    Text.Parsec.Text+    Text.Parsec.Text.Lazy+    Text.Parsec.Token+    Text.ParserCombinators.Parsec+    Text.ParserCombinators.Parsec.Char+    Text.ParserCombinators.Parsec.Combinator+    Text.ParserCombinators.Parsec.Error+    Text.ParserCombinators.Parsec.Expr+    Text.ParserCombinators.Parsec.Language+    Text.ParserCombinators.Parsec.Perm+    Text.ParserCombinators.Parsec.Pos+    Text.ParserCombinators.Parsec.Prim+    Text.ParserCombinators.Parsec.Token++  build-depends:+      base        >=4.12.0.0 && <4.22+    , bytestring  >=0.10.8.2 && <0.13+    , mtl         >=2.2.2    && <2.4+    , text        >=1.2.3.0  && <1.3  || >=2.0 && <2.2++  default-language: Haskell2010+  other-extensions:+    CPP+    DeriveDataTypeable+    ExistentialQuantification+    FlexibleContexts+    FlexibleInstances+    FunctionalDependencies+    MultiParamTypeClasses+    PolymorphicComponents+    Safe+    StandaloneDeriving+    Trustworthy+    UndecidableInstances++  ghc-options:      -Wall+  ghc-options:+    -Wcompat -Wnoncanonical-monad-instances -Wno-trustworthy-safe++  if impl(ghc <8.8)+    ghc-options: -Wnoncanonical-monadfail-instances++-- these flags may abort compilation with GHC-8.10+-- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3295+-- https://gitlab.haskell.org/ghc/ghc/-/issues/22728+-- if impl(ghc >= 9.0)+--    -- ghc-options: -Winferred-safe-imports -Wmissing-safe-haskell-mode++test-suite parsec-tests+  type:             exitcode-stdio-1.0+  hs-source-dirs:   test+  main-is:          Main.hs+  other-modules:+    Bugs+    Bugs.Bug2+    Bugs.Bug35+    Bugs.Bug6+    Bugs.Bug9+    Features+    Features.Feature150+    Features.Feature80+    Util++  build-depends:+      base+    , mtl+    , parsec+    , tasty        >=1.4  && <1.6+    , tasty-hunit  >=0.10 && <0.11++  -- dependencies whose version bounds are not inherited via lib:parsec+  default-language: Haskell2010+  ghc-options:      -Wall++  if impl(ghc >=8.0)+    ghc-options:+      -Wcompat -Wnoncanonical-monad-instances+      -Wnoncanonical-monadfail-instances++  else+    build-depends: semigroups++test-suite parsec-issue127+  default-language: Haskell2010+  type:             exitcode-stdio-1.0+  main-is:          issue127.hs+  hs-source-dirs:   test+  build-depends:+      base+    , parsec++test-suite parsec-issue171+  default-language: Haskell2010+  type:             exitcode-stdio-1.0+  main-is:          issue171.hs+  hs-source-dirs:   test+  build-depends:+      base+    , deepseq+    , parsec+    , tasty+    , tasty-hunit++test-suite parsec-issue175+  default-language: Haskell2010+  type:             exitcode-stdio-1.0+  main-is:          issue175.hs+  hs-source-dirs:   test+  build-depends:+      base+    , parsec+    , tasty+    , tasty-hunit
+ src/Text/Parsec.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE Safe #-}++{-|+Module      :  Text.Parsec+Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007+License     :  BSD-style (see the LICENSE file)++Maintainer  :  aslatter@gmail.com+Stability   :  provisional+Portability :  portable++This module includes everything you need to get started writing a+parser.++By default this module is set up to parse character data. If you'd like+to parse the result of your own tokenizer you should start with the following+imports:++@+ import Text.Parsec.Prim+ import Text.Parsec.Combinator+@++Then you can implement your own version of 'satisfy' on top of the 'tokenPrim'+primitive.++-}++module Text.Parsec+    ( -- * Parsers+      ParsecT+    , Parsec+    , token+    , tokens+    , runParserT+    , runParser+    , parse+    , parseTest+    , getPosition+    , getInput+    , getState+    , putState+    , modifyState+     -- * Combinators+    , (<|>)+    , (<?>)+    , label+    , labels+    , try+    , unexpected+    , choice+    , many+    , many1+    , skipMany+    , skipMany1+    , count+    , between+    , option+    , optionMaybe+    , optional+    , sepBy+    , sepBy1+    , endBy+    , endBy1+    , sepEndBy+    , sepEndBy1+    , chainl+    , chainl1+    , chainr+    , chainr1+    , eof+    , notFollowedBy+    , manyTill+    , lookAhead+    , anyToken+     -- * Character Parsing+    , module Text.Parsec.Char+     -- * Error messages+    , ParseError+    , errorPos+     -- * Position+    , SourcePos+    , SourceName, Line, Column+    , sourceName, sourceLine, sourceColumn+    , incSourceLine, incSourceColumn+    , setSourceLine, setSourceColumn, setSourceName+     -- * Debugging+     --+     -- | As a more comprehensive alternative for debugging Parsec parsers,+     -- there's also the [parsec-free](http://hackage.haskell.org/package/parsec-free)+     -- package.+     --+    , parserTrace, parserTraced+     -- * Low-level operations+    , manyAccum+    , tokenPrim+    , tokenPrimEx+    , runPT+    , unknownError+    , sysUnExpectError+    , mergeErrorReply+    , getParserState+    , setParserState+    , updateParserState+    , Stream (..)+    , runParsecT+    , mkPT+    , runP+    , Consumed (..)+    , Reply (..)+    , State (..)+    , setPosition+    , setInput+     -- * Other stuff+    , setState+    , updateState+    , parsecMap+    , parserReturn+    , parserBind+    , parserFail+    , parserZero+    , parserPlus+    ) where++import Text.Parsec.Pos+import Text.Parsec.Error+import Text.Parsec.Prim+import Text.Parsec.Char+import Text.Parsec.Combinator
+ src/Text/Parsec/ByteString.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Parsec.ByteString+-- Copyright   :  (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+--+-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  portable+--+-- Convenience definitions for working with 'C.ByteString's.+--+-----------------------------------------------------------------------------++module Text.Parsec.ByteString+    ( Parser, GenParser, parseFromFile+    ) where++import qualified Data.ByteString.Char8 as C++import Text.Parsec.Error+import Text.Parsec.Prim++type Parser = Parsec C.ByteString ()+type GenParser t st = Parsec C.ByteString st++-- | @parseFromFile p filePath@ runs a strict bytestring parser @p@ on the+-- input read from @filePath@ using 'ByteString.Char8.readFile'. Returns either a 'ParseError'+-- ('Left') or a value of type @a@ ('Right').+--+-- >  main    = do{ result <- parseFromFile numbers "digits.txt"+-- >              ; case result of+-- >                  Left err  -> print err+-- >                  Right xs  -> print (sum xs)+-- >              }++parseFromFile :: Parser a -> FilePath -> IO (Either ParseError a)+parseFromFile p fname+    = do input <- C.readFile fname+         return (runP p () fname input)
+ src/Text/Parsec/ByteString/Lazy.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Parsec.ByteString.Lazy+-- Copyright   :  (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+--+-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  portable+--+-- Convenience definitions for working with lazy 'C.ByteString's.+--+-----------------------------------------------------------------------------++module Text.Parsec.ByteString.Lazy+    ( Parser, GenParser, parseFromFile+    ) where++import qualified Data.ByteString.Lazy.Char8 as C++import Text.Parsec.Error+import Text.Parsec.Prim++type Parser = Parsec C.ByteString ()+type GenParser t st = Parsec C.ByteString st++-- | @parseFromFile p filePath@ runs a lazy bytestring parser @p@ on the+-- input read from @filePath@ using 'ByteString.Lazy.Char8.readFile'. Returns either a 'ParseError'+-- ('Left') or a value of type @a@ ('Right').+--+-- >  main    = do{ result <- parseFromFile numbers "digits.txt"+-- >              ; case result of+-- >                  Left err  -> print err+-- >                  Right xs  -> print (sum xs)+-- >              }++parseFromFile :: Parser a -> FilePath -> IO (Either ParseError a)+parseFromFile p fname+    = do input <- C.readFile fname+         return (runP p () fname input)
+ src/Text/Parsec/Char.hs view
@@ -0,0 +1,189 @@+{-# LANGUAGE FlexibleContexts, Safe #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Parsec.Char+-- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+--+-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  portable+--+-- Commonly used character parsers.+--+-----------------------------------------------------------------------------++module Text.Parsec.Char where++import Data.Char (isSpace, isUpper, isLower, isAlphaNum, isAlpha, isDigit, isHexDigit, isOctDigit)++import Text.Parsec.Pos+import Text.Parsec.Prim++-- | @oneOf cs@ succeeds if the current character is in the supplied+-- list of characters @cs@. Returns the parsed character. See also+-- 'satisfy'.+--+-- >   vowel  = oneOf "aeiou"++oneOf :: (Stream s m Char) => [Char] -> ParsecT s u m Char+{-# INLINABLE oneOf #-}+oneOf cs            = satisfy (\c -> elem c cs)++-- | As the dual of 'oneOf', @noneOf cs@ succeeds if the current+-- character /not/ in the supplied list of characters @cs@. Returns the+-- parsed character.+--+-- >  consonant = noneOf "aeiou"++noneOf :: (Stream s m Char) => [Char] -> ParsecT s u m Char+{-# INLINABLE noneOf #-}+noneOf cs           = satisfy (\c -> not (elem c cs))++-- | Skips /zero/ or more white space characters. See also 'skipMany'.++spaces :: (Stream s m Char) => ParsecT s u m ()+{-# INLINABLE spaces #-}+spaces              = skipMany space        <?> "white space"++-- | Parses a white space character (any character which satisfies 'isSpace')+-- Returns the parsed character.++space :: (Stream s m Char) => ParsecT s u m Char+{-# INLINABLE space #-}+space               = satisfy isSpace       <?> "space"++-- | Parses a newline character (\'\\n\'). Returns a newline character.++newline :: (Stream s m Char) => ParsecT s u m Char+{-# INLINABLE newline #-}+newline             = char '\n'             <?> "lf new-line"++-- | Parses a carriage return character (\'\\r\') followed by a newline character (\'\\n\').+-- Returns a newline character.++crlf :: (Stream s m Char) => ParsecT s u m Char+{-# INLINABLE crlf #-}+crlf                = char '\r' *> char '\n' <?> "crlf new-line"++-- | Parses a CRLF (see 'crlf') or LF (see 'newline') end-of-line.+-- Returns a newline character (\'\\n\').+--+-- > endOfLine = newline <|> crlf+--++endOfLine :: (Stream s m Char) => ParsecT s u m Char+{-# INLINABLE endOfLine #-}+endOfLine           = newline <|> crlf       <?> "new-line"++-- | Parses a tab character (\'\\t\'). Returns a tab character.++tab :: (Stream s m Char) => ParsecT s u m Char+{-# INLINABLE tab #-}+tab                 = char '\t'             <?> "tab"++-- | Parses an upper case letter (according to 'isUpper').+-- Returns the parsed character.++upper :: (Stream s m Char) => ParsecT s u m Char+{-# INLINABLE upper #-}+upper               = satisfy isUpper       <?> "uppercase letter"++-- | Parses a lower case character (according to 'isLower').+-- Returns the parsed character.++lower :: (Stream s m Char) => ParsecT s u m Char+{-# INLINABLE lower #-}+lower               = satisfy isLower       <?> "lowercase letter"++-- | Parses a alphabetic or numeric Unicode characters+-- according to 'isAlphaNum'. Returns the parsed character.+--+-- Note that numeric digits outside the ASCII range (such as arabic-indic digits like e.g. \"٤\" or @U+0664@),+-- as well as numeric characters which aren't digits, are parsed by this function+-- but not by 'digit'.++alphaNum :: (Stream s m Char => ParsecT s u m Char)+{-# INLINABLE alphaNum #-}+alphaNum            = satisfy isAlphaNum    <?> "letter or digit"++-- | Parses an alphabetic Unicode characters (lower-case, upper-case and title-case letters,+-- plus letters of caseless scripts and modifiers letters according to 'isAlpha').+-- Returns the parsed character.++letter :: (Stream s m Char) => ParsecT s u m Char+{-# INLINABLE letter #-}+letter              = satisfy isAlpha       <?> "letter"++-- | Parses an ASCII digit. Returns the parsed character.++digit :: (Stream s m Char) => ParsecT s u m Char+{-# INLINABLE digit #-}+digit               = satisfy isDigit       <?> "digit"++-- | Parses a hexadecimal digit (a digit or a letter between \'a\' and+-- \'f\' or \'A\' and \'F\'). Returns the parsed character.++hexDigit :: (Stream s m Char) => ParsecT s u m Char+{-# INLINABLE hexDigit #-}+hexDigit            = satisfy isHexDigit    <?> "hexadecimal digit"++-- | Parses an octal digit (a character between \'0\' and \'7\'). Returns+-- the parsed character.++octDigit :: (Stream s m Char) => ParsecT s u m Char+{-# INLINABLE octDigit #-}+octDigit            = satisfy isOctDigit    <?> "octal digit"++-- | @char c@ parses a single character @c@. Returns the parsed+-- character (i.e. @c@).+--+-- >  semiColon  = char ';'++char :: (Stream s m Char) => Char -> ParsecT s u m Char+{-# INLINABLE char #-}+char c              = satisfy (==c)  <?> show [c]++-- | This parser succeeds for any character. Returns the parsed character.++anyChar :: (Stream s m Char) => ParsecT s u m Char+{-# INLINABLE anyChar #-}+anyChar             = satisfy (const True)++-- | The parser @satisfy f@ succeeds for any character for which the+-- supplied function @f@ returns 'True'. Returns the character that is+-- actually parsed.++-- >  digit     = satisfy isDigit+-- >  oneOf cs  = satisfy (\c -> c `elem` cs)++satisfy :: (Stream s m Char) => (Char -> Bool) -> ParsecT s u m Char+{-# INLINABLE satisfy #-}+satisfy f           = tokenPrim (\c -> show [c])+                                (\pos c _cs -> updatePosChar pos c)+                                (\c -> if f c then Just c else Nothing)++-- | @'string' s@ parses a sequence of characters given by @s@. Returns+-- the parsed string (i.e. @s@).+--+-- >  divOrMod    =   string "div"+-- >              <|> string "mod"+--+-- Consider using 'string''.++string :: (Stream s m Char) => String -> ParsecT s u m String+{-# INLINABLE string #-}+string s            = tokens show updatePosString s++-- | @'string'' s@ parses a sequence of characters given by @s@.+-- Doesn't consume matching prefix.+--+-- >  carOrCdr    =   string' "car"+-- >              <|> string' "cdr"+--+-- @since 3.1.16.0++string' :: (Stream s m Char) => String -> ParsecT s u m String+{-# INLINABLE string' #-}+string' s            = tokens' show updatePosString s
+ src/Text/Parsec/Combinator.hs view
@@ -0,0 +1,344 @@+-- due to Debug.Trace+{-# LANGUAGE Trustworthy #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Parsec.Combinator+-- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+--+-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  portable+--+-- Commonly used generic combinators.+--+-- See also the [parser-combinators](http://hackage.haskell.org/package/parser-combinators)+-- package for additional (and generalised) combinators.+--+-----------------------------------------------------------------------------++module Text.Parsec.Combinator+    ( choice+    , count+    , between+    , option, optionMaybe, optional+    , skipMany1+    , many1+    , sepBy, sepBy1+    , endBy, endBy1+    , sepEndBy, sepEndBy1+    , chainl, chainl1+    , chainr, chainr1+    , eof, notFollowedBy+    -- tricky combinators+    , manyTill, lookAhead, anyToken+    -- * Debugging+    --+    -- | As a more comprehensive alternative for debugging Parsec parsers,+    -- there's also the [parsec-free](http://hackage.haskell.org/package/parsec-free)+    -- package.+    --+    , parserTrace, parserTraced+    ) where++import Control.Monad (mzero, liftM)+import Debug.Trace (trace)++import Text.Parsec.Prim++-- | @choice ps@ tries to apply the parsers in the list @ps@ in order,+-- until one of them succeeds. Returns the value of the succeeding+-- parser.++choice :: (Stream s m t) => [ParsecT s u m a] -> ParsecT s u m a+{-# INLINABLE choice #-}+choice ps           = foldr (<|>) mzero ps++-- | @option x p@ tries to apply parser @p@. If @p@ fails without+-- consuming input, it returns the value @x@, otherwise the value+-- returned by @p@.+--+-- >  priority  = option 0 (do{ d <- digit+-- >                          ; return (digitToInt d)+-- >                          })++option :: (Stream s m t) => a -> ParsecT s u m a -> ParsecT s u m a+{-# INLINABLE option #-}+option x p          = p <|> return x++-- | @optionMaybe p@ tries to apply parser @p@.  If @p@ fails without+-- consuming input, it return 'Nothing', otherwise it returns+-- 'Just' the value returned by @p@.++optionMaybe :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (Maybe a)+{-# INLINABLE optionMaybe #-}+optionMaybe p       = option Nothing (liftM Just p)++-- | @optional p@ tries to apply parser @p@.  It will parse @p@ or nothing.+-- It only fails if @p@ fails after consuming input. It discards the result+-- of @p@.++optional :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m ()+{-# INLINABLE optional #-}+optional p          = do{ _ <- p; return ()} <|> return ()++-- | @between open close p@ parses @open@, followed by @p@ and @close@.+-- Returns the value returned by @p@.+--+-- >  braces  = between (symbol "{") (symbol "}")++between :: (Stream s m t) => ParsecT s u m open -> ParsecT s u m close+            -> ParsecT s u m a -> ParsecT s u m a+{-# INLINABLE between #-}+between open close p+                    = do{ _ <- open; x <- p; _ <- close; return x }++-- | @skipMany1 p@ applies the parser @p@ /one/ or more times, skipping+-- its result.++skipMany1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m ()+{-# INLINABLE skipMany1 #-}+skipMany1 p         = do{ _ <- p; skipMany p }+{-+skipMany p          = scan+                    where+                      scan  = do{ p; scan } <|> return ()+-}++-- | @sepBy p sep@ parses /zero/ or more occurrences of @p@, separated+-- by @sep@. Returns a list of values returned by @p@.+--+-- >  commaSep p  = p `sepBy` (symbol ",")++sepBy :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]+{-# INLINABLE sepBy #-}+sepBy p sep         = sepBy1 p sep <|> return []++-- | @sepBy1 p sep@ parses /one/ or more occurrences of @p@, separated+-- by @sep@. Returns a list of values returned by @p@.++sepBy1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]+{-# INLINABLE sepBy1 #-}+sepBy1 p sep        = do{ x <- p+                        ; xs <- many (sep >> p)+                        ; return (x:xs)+                        }+++-- | @sepEndBy1 p sep@ parses /one/ or more occurrences of @p@,+-- separated and optionally ended by @sep@. Returns a list of values+-- returned by @p@.++sepEndBy1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]+{-# INLINABLE sepEndBy1 #-}+sepEndBy1 p sep     = do{ x <- p+                        ; do{ _ <- sep+                            ; xs <- sepEndBy p sep+                            ; return (x:xs)+                            }+                          <|> return [x]+                        }++-- | @sepEndBy p sep@ parses /zero/ or more occurrences of @p@,+-- separated and optionally ended by @sep@, ie. haskell style+-- statements. Returns a list of values returned by @p@.+--+-- >  haskellStatements  = haskellStatement `sepEndBy` semi++sepEndBy :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]+{-# INLINABLE sepEndBy #-}+sepEndBy p sep      = sepEndBy1 p sep <|> return []+++-- | @endBy1 p sep@ parses /one/ or more occurrences of @p@, separated+-- and ended by @sep@. Returns a list of values returned by @p@.++endBy1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]+{-# INLINABLE endBy1 #-}+endBy1 p sep        = many1 (do{ x <- p; _ <- sep; return x })++-- | @endBy p sep@ parses /zero/ or more occurrences of @p@, separated+-- and ended by @sep@. Returns a list of values returned by @p@.+--+-- >   cStatements  = cStatement `endBy` semi++endBy :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]+{-# INLINABLE endBy #-}+endBy p sep         = many (do{ x <- p; _ <- sep; return x })++-- | @count n p@ parses @n@ occurrences of @p@. If @n@ is smaller or+-- equal to zero, the parser equals to @return []@. Returns a list of+-- @n@ values returned by @p@.++count :: (Stream s m t) => Int -> ParsecT s u m a -> ParsecT s u m [a]+{-# INLINABLE count #-}+count n p           | n <= 0    = return []+                    | otherwise = sequence (replicate n p)++-- | @chainr p op x@ parses /zero/ or more occurrences of @p@,+-- separated by @op@ Returns a value obtained by a /right/ associative+-- application of all functions returned by @op@ to the values returned+-- by @p@. If there are no occurrences of @p@, the value @x@ is+-- returned.++chainr :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> a -> ParsecT s u m a+{-# INLINABLE chainr #-}+chainr p op x       = chainr1 p op <|> return x++-- | @chainl p op x@ parses /zero/ or more occurrences of @p@,+-- separated by @op@. Returns a value obtained by a /left/ associative+-- application of all functions returned by @op@ to the values returned+-- by @p@. If there are zero occurrences of @p@, the value @x@ is+-- returned.++chainl :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> a -> ParsecT s u m a+{-# INLINABLE chainl #-}+chainl p op x       = chainl1 p op <|> return x++-- | @chainl1 p op@ parses /one/ or more occurrences of @p@,+-- separated by @op@ Returns a value obtained by a /left/ associative+-- application of all functions returned by @op@ to the values returned+-- by @p@. This parser can for example be used to eliminate left+-- recursion which typically occurs in expression grammars.+--+-- >  expr    = term   `chainl1` addop+-- >  term    = factor `chainl1` mulop+-- >  factor  = parens expr <|> integer+-- >+-- >  mulop   =   do{ symbol "*"; return (*)   }+-- >          <|> do{ symbol "/"; return (div) }+-- >+-- >  addop   =   do{ symbol "+"; return (+) }+-- >          <|> do{ symbol "-"; return (-) }++chainl1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a+{-# INLINABLE chainl1 #-}+chainl1 p op        = do{ x <- p; rest x }+                    where+                      rest x    = do{ f <- op+                                    ; y <- p+                                    ; rest (f x y)+                                    }+                                <|> return x++-- | @chainr1 p op x@ parses /one/ or more occurrences of |p|,+-- separated by @op@ Returns a value obtained by a /right/ associative+-- application of all functions returned by @op@ to the values returned+-- by @p@.++chainr1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a+{-# INLINABLE chainr1 #-}+chainr1 p op        = scan+                    where+                      scan      = do{ x <- p; rest x }++                      rest x    = do{ f <- op+                                    ; y <- scan+                                    ; return (f x y)+                                    }+                                <|> return x++-----------------------------------------------------------+-- Tricky combinators+-----------------------------------------------------------+-- | The parser @anyToken@ accepts any kind of token. It is for example+-- used to implement 'eof'. Returns the accepted token.++anyToken :: (Stream s m t, Show t) => ParsecT s u m t+{-# INLINABLE anyToken #-}+anyToken            = tokenPrim show (\pos _tok _toks -> pos) Just++-- | This parser only succeeds at the end of the input. This is not a+-- primitive parser but it is defined using 'notFollowedBy'.+--+-- >  eof  = notFollowedBy anyToken <?> "end of input"++eof :: (Stream s m t, Show t) => ParsecT s u m ()+{-# INLINABLE eof #-}+eof                 = notFollowedBy anyToken <?> "end of input"++-- | @notFollowedBy p@ only succeeds when parser @p@ fails. This parser+-- does not consume any input. This parser can be used to implement the+-- \'longest match\' rule. For example, when recognizing keywords (for+-- example @let@), we want to make sure that a keyword is not followed+-- by a legal identifier character, in which case the keyword is+-- actually an identifier (for example @lets@). We can program this+-- behaviour as follows:+--+-- >  keywordLet  = try (do{ string "let"+-- >                       ; notFollowedBy alphaNum+-- >                       })+--+-- __NOTE__: Currently, 'notFollowedBy' exhibits surprising behaviour+-- when applied to a parser @p@ that doesn't consume any input;+-- specifically+--+--  - @'notFollowedBy' . 'notFollowedBy'@ is /not/ equivalent to 'lookAhead', and+--+--  - @'notFollowedBy' 'eof'@ /never/ fails.+--+-- See [haskell/parsec#8](https://github.com/haskell/parsec/issues/8)+-- for more details.++notFollowedBy :: (Stream s m t, Show a) => ParsecT s u m a -> ParsecT s u m ()+{-# INLINABLE notFollowedBy #-}+notFollowedBy p     = try (do{ c <- try p; unexpected (show c) }+                           <|> return ()+                          )++-- | @manyTill p end@ applies parser @p@ /zero/ or more times until+-- parser @end@ succeeds. Returns the list of values returned by @p@.+-- This parser can be used to scan comments:+--+-- >  simpleComment   = do{ string "<!--"+-- >                      ; manyTill anyChar (try (string "-->"))+-- >                      }+--+--    Note the overlapping parsers @anyChar@ and @string \"-->\"@, and+--    therefore the use of the 'try' combinator.++manyTill :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]+{-# INLINABLE manyTill #-}+manyTill p end      = scan+                    where+                      scan  = do{ _ <- end; return [] }+                            <|>+                              do{ x <- p; xs <- scan; return (x:xs) }++-- | @parserTrace label@ is an impure function, implemented with "Debug.Trace" that+-- prints to the console the remaining parser state at the time it is invoked.+-- It is intended to be used for debugging parsers by inspecting their intermediate states.+--+-- > *> parseTest (oneOf "aeiou"  >> parserTrace "label") "atest"+-- > label: "test"+-- > ...+--+-- @since 3.1.12.0+parserTrace :: (Show t, Stream s m t) => String -> ParsecT s u m ()+{-# INLINABLE parserTrace #-}+parserTrace s = pt <|> return ()+    where+        pt = try $ do+           x <- try $ many1 anyToken+           trace (s++": " ++ show x) $ try $ eof+           fail (show x)++-- | @parserTraced label p@ is an impure function, implemented with "Debug.Trace" that+-- prints to the console the remaining parser state at the time it is invoked.+-- It then continues to apply parser @p@, and if @p@ fails will indicate that+-- the label has been backtracked.+-- It is intended to be used for debugging parsers by inspecting their intermediate states.+--+-- > *>  parseTest (oneOf "aeiou"  >> parserTraced "label" (oneOf "nope")) "atest"+-- > label: "test"+-- > label backtracked+-- > parse error at (line 1, column 2):+-- > ...+--+-- @since 3.1.12.0+parserTraced :: (Stream s m t, Show t) => String -> ParsecT s u m b -> ParsecT s u m b+{-# INLINABLE parserTraced #-}+parserTraced s p = do+  parserTrace s+  p <|> trace (s ++ " backtracked") (fail s)
+ src/Text/Parsec/Error.hs view
@@ -0,0 +1,227 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Parsec.Error+-- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+--+-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  portable+--+-- Parse errors+--+-----------------------------------------------------------------------------++module Text.Parsec.Error+    ( Message ( SysUnExpect, UnExpect, Expect, Message )+    , messageString+    , ParseError, errorPos, errorMessages, errorIsUnknown+    , showErrorMessages+    , newErrorMessage, newErrorUnknown+    , addErrorMessage, setErrorPos, setErrorMessage+    , mergeError+    ) where++import Control.Exception ( Exception )+import Data.List ( nub, sort )+import Data.Typeable ( Typeable )+import qualified Data.Monoid as Mon++import Text.Parsec.Pos++-- | This abstract data type represents parse error messages. There are+-- four kinds of messages:+--+-- >  data Message = SysUnExpect String+-- >               | UnExpect String+-- >               | Expect String+-- >               | Message String+--+-- The fine distinction between different kinds of parse errors allows+-- the system to generate quite good error messages for the user. It+-- also allows error messages that are formatted in different+-- languages. Each kind of message is generated by different combinators:+--+--     * A 'SysUnExpect' message is automatically generated by the+--       'Text.Parsec.Combinator.satisfy' combinator. The argument is the+--       unexpected input.+--+--     * A 'UnExpect' message is generated by the 'Text.Parsec.Prim.unexpected'+--       combinator. The argument describes the+--       unexpected item.+--+--     * A 'Expect' message is generated by the 'Text.Parsec.Prim.<?>'+--       combinator. The argument describes the expected item.+--+--     * A 'Message' message is generated by the 'fail'+--       combinator. The argument is some general parser message.++data Message = SysUnExpect !String -- @ library generated unexpect+             | UnExpect    !String -- @ unexpected something+             | Expect      !String -- @ expecting something+             | Message     !String -- @ raw message+    deriving ( Typeable )++instance Enum Message where+    fromEnum (SysUnExpect _) = 0+    fromEnum (UnExpect    _) = 1+    fromEnum (Expect      _) = 2+    fromEnum (Message     _) = 3+    toEnum _ = error "toEnum is undefined for Message"++-- < Return 'True' only when 'compare' would return 'EQ'.++instance Eq Message where++    m1 == m2 = fromEnum m1 == fromEnum m2++-- < Compares two error messages without looking at their content. Only+-- the constructors are compared where:+--+-- > 'SysUnExpect' < 'UnExpect' < 'Expect' < 'Message'++instance Ord Message where+    compare msg1 msg2 = compare (fromEnum msg1) (fromEnum msg2)++-- | Extract the message string from an error message++messageString :: Message -> String+messageString (SysUnExpect s) = s+messageString (UnExpect    s) = s+messageString (Expect      s) = s+messageString (Message     s) = s++-- | The abstract data type @ParseError@ represents parse errors. It+-- provides the source position ('SourcePos') of the error+-- and a list of error messages ('Message'). A @ParseError@+-- can be returned by the function 'Text.Parsec.Prim.parse'. @ParseError@ is an+-- instance of the 'Show' and 'Eq' classes.++data ParseError = ParseError !SourcePos [Message]+    deriving ( Typeable )++-- | Extracts the source position from the parse error++errorPos :: ParseError -> SourcePos+errorPos (ParseError pos _msgs)+    = pos++-- | Extracts the list of error messages from the parse error++errorMessages :: ParseError -> [Message]+errorMessages (ParseError _pos msgs)+    = sort msgs++errorIsUnknown :: ParseError -> Bool+errorIsUnknown (ParseError _pos msgs)+    = null msgs++-- < Create parse errors++newErrorUnknown :: SourcePos -> ParseError+newErrorUnknown pos+    = ParseError pos []++newErrorMessage :: Message -> SourcePos -> ParseError+newErrorMessage msg pos+    = ParseError pos [msg]++addErrorMessage :: Message -> ParseError -> ParseError+addErrorMessage msg (ParseError pos msgs)+    = ParseError pos (msg:msgs)++setErrorPos :: SourcePos -> ParseError -> ParseError+setErrorPos pos (ParseError _ msgs)+    = ParseError pos msgs++setErrorMessage :: Message -> ParseError -> ParseError+setErrorMessage msg (ParseError pos msgs)+    = ParseError pos (msg : filter (msg /=) msgs)++mergeError :: ParseError -> ParseError -> ParseError+mergeError e1@(ParseError pos1 msgs1) e2@(ParseError pos2 msgs2)+    -- prefer meaningful errors+    | null msgs2 && not (null msgs1) = e1+    | null msgs1 && not (null msgs2) = e2+    | otherwise+      -- perfectly we'd compare the consumed token count+      -- https://github.com/haskell/parsec/issues/175+    = case compareErrorPos pos1 pos2 of+        -- select the longest match+        EQ -> ParseError pos1 (msgs1 ++ msgs2)+        GT -> e1+        LT -> e2++compareErrorPos :: SourcePos -> SourcePos -> Ordering+compareErrorPos x y = Mon.mappend (compare (sourceLine x) (sourceLine y)) (compare (sourceColumn x) (sourceColumn y))++instance Show ParseError where+    show err+        = show (errorPos err) ++ ":" +++          showErrorMessages "or" "unknown parse error"+                            "expecting" "unexpected" "end of input"+                           (errorMessages err)++instance Eq ParseError where+    l == r+        = errorPos l == errorPos r && messageStrs l == messageStrs r+        where+          messageStrs = map messageString . errorMessages++-- | @since 3.1.17.0+instance Exception ParseError++-- Language independent show function++--  TODO+-- < The standard function for showing error messages. Formats a list of+--    error messages in English. This function is used in the |Show|+--    instance of |ParseError <#ParseError>|. The resulting string will be+--    formatted like:+--+--    |unexpected /{The first UnExpect or a SysUnExpect message}/;+--    expecting /{comma separated list of Expect messages}/;+--    /{comma separated list of Message messages}/++showErrorMessages ::+    String -> String -> String -> String -> String -> [Message] -> String+showErrorMessages msgOr msgUnknown msgExpecting msgUnExpected msgEndOfInput msgs+    | null msgs = msgUnknown+    | otherwise = concat $ map ("\n"++) $ clean $+                 [showSysUnExpect,showUnExpect,showExpect,showMessages]+    where+      (sysUnExpect,msgs1) = span ((SysUnExpect "") ==) msgs+      (unExpect,msgs2)    = span ((UnExpect    "") ==) msgs1+      (expect,messages)   = span ((Expect      "") ==) msgs2++      showExpect      = showMany msgExpecting expect+      showUnExpect    = showMany msgUnExpected unExpect+      showSysUnExpect+          | not (null unExpect)      = ""+          | []      <- sysUnExpect   = ""+          | msg : _ <- sysUnExpect+          , null (messageString msg) = msgUnExpected ++ " " ++ msgEndOfInput+          | msg : _ <- sysUnExpect   = msgUnExpected ++ " " ++ messageString msg++      showMessages      = showMany "" messages++      -- helpers+      showMany pre msgs3 = case clean (map messageString msgs3) of+                            [] -> ""+                            ms | null pre  -> commasOr ms+                               | otherwise -> pre ++ " " ++ commasOr ms++      commasOr []       = ""+      commasOr [m]      = m+      commasOr ms       = commaSep (init ms) ++ " " ++ msgOr ++ " " ++ last ms++      commaSep          = separate ", " . clean++      separate   _ []     = ""+      separate   _ [m]    = m+      separate sep (m:ms) = m ++ sep ++ separate sep ms++      clean             = nub . filter (not . null)
+ src/Text/Parsec/Expr.hs view
@@ -0,0 +1,174 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Parsec.Expr+-- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+--+-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  non-portable+--+-- A helper module to parse \"expressions\".+-- Builds a parser given a table of operators and associativities.+--+-----------------------------------------------------------------------------++module Text.Parsec.Expr+    ( Assoc(..), Operator(..), OperatorTable+    , buildExpressionParser+    ) where++import Data.Typeable ( Typeable )++import Text.Parsec.Prim+import Text.Parsec.Combinator++-----------------------------------------------------------+-- Assoc and OperatorTable+-----------------------------------------------------------++-- |  This data type specifies the associativity of operators: left, right+-- or none.++data Assoc                = AssocNone+                          | AssocLeft+                          | AssocRight+   deriving ( Typeable )++-- | This data type specifies operators that work on values of type @a@.+-- An operator is either binary infix or unary prefix or postfix. A+-- binary operator has also an associated associativity.++data Operator s u m a   = Infix (ParsecT s u m (a -> a -> a)) Assoc+                        | Prefix (ParsecT s u m (a -> a))+                        | Postfix (ParsecT s u m (a -> a))+    deriving ( Typeable )++-- | An @OperatorTable s u m a@ is a list of @Operator s u m a@+-- lists. The list is ordered in descending+-- precedence. All operators in one list have the same precedence (but+-- may have a different associativity).++type OperatorTable s u m a = [[Operator s u m a]]++-----------------------------------------------------------+-- Convert an OperatorTable and basic term parser into+-- a full fledged expression parser+-----------------------------------------------------------++-- | @buildExpressionParser table term@ builds an expression parser for+-- terms @term@ with operators from @table@, taking the associativity+-- and precedence specified in @table@ into account. Prefix and postfix+-- operators of the same precedence can only occur once (i.e. @--2@ is+-- not allowed if @-@ is prefix negate). Prefix and postfix operators+-- of the same precedence associate to the left (i.e. if @++@ is+-- postfix increment, than @-2++@ equals @-1@, not @-3@).+--+-- The @buildExpressionParser@ takes care of all the complexity+-- involved in building expression parser. Here is an example of an+-- expression parser that handles prefix signs, postfix increment and+-- basic arithmetic.+--+-- >  expr    = buildExpressionParser table term+-- >          <?> "expression"+-- >+-- >  term    =  parens expr+-- >          <|> natural+-- >          <?> "simple expression"+-- >+-- >  table   = [ [prefix "-" negate, prefix "+" id ]+-- >            , [postfix "++" (+1)]+-- >            , [binary "*" (*) AssocLeft, binary "/" (div) AssocLeft ]+-- >            , [binary "+" (+) AssocLeft, binary "-" (-)   AssocLeft ]+-- >            ]+-- >+-- >  binary  name fun assoc = Infix (do{ reservedOp name; return fun }) assoc+-- >  prefix  name fun       = Prefix (do{ reservedOp name; return fun })+-- >  postfix name fun       = Postfix (do{ reservedOp name; return fun })++buildExpressionParser :: (Stream s m t)+                      => OperatorTable s u m a+                      -> ParsecT s u m a+                      -> ParsecT s u m a+{-# INLINABLE buildExpressionParser #-}+buildExpressionParser operators simpleExpr+    = foldl (makeParser) simpleExpr operators+    where+      makeParser term ops+        = let (rassoc,lassoc,nassoc+               ,prefix,postfix)      = foldr splitOp ([],[],[],[],[]) ops++              rassocOp   = choice rassoc+              lassocOp   = choice lassoc+              nassocOp   = choice nassoc+              prefixOp   = choice prefix  <?> ""+              postfixOp  = choice postfix <?> ""++              ambiguous assoc op= try $+                                  do{ _ <- op; fail ("ambiguous use of a " ++ assoc+                                                     ++ " associative operator")+                                    }++              ambiguousRight    = ambiguous "right" rassocOp+              ambiguousLeft     = ambiguous "left" lassocOp+              ambiguousNon      = ambiguous "non" nassocOp++              termP      = do{ pre  <- prefixP+                             ; x    <- term+                             ; post <- postfixP+                             ; return (post (pre x))+                             }++              postfixP   = postfixOp <|> return id++              prefixP    = prefixOp <|> return id++              rassocP x  = do{ f <- rassocOp+                             ; y  <- do{ z <- termP; rassocP1 z }+                             ; return (f x y)+                             }+                           <|> ambiguousLeft+                           <|> ambiguousNon+                           -- <|> return x++              rassocP1 x = rassocP x  <|> return x++              lassocP x  = do{ f <- lassocOp+                             ; y <- termP+                             ; lassocP1 (f x y)+                             }+                           <|> ambiguousRight+                           <|> ambiguousNon+                           -- <|> return x++              lassocP1 x = lassocP x <|> return x++              nassocP x  = do{ f <- nassocOp+                             ; y <- termP+                             ;    ambiguousRight+                              <|> ambiguousLeft+                              <|> ambiguousNon+                              <|> return (f x y)+                             }+                           -- <|> return x++           in  do{ x <- termP+                 ; rassocP x <|> lassocP  x <|> nassocP x <|> return x+                   <?> "operator"+                 }+++      splitOp (Infix op assoc) (rassoc,lassoc,nassoc,prefix,postfix)+        = case assoc of+            AssocNone  -> (rassoc,lassoc,op:nassoc,prefix,postfix)+            AssocLeft  -> (rassoc,op:lassoc,nassoc,prefix,postfix)+            AssocRight -> (op:rassoc,lassoc,nassoc,prefix,postfix)++      splitOp (Prefix op) (rassoc,lassoc,nassoc,prefix,postfix)+        = (rassoc,lassoc,nassoc,op:prefix,postfix)++      splitOp (Postfix op) (rassoc,lassoc,nassoc,prefix,postfix)+        = (rassoc,lassoc,nassoc,prefix,op:postfix)
+ src/Text/Parsec/Language.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Parsec.Language+-- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+--+-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  non-portable (uses non-portable module Text.Parsec.Token)+--+-- A helper module that defines some language definitions that can be used+-- to instantiate a token parser (see "Text.Parsec.Token").+--+-----------------------------------------------------------------------------++module Text.Parsec.Language+    ( haskellDef, haskell+    , mondrianDef, mondrian+    , emptyDef+    , haskellStyle+    , javaStyle+    , LanguageDef+    , GenLanguageDef+    ) where++import Text.Parsec+import Text.Parsec.Token++-----------------------------------------------------------+-- Styles: haskellStyle, javaStyle+-----------------------------------------------------------++-- | This is a minimal token definition for Haskell style languages. It+-- defines the style of comments, valid identifiers and case+-- sensitivity. It does not define any reserved words or operators.++haskellStyle :: LanguageDef st+haskellStyle = emptyDef+                { commentStart   = "{-"+                , commentEnd     = "-}"+                , commentLine    = "--"+                , nestedComments = True+                , identStart     = letter+                , identLetter    = alphaNum <|> oneOf "_'"+                , opStart        = opLetter haskellStyle+                , opLetter       = oneOf ":!#$%&*+./<=>?@\\^|-~"+                , reservedOpNames= []+                , reservedNames  = []+                , caseSensitive  = True+                }++-- | This is a minimal token definition for Java style languages. It+-- defines the style of comments, valid identifiers and case+-- sensitivity. It does not define any reserved words or operators.++javaStyle  :: LanguageDef st+javaStyle   = emptyDef+                { commentStart   = "/*"+                , commentEnd     = "*/"+                , commentLine    = "//"+                , nestedComments = True+                , identStart     = letter+                , identLetter    = alphaNum <|> oneOf "_'"+                , reservedNames  = []+                , reservedOpNames= []+                , caseSensitive  = False+                }++-----------------------------------------------------------+-- minimal language definition+--------------------------------------------------------++-- | This is the most minimal token definition. It is recommended to use+-- this definition as the basis for other definitions. @emptyDef@ has+-- no reserved names or operators, is case sensitive and doesn't accept+-- comments, identifiers or operators.++emptyDef   :: LanguageDef st+emptyDef    = LanguageDef+               { commentStart   = ""+               , commentEnd     = ""+               , commentLine    = ""+               , nestedComments = True+               , identStart     = letter <|> char '_'+               , identLetter    = alphaNum <|> oneOf "_'"+               , opStart        = opLetter emptyDef+               , opLetter       = oneOf ":!#$%&*+./<=>?@\\^|-~"+               , reservedOpNames= []+               , reservedNames  = []+               , caseSensitive  = True+               }++++-----------------------------------------------------------+-- Haskell+-----------------------------------------------------------++-- | A lexer for the Haskell language.++haskell :: TokenParser st+haskell      = makeTokenParser haskellDef++-- | The language definition for the Haskell language.++haskellDef  :: LanguageDef st+haskellDef   = haskell98Def+                { identLetter    = identLetter haskell98Def <|> char '#'+                , reservedNames  = reservedNames haskell98Def +++                                   ["foreign","import","export","primitive"+                                   ,"_ccall_","_casm_"+                                   ,"forall"+                                   ]+                }++-- | The language definition for the language Haskell98.++haskell98Def :: LanguageDef st+haskell98Def = haskellStyle+                { reservedOpNames= ["::","..","=","\\","|","<-","->","@","~","=>"]+                , reservedNames  = ["let","in","case","of","if","then","else",+                                    "data","type",+                                    "class","default","deriving","do","import",+                                    "infix","infixl","infixr","instance","module",+                                    "newtype","where",+                                    "primitive"+                                    -- "as","qualified","hiding"+                                   ]+                }+++-----------------------------------------------------------+-- Mondrian+-----------------------------------------------------------++-- | A lexer for the Mondrian language.++mondrian :: TokenParser st+mondrian    = makeTokenParser mondrianDef++-- | The language definition for the language Mondrian.++mondrianDef :: LanguageDef st+mondrianDef = javaStyle+                { reservedNames = [ "case", "class", "default", "extends"+                                  , "import", "in", "let", "new", "of", "package"+                                  ]+                , caseSensitive  = True+                }
+ src/Text/Parsec/Perm.hs view
@@ -0,0 +1,194 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Parsec.Perm+-- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007+-- License     :  BSD-style (see the file libraries/parsec/LICENSE)+--+-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  non-portable (uses existentially quantified data constructors)+--+-- This module implements permutation parsers. The algorithm used+-- is fairly complex since we push the type system to its limits :-)+-- The algorithm is described in:+--+-- /Parsing Permutation Phrases,/+-- by Arthur Baars, Andres Loh and Doaitse Swierstra.+-- Published as a functional pearl at the Haskell Workshop 2001.+--+-- From the abstract: +--+-- A permutation phrase is a sequence of elements (possibly of different types) +-- in which each element occurs exactly once and the order is irrelevant. +-- Some of the permutable elements may be optional.+--+-----------------------------------------------------------------------------+++module Text.Parsec.Perm+    ( PermParser+    , StreamPermParser -- abstract++    , permute+    , (<||>), (<$$>)+    , (<|?>), (<$?>)+    ) where++import Control.Monad.Identity ( Identity )+import Data.Typeable ( Typeable )+import Text.Parsec++infixl 1 <||>, <|?>+infixl 2 <$$>, <$?>+++{---------------------------------------------------------------+  test -- parse a permutation of+  * an optional string of 'a's+  * a required 'b'+  * an optional 'c'+---------------------------------------------------------------}+{-+test input+  = parse (do{ x <- ptest; eof; return x }) "" input++ptest :: Parser (String,Char,Char)+ptest+  = permute $+    (,,) <$?> ("",many1 (char 'a'))+         <||> char 'b'+         <|?> ('_',char 'c')+-}++{---------------------------------------------------------------+  Building a permutation parser+---------------------------------------------------------------}++-- | The expression @perm \<||> p@ adds parser @p@ to the permutation+-- parser @perm@. The parser @p@ is not allowed to accept empty input -+-- use the optional combinator ('<|?>') instead. Returns a+-- new permutation parser that includes @p@.++(<||>) :: (Stream s Identity tok) => StreamPermParser s st (a -> b) -> Parsec s st a -> StreamPermParser s st b+(<||>) perm p     = add perm p++-- | The expression @f \<$$> p@ creates a fresh permutation parser+-- consisting of parser @p@. The the final result of the permutation+-- parser is the function @f@ applied to the return value of @p@. The+-- parser @p@ is not allowed to accept empty input - use the optional+-- combinator ('<$?>') instead.+--+-- If the function @f@ takes more than one parameter, the type variable+-- @b@ is instantiated to a functional type which combines nicely with+-- the adds parser @p@ to the ('<||>') combinator. This+-- results in stylized code where a permutation parser starts with a+-- combining function @f@ followed by the parsers. The function @f@+-- gets its parameters in the order in which the parsers are specified,+-- but actual input can be in any order.++(<$$>) :: (Stream s Identity tok) => (a -> b) -> Parsec s st a -> StreamPermParser s st b+(<$$>) f p        = newperm f <||> p++-- | The expression @perm \<||> (x,p)@ adds parser @p@ to the+-- permutation parser @perm@. The parser @p@ is optional - if it can+-- not be applied, the default value @x@ will be used instead. Returns+-- a new permutation parser that includes the optional parser @p@.++(<|?>) :: (Stream s Identity tok) => StreamPermParser s st (a -> b) -> (a, Parsec s st a) -> StreamPermParser s st b+(<|?>) perm (x,p) = addopt perm x p++-- | The expression @f \<$?> (x,p)@ creates a fresh permutation parser+-- consisting of parser @p@. The the final result of the permutation+-- parser is the function @f@ applied to the return value of @p@. The+-- parser @p@ is optional - if it can not be applied, the default value+-- @x@ will be used instead.++(<$?>) :: (Stream s Identity tok) => (a -> b) -> (a, Parsec s st a) -> StreamPermParser s st b+(<$?>) f (x,p)    = newperm f <|?> (x,p)++{---------------------------------------------------------------+  The permutation tree+---------------------------------------------------------------}++-- | Provided for backwards compatibility.  The tok type is ignored.++type PermParser tok st a = StreamPermParser String st a++-- | The type @StreamPermParser s st a@ denotes a permutation parser that,+-- when converted by the 'permute' function, parses+-- @s@ streams with user state @st@ and returns a value of+-- type @a@ on success.+--+-- Normally, a permutation parser is first build with special operators+-- like ('<||>') and than transformed into a normal parser+-- using 'permute'.++data StreamPermParser s st a = Perm (Maybe a) [StreamBranch s st a]+    deriving ( Typeable )++-- type Branch st a = StreamBranch String st a++data StreamBranch s st a = forall b. Branch (StreamPermParser s st (b -> a)) (Parsec s st b)+    deriving ( Typeable )++-- | The parser @permute perm@ parses a permutation of parser described+-- by @perm@. For example, suppose we want to parse a permutation of:+-- an optional string of @a@'s, the character @b@ and an optional @c@.+-- This can be described by:+--+-- >  test  = permute (tuple <$?> ("",many1 (char 'a'))+-- >                         <||> char 'b'+-- >                         <|?> ('_',char 'c'))+-- >        where+-- >          tuple a b c  = (a,b,c)++-- transform a permutation tree into a normal parser+permute :: (Stream s Identity tok) => StreamPermParser s st a -> Parsec s st a+permute (Perm def xs)+  = choice (map branch xs ++ empty)+  where+    empty+      = case def of+          Nothing -> []+          Just x  -> [return x]++    branch (Branch perm p)+      = do{ x <- p+          ; f <- permute perm+          ; return (f x)+          }++-- build permutation trees+newperm :: (Stream s Identity tok) => (a -> b) -> StreamPermParser s st (a -> b)+newperm f+  = Perm (Just f) []++add :: (Stream s Identity tok) => StreamPermParser s st (a -> b) -> Parsec s st a -> StreamPermParser s st b+add perm@(Perm _mf fs) p+  = Perm Nothing (first:map insert fs)+  where+    first   = Branch perm p+    insert (Branch perm' p')+            = Branch (add (mapPerms flip perm') p) p'++addopt :: (Stream s Identity tok) => StreamPermParser s st (a -> b) -> a -> Parsec s st a -> StreamPermParser s st b+addopt perm@(Perm mf fs) x p+  = Perm (fmap ($ x) mf) (first:map insert fs)+  where+    first   = Branch perm p+    insert (Branch perm' p')+            = Branch (addopt (mapPerms flip perm') x p) p'+++mapPerms :: (Stream s Identity tok) => (a -> b) -> StreamPermParser s st a -> StreamPermParser s st b+mapPerms f (Perm x xs)+  = Perm (fmap f x) (map mapBranch xs)+  where+    mapBranch (Branch perm p)+      = Branch (mapPerms (f.) perm) p
+ src/Text/Parsec/Pos.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Parsec.Pos+-- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+--+-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  portable+--+-- Textual source positions.+--+-----------------------------------------------------------------------------++module Text.Parsec.Pos+    ( SourceName, Line, Column+    , SourcePos+    , sourceLine, sourceColumn, sourceName+    , incSourceLine, incSourceColumn+    , setSourceLine, setSourceColumn, setSourceName+    , newPos, initialPos+    , updatePosChar, updatePosString+    ) where++import Data.Data (Data)+import Data.Typeable (Typeable)++-- < Source positions: a file name, a line and a column+-- upper left is (1,1)++type SourceName = String+type Line       = Int+type Column     = Int++-- | The abstract data type @SourcePos@ represents source positions. It+-- contains the name of the source (i.e. file name), a line number and+-- a column number. @SourcePos@ is an instance of the 'Show', 'Eq' and+-- 'Ord' class.++data SourcePos  = SourcePos SourceName !Line !Column+    deriving ( Eq, Ord, Data, Typeable)++-- | Create a new 'SourcePos' with the given source name,+-- line number and column number.++newPos :: SourceName -> Line -> Column -> SourcePos+newPos name line column+    = SourcePos name line column++-- | Create a new 'SourcePos' with the given source name,+-- and line number and column number set to 1, the upper left.++initialPos :: SourceName -> SourcePos+initialPos name+    = newPos name 1 1++-- | Extracts the name of the source from a source position.++sourceName :: SourcePos -> SourceName+sourceName (SourcePos name _line _column) = name++-- | Extracts the line number from a source position.++sourceLine :: SourcePos -> Line+sourceLine (SourcePos _name line _column) = line++-- | Extracts the column number from a source position.++sourceColumn :: SourcePos -> Column+sourceColumn (SourcePos _name _line column) = column++-- | Increments the line number of a source position.++incSourceLine :: SourcePos -> Line -> SourcePos+incSourceLine (SourcePos name line column) n = SourcePos name (line+n) column++-- | Increments the column number of a source position.++incSourceColumn :: SourcePos -> Column -> SourcePos+incSourceColumn (SourcePos name line column) n = SourcePos name line (column+n)++-- | Set the name of the source.++setSourceName :: SourcePos -> SourceName -> SourcePos+setSourceName (SourcePos _name line column) n = SourcePos n line column++-- | Set the line number of a source position.++setSourceLine :: SourcePos -> Line -> SourcePos+setSourceLine (SourcePos name _line column) n = SourcePos name n column++-- | Set the column number of a source position.++setSourceColumn :: SourcePos -> Column -> SourcePos+setSourceColumn (SourcePos name line _column) n = SourcePos name line n++-- | The expression @updatePosString pos s@ updates the source position+-- @pos@ by calling 'updatePosChar' on every character in @s@, ie.+-- @foldl updatePosChar pos string@.++updatePosString :: SourcePos -> String -> SourcePos+updatePosString pos string+    = foldl updatePosChar pos string++-- | Update a source position given a character. If the character is a+-- newline (\'\\n\') or carriage return (\'\\r\') the line number is+-- incremented by 1. If the character is a tab (\'\t\') the column+-- number is incremented to the nearest 8'th column, ie. @column + 8 -+-- ((column-1) \`mod\` 8)@. In all other cases, the column is+-- incremented by 1.++updatePosChar   :: SourcePos -> Char -> SourcePos+updatePosChar (SourcePos name line column) c+    = case c of+        '\n' -> SourcePos name (line+1) 1+        '\t' -> SourcePos name line (column + 8 - ((column-1) `mod` 8))+        _    -> SourcePos name line (column + 1)++instance Show SourcePos where+  show (SourcePos name line column)+    | null name = showLineColumn+    | otherwise = "\"" ++ name ++ "\" " ++ showLineColumn+    where+      showLineColumn    = "(line " ++ show line +++                          ", column " ++ show column +++                          ")"
+ src/Text/Parsec/Prim.hs view
@@ -0,0 +1,912 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolymorphicComponents #-}+{-# LANGUAGE Safe #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE UndecidableInstances #-}++{-# OPTIONS_GHC -fno-warn-name-shadowing #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Parsec.Prim+-- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+--+-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  portable+--+-- The primitive parser combinators.+--+-----------------------------------------------------------------------------++{-# OPTIONS_HADDOCK not-home #-}++module Text.Parsec.Prim+    ( unknownError+    , sysUnExpectError+    , unexpected+    , ParsecT+    , runParsecT+    , mkPT+    , Parsec+    , Consumed(..)+    , Reply(..)+    , State(..)+    , parsecMap+    , parserReturn+    , parserBind+    , mergeErrorReply+    , parserFail+    , parserZero+    , parserPlus+    , (<?>)+    , (<|>)+    , label+    , labels+    , lookAhead+    , Stream(..)+    , tokens+    , tokens'+    , try+    , token+    , tokenPrim+    , tokenPrimEx+    , many+    , skipMany+    , manyAccum+    , many1+    , runPT+    , runP+    , runParserT+    , runParser+    , parse+    , parseTest+    , getPosition+    , getInput+    , setPosition+    , setInput+    , getParserState+    , setParserState+    , updateParserState+    , getState+    , putState+    , modifyState+    , setState+    , updateState+    ) where+++import Prelude hiding (sequence)+import qualified Data.ByteString.Lazy.Char8 as CL+import qualified Data.ByteString.Char8 as C++import Data.Typeable ( Typeable )++import qualified Data.Text as Text+import qualified Data.Text.Lazy as TextL++-- To define Monoid instance+import qualified Data.List.NonEmpty as NE+import Data.List ( genericReplicate )+import Data.Traversable (sequence)+import qualified Data.Functor as Functor ( Functor(..) )+import qualified Data.Semigroup as Semigroup ( Semigroup(..) )+import qualified Data.Monoid as Monoid ( Monoid(..) )++import qualified Control.Applicative as Applicative ( Applicative(..), Alternative(..), liftA2 )+import Control.Monad (MonadPlus (..), ap, void, liftM)+import Control.Monad.Trans (MonadTrans (lift), MonadIO (liftIO))+import Control.Monad.Identity (Identity, runIdentity)+import qualified Control.Monad.Fail as Fail++import Control.Monad.Reader.Class (MonadReader (..))+import Control.Monad.State.Class (MonadState (..))+import Control.Monad.Cont.Class (MonadCont (..))+import Control.Monad.Error.Class (MonadError (..))++import Text.Parsec.Pos+import Text.Parsec.Error++unknownError :: State s u -> ParseError+unknownError state        = newErrorUnknown (statePos state)++sysUnExpectError :: String -> SourcePos -> Reply s u a+sysUnExpectError msg pos  = Error (newErrorMessage (SysUnExpect msg) pos)++-- | The parser @unexpected msg@ always fails with an unexpected error+-- message @msg@ without consuming any input.+--+-- The parsers 'fail', ('<?>') and @unexpected@ are the three parsers+-- used to generate error messages. Of these, only ('<?>') is commonly+-- used. For an example of the use of @unexpected@, see the definition+-- of 'Text.Parsec.Combinator.notFollowedBy'.++unexpected :: (Stream s m t) => String -> ParsecT s u m a+unexpected msg+    = ParsecT $ \s _ _ _ eerr ->+      eerr $ newErrorMessage (UnExpect msg) (statePos s)++-- | ParserT monad transformer and Parser type++-- | @ParsecT s u m a@ is a parser with stream type @s@, user state type @u@,+-- underlying monad @m@ and return type @a@.  Parsec is strict in the user state.+-- If this is undesirable, simply use a data type like @data Box a = Box a@ and+-- the state type @Box YourStateType@ to add a level of indirection.++newtype ParsecT s u m a+    = ParsecT {unParser :: forall b .+                 State s u+              -> (a -> State s u -> ParseError -> m b) -- consumed ok+              -> (ParseError -> m b)                   -- consumed err+              -> (a -> State s u -> ParseError -> m b) -- empty ok+              -> (ParseError -> m b)                   -- empty err+              -> m b+             }+     deriving ( Typeable )++-- | Low-level unpacking of the ParsecT type. To run your parser, please look to+-- runPT, runP, runParserT, runParser and other such functions.+runParsecT :: Monad m => ParsecT s u m a -> State s u -> m (Consumed (m (Reply s u a)))+{-# INLINABLE runParsecT #-}+runParsecT p s = unParser p s cok cerr eok eerr+    where cok a s' err = return . Consumed . return $ Ok a s' err+          cerr err = return . Consumed . return $ Error err+          eok a s' err = return . Empty . return $ Ok a s' err+          eerr err = return . Empty . return $ Error err++-- | Low-level creation of the ParsecT type. You really shouldn't have to do this.+mkPT :: Monad m => (State s u -> m (Consumed (m (Reply s u a)))) -> ParsecT s u m a+{-# INLINABLE mkPT #-}+mkPT k = ParsecT $ \s cok cerr eok eerr -> do+           cons <- k s+           case cons of+             Consumed mrep -> do+                       rep <- mrep+                       case rep of+                         Ok x s' err -> cok x s' err+                         Error err -> cerr err+             Empty mrep -> do+                       rep <- mrep+                       case rep of+                         Ok x s' err -> eok x s' err+                         Error err -> eerr err++type Parsec s u = ParsecT s u Identity++data Consumed a  = Consumed a+                 | Empty !a+    deriving ( Typeable )++data Reply s u a = Ok a !(State s u) ParseError+                 | Error ParseError+    deriving ( Typeable )++data State s u = State {+      stateInput :: s,+      statePos   :: !SourcePos,+      stateUser  :: !u+    }+    deriving ( Typeable )++-- | The 'Semigroup' instance for 'ParsecT' is used to append the result+-- of several parsers, for example:+--+-- @+-- (many $ char 'a') <> (many $ char 'b')+-- @+--+-- The above will parse a string like @"aabbb"@ and return a successful+-- parse result @"aabbb"@. Compare against the below which will+-- produce a result of @"bbb"@ for the same input:+--+-- @+-- (many $ char 'a') >> (many $ char 'b')+-- (many $ char 'a') *> (many $ char 'b')+-- @+--+-- @since 3.1.12+instance Semigroup.Semigroup a => Semigroup.Semigroup (ParsecT s u m a) where+    -- | Combines two parsers like '*>', '>>' and @do {...;...}@+    --  /but/ also combines their results with (<>) instead of+    --  discarding the first.+    (<>)     = Applicative.liftA2 (Semigroup.<>)++    sconcat  = fmap Semigroup.sconcat . sequence+    stimes b = Semigroup.sconcat . NE.fromList . genericReplicate b++-- | The 'Monoid' instance for 'ParsecT' is used for the same purposes as+-- the 'Semigroup' instance.+--+-- @since 3.1.12+instance ( Monoid.Monoid a+         , Semigroup.Semigroup (ParsecT s u m a)+         ) => Monoid.Monoid (ParsecT s u m a) where+    -- | A parser that always succeeds, consumes no input, and+    --  returns the underlying 'Monoid''s 'mempty' value+    mempty = Applicative.pure Monoid.mempty++    -- | See 'ParsecT''s 'Semigroup.<>' implementation+    mappend = (Semigroup.<>)++    mconcat = Functor.fmap Monoid.mconcat . sequence++instance Functor Consumed where+    fmap f (Consumed x) = Consumed (f x)+    fmap f (Empty x)    = Empty (f x)++instance Functor (Reply s u) where+    fmap f (Ok x s e) = Ok (f x) s e+    fmap _ (Error e) = Error e -- XXX++instance Functor (ParsecT s u m) where+    fmap f p = parsecMap f p++parsecMap :: (a -> b) -> ParsecT s u m a -> ParsecT s u m b+parsecMap f p+    = ParsecT $ \s cok cerr eok eerr ->+      unParser p s (cok . f) cerr (eok . f) eerr++instance Applicative.Applicative (ParsecT s u m) where+    pure = parserReturn+    (<*>) = ap -- TODO: Can this be optimized?+    p1 *> p2 = p1 `parserBind` const p2+    p1 <* p2 = do { x1 <- p1 ; void p2 ; return x1 }++instance Applicative.Alternative (ParsecT s u m) where+    empty = mzero+    (<|>) = mplus++    -- TODO: https://github.com/haskell/parsec/issues/179+    -- investigate what's wrong with haddock+    --+    -- many = many+    -- some = many1++instance Monad (ParsecT s u m) where+    return = Applicative.pure+    p >>= f = parserBind p f+    (>>) = (Applicative.*>)+#if !MIN_VERSION_base(4,13,0)+    fail = Fail.fail+#endif++-- | @since 3.1.12.0+instance Fail.MonadFail (ParsecT s u m) where+    fail = parserFail++instance (MonadIO m) => MonadIO (ParsecT s u m) where+    liftIO = lift . liftIO++instance (MonadReader r m) => MonadReader r (ParsecT s u m) where+    ask = lift ask+    local f p = mkPT $ \s -> local f (runParsecT p s)++-- I'm presuming the user might want a separate, non-backtracking+-- state aside from the Parsec user state.+instance (MonadState s m) => MonadState s (ParsecT s' u m) where+    get = lift get+    put = lift . put++instance (MonadCont m) => MonadCont (ParsecT s u m) where+    callCC f = mkPT $ \s ->+          callCC $ \c ->+          runParsecT (f (\a -> mkPT $ \s' -> c (pack s' a))) s++     where pack s a= Empty $ return (Ok a s (unknownError s))++instance (MonadError e m) => MonadError e (ParsecT s u m) where+    throwError = lift . throwError+    p `catchError` h = mkPT $ \s ->+        runParsecT p s `catchError` \e ->+            runParsecT (h e) s++parserReturn :: a -> ParsecT s u m a+parserReturn x+    = ParsecT $ \s _ _ eok _ ->+      eok x s (unknownError s)++parserBind :: ParsecT s u m a -> (a -> ParsecT s u m b) -> ParsecT s u m b+{-# INLINE parserBind #-}+parserBind m k+  = ParsecT $ \s cok cerr eok eerr ->+    let+        -- consumed-okay case for m+        mcok x s err+          | errorIsUnknown err = unParser (k x) s cok cerr cok cerr+          | otherwise =+            let+                 -- if (k x) consumes, those go straight up+                 pcok = cok+                 pcerr = cerr++                 -- if (k x) doesn't consume input, but is okay,+                 -- we still return in the consumed continuation+                 peok x s err' = cok x s (mergeError err err')++                 -- if (k x) doesn't consume input, but errors,+                 -- we return the error in the 'consumed-error'+                 -- continuation+                 peerr err' = cerr (mergeError err err')+            in  unParser (k x) s pcok pcerr peok peerr++        -- empty-ok case for m+        meok x s err+          | errorIsUnknown err = unParser (k x) s cok cerr eok eerr+          | otherwise =+            let+                -- in these cases, (k x) can return as empty+                pcok = cok+                peok x s err' = eok x s (mergeError err err')+                pcerr = cerr+                peerr err' = eerr (mergeError err err')+            in  unParser (k x) s pcok pcerr peok peerr+        -- consumed-error case for m+        mcerr = cerr++        -- empty-error case for m+        meerr = eerr++    in unParser m s mcok mcerr meok meerr+++mergeErrorReply :: ParseError -> Reply s u a -> Reply s u a+mergeErrorReply err1 reply -- XXX where to put it?+    = case reply of+        Ok x state err2 -> Ok x state (mergeError err1 err2)+        Error err2      -> Error (mergeError err1 err2)++parserFail :: String -> ParsecT s u m a+parserFail msg+    = ParsecT $ \s _ _ _ eerr ->+      eerr $ newErrorMessage (Message msg) (statePos s)++instance MonadPlus (ParsecT s u m) where+    mzero = parserZero+    mplus p1 p2 = parserPlus p1 p2++-- | @parserZero@ always fails without consuming any input. @parserZero@ is defined+-- equal to the 'mzero' member of the 'MonadPlus' class and to the 'Control.Applicative.empty' member+-- of the 'Control.Applicative.Alternative' class.++parserZero :: ParsecT s u m a+parserZero+    = ParsecT $ \s _ _ _ eerr ->+      eerr $ unknownError s++parserPlus :: ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a+{-# INLINE parserPlus #-}+parserPlus m n+    = ParsecT $ \s cok cerr eok eerr ->+      let+          meerr err =+              let+                  neok y s' err' = eok y s' (mergeError err err')+                  neerr err' = eerr $ mergeError err err'+              in unParser n s cok cerr neok neerr+      in unParser m s cok cerr eok meerr++instance MonadTrans (ParsecT s u) where+    lift amb = ParsecT $ \s _ _ eok _ -> do+               a <- amb+               eok a s $ unknownError s++infix  0 <?>+infixr 1 <|>++-- | The parser @p \<?> msg@ behaves as parser @p@, but whenever the+-- parser @p@ fails /without consuming any input/, it replaces expect+-- error messages with the expect error message @msg@.+--+-- This is normally used at the end of a set alternatives where we want+-- to return an error message in terms of a higher level construct+-- rather than returning all possible characters. For example, if the+-- @expr@ parser from the 'try' example would fail, the error+-- message is: '...: expecting expression'. Without the @(\<?>)@+-- combinator, the message would be like '...: expecting \"let\" or+-- letter', which is less friendly.++(<?>) :: (ParsecT s u m a) -> String -> (ParsecT s u m a)+p <?> msg = label p msg++-- | This combinator implements choice. The parser @p \<|> q@ first+-- applies @p@. If it succeeds, the value of @p@ is returned. If @p@+-- fails /without consuming any input/, parser @q@ is tried. This+-- combinator is defined equal to the 'mplus' member of the 'MonadPlus'+-- class and the ('Control.Applicative.<|>') member of 'Control.Applicative.Alternative'.+--+-- The parser is called /predictive/ since @q@ is only tried when+-- parser @p@ didn't consume any input (i.e.. the look ahead is 1).+-- This non-backtracking behaviour allows for both an efficient+-- implementation of the parser combinators and the generation of good+-- error messages.++(<|>) :: (ParsecT s u m a) -> (ParsecT s u m a) -> (ParsecT s u m a)+p1 <|> p2 = mplus p1 p2++-- | A synonym for @\<?>@, but as a function instead of an operator.+label :: ParsecT s u m a -> String -> ParsecT s u m a+label p msg+  = labels p [msg]++labels :: ParsecT s u m a -> [String] -> ParsecT s u m a+labels p msgs =+    ParsecT $ \s cok cerr eok eerr ->+    let eok' x s' error = eok x s' $ if errorIsUnknown error+                  then error+                  else setExpectErrors error msgs+        eerr' err = eerr $ setExpectErrors err msgs++    in unParser p s cok cerr eok' eerr'++ where+   setExpectErrors err []         = setErrorMessage (Expect "") err+   setExpectErrors err [msg]      = setErrorMessage (Expect msg) err+   setExpectErrors err (msg:msgs)+       = foldr (\msg' err' -> addErrorMessage (Expect msg') err')+         (setErrorMessage (Expect msg) err) msgs++-- TODO: There should be a stronger statement that can be made about this++-- | An instance of @Stream@ has stream type @s@, underlying monad @m@ and token type @t@ determined by the stream+--+-- Some rough guidelines for a \"correct\" instance of Stream:+--+--    * unfoldM uncons gives the [t] corresponding to the stream+--+--    * A @Stream@ instance is responsible for maintaining the \"position within the stream\" in the stream state @s@.  This is trivial unless you are using the monad in a non-trivial way.++class (Monad m) => Stream s m t | s -> t where+    uncons :: s -> m (Maybe (t,s))++instance (Monad m) => Stream [tok] m tok where+    uncons []     = return $ Nothing+    uncons (t:ts) = return $ Just (t,ts)+    {-# INLINE uncons #-}+++instance (Monad m) => Stream CL.ByteString m Char where+    uncons = return . CL.uncons++instance (Monad m) => Stream C.ByteString m Char where+    uncons = return . C.uncons++instance (Monad m) => Stream Text.Text m Char where+    uncons = return . Text.uncons+    {-# INLINE uncons #-}++instance (Monad m) => Stream TextL.Text m Char where+    uncons = return . TextL.uncons+    {-# INLINE uncons #-}+++tokens :: (Stream s m t, Eq t)+       => ([t] -> String)      -- Pretty print a list of tokens+       -> (SourcePos -> [t] -> SourcePos)+       -> [t]                  -- List of tokens to parse+       -> ParsecT s u m [t]+{-# INLINE tokens #-}+tokens _ _ []+    = ParsecT $ \s _ _ eok _ ->+      eok [] s $ unknownError s+tokens showTokens nextposs tts@(tok:toks)+    = ParsecT $ \(State input pos u) cok cerr _eok eerr ->+    let+        errEof = (setErrorMessage (Expect (showTokens tts))+                  (newErrorMessage (SysUnExpect "") pos))++        errExpect x = (setErrorMessage (Expect (showTokens tts))+                       (newErrorMessage (SysUnExpect (showTokens [x])) pos))++        walk []     rs = ok rs+        walk (t:ts) rs = do+          sr <- uncons rs+          case sr of+            Nothing                 -> cerr $ errEof+            Just (x,xs) | t == x    -> walk ts xs+                        | otherwise -> cerr $ errExpect x++        ok rs = let pos' = nextposs pos tts+                    s' = State rs pos' u+                in cok tts s' (newErrorUnknown pos')+    in do+        sr <- uncons input+        case sr of+            Nothing         -> eerr $ errEof+            Just (x,xs)+                | tok == x  -> walk toks xs+                | otherwise -> eerr $ errExpect x++-- | Like 'tokens', but doesn't consume matching prefix.+--+-- @since 3.1.16.0+tokens' :: (Stream s m t, Eq t)+       => ([t] -> String)      -- Pretty print a list of tokens+       -> (SourcePos -> [t] -> SourcePos)+       -> [t]                  -- List of tokens to parse+       -> ParsecT s u m [t]+{-# INLINE tokens' #-}+tokens' _ _ []+    = ParsecT $ \s _ _ eok _ ->+      eok [] s $ unknownError s+tokens' showTokens nextposs tts@(tok:toks)+    = ParsecT $ \(State input pos u) cok _cerr _eok eerr ->+    let+        errEof = (setErrorMessage (Expect (showTokens tts))+                  (newErrorMessage (SysUnExpect "") pos))++        errExpect x = (setErrorMessage (Expect (showTokens tts))+                       (newErrorMessage (SysUnExpect (showTokens [x])) pos))++        walk []     rs = ok rs+        walk (t:ts) rs = do+          sr <- uncons rs+          case sr of+            Nothing                 -> eerr $ errEof+            Just (x,xs) | t == x    -> walk ts xs+                        | otherwise -> eerr $ errExpect x++        ok rs = let pos' = nextposs pos tts+                    s' = State rs pos' u+                in cok tts s' (newErrorUnknown pos')+    in do+        sr <- uncons input+        case sr of+            Nothing         -> eerr $ errEof+            Just (x,xs)+                | tok == x  -> walk toks xs+                | otherwise -> eerr $ errExpect x++-- | The parser @try p@ behaves like parser @p@, except that it+-- pretends that it hasn't consumed any input when an error occurs.+--+-- This combinator is used whenever arbitrary look ahead is needed.+-- Since it pretends that it hasn't consumed any input when @p@ fails,+-- the ('<|>') combinator will try its second alternative even when the+-- first parser failed while consuming input.+--+-- The @try@ combinator can for example be used to distinguish+-- identifiers and reserved words. Both reserved words and identifiers+-- are a sequence of letters. Whenever we expect a certain reserved+-- word where we can also expect an identifier we have to use the @try@+-- combinator. Suppose we write:+--+-- >  expr        = letExpr <|> identifier <?> "expression"+-- >+-- >  letExpr     = do{ string "let"; ... }+-- >  identifier  = many1 letter+--+-- If the user writes \"lexical\", the parser fails with: @unexpected+-- \'x\', expecting \'t\' in \"let\"@. Indeed, since the ('<|>') combinator+-- only tries alternatives when the first alternative hasn't consumed+-- input, the @identifier@ parser is never tried (because the prefix+-- \"le\" of the @string \"let\"@ parser is already consumed). The+-- right behaviour can be obtained by adding the @try@ combinator:+--+-- >  expr        = letExpr <|> identifier <?> "expression"+-- >+-- >  letExpr     = do{ try (string "let"); ... }+-- >  identifier  = many1 letter++try :: ParsecT s u m a -> ParsecT s u m a+try p =+    ParsecT $ \s cok _ eok eerr ->+    unParser p s cok eerr eok eerr++-- | @lookAhead p@ parses @p@ without consuming any input.+--+-- If @p@ fails and consumes some input, so does @lookAhead@. Combine with 'try'+-- if this is undesirable.++lookAhead :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m a+lookAhead p =+    ParsecT $ \s _ cerr eok eerr -> do+        let eok' a _ _ = eok a s (newErrorUnknown (statePos s))+        unParser p s eok' cerr eok' eerr++-- | The parser @token showTok posFromTok testTok@ accepts a token @t@+-- with result @x@ when the function @testTok t@ returns @'Just' x@. The+-- source position of the @t@ should be returned by @posFromTok t@ and+-- the token can be shown using @showTok t@.+--+-- This combinator is expressed in terms of 'tokenPrim'.+-- It is used to accept user defined token streams. For example,+-- suppose that we have a stream of basic tokens tupled with source+-- positions. We can then define a parser that accepts single tokens as:+--+-- >  mytoken x+-- >    = token showTok posFromTok testTok+-- >    where+-- >      showTok (pos,t)     = show t+-- >      posFromTok (pos,t)  = pos+-- >      testTok (pos,t)     = if x == t then Just t else Nothing++token :: (Stream s Identity t)+      => (t -> String)            -- ^ Token pretty-printing function.+      -> (t -> SourcePos)         -- ^ Computes the position of a token.+      -> (t -> Maybe a)           -- ^ Matching function for the token to parse.+      -> Parsec s u a+{-# INLINABLE token #-}+token showToken tokpos test = tokenPrim showToken nextpos test+    where+        nextpos _ tok ts = case runIdentity (uncons ts) of+                             Nothing -> tokpos tok+                             Just (tok',_) -> tokpos tok'++-- | The parser @tokenPrim showTok nextPos testTok@ accepts a token @t@+-- with result @x@ when the function @testTok t@ returns @'Just' x@. The+-- token can be shown using @showTok t@. The position of the /next/+-- token should be returned when @nextPos@ is called with the current+-- source position @pos@, the current token @t@ and the rest of the+-- tokens @toks@, @nextPos pos t toks@.+--+-- This is the most primitive combinator for accepting tokens. For+-- example, the 'Text.Parsec.Char.char' parser could be implemented as:+--+-- >  char c+-- >    = tokenPrim showChar nextPos testChar+-- >    where+-- >      showChar x        = "'" ++ x ++ "'"+-- >      testChar x        = if x == c then Just x else Nothing+-- >      nextPos pos x xs  = updatePosChar pos x++tokenPrim :: (Stream s m t)+          => (t -> String)                      -- ^ Token pretty-printing function.+          -> (SourcePos -> t -> s -> SourcePos) -- ^ Next position calculating function.+          -> (t -> Maybe a)                     -- ^ Matching function for the token to parse.+          -> ParsecT s u m a+{-# INLINE tokenPrim #-}+tokenPrim showToken nextpos test = tokenPrimEx showToken nextpos Nothing test++tokenPrimEx :: (Stream s m t)+            => (t -> String)+            -> (SourcePos -> t -> s -> SourcePos)+            -> Maybe (SourcePos -> t -> s -> u -> u)+            -> (t -> Maybe a)+            -> ParsecT s u m a+{-# INLINE tokenPrimEx #-}+tokenPrimEx showToken nextpos Nothing test+  = ParsecT $ \(State input pos user) cok _cerr _eok eerr -> do+      r <- uncons input+      case r of+        Nothing -> eerr $ unexpectError "" pos+        Just (c,cs)+         -> case test c of+              Just x -> let newpos = nextpos pos c cs+                            newstate = State cs newpos user+                        in seq newpos $ seq newstate $+                           cok x newstate (newErrorUnknown newpos)+              Nothing -> eerr $ unexpectError (showToken c) pos+tokenPrimEx showToken nextpos (Just nextState) test+  = ParsecT $ \(State input pos user) cok _cerr _eok eerr -> do+      r <- uncons input+      case r of+        Nothing -> eerr $ unexpectError "" pos+        Just (c,cs)+         -> case test c of+              Just x -> let newpos = nextpos pos c cs+                            newUser = nextState pos c cs user+                            newstate = State cs newpos newUser+                        in seq newpos $ seq newstate $+                           cok x newstate $ newErrorUnknown newpos+              Nothing -> eerr $ unexpectError (showToken c) pos++unexpectError :: String -> SourcePos -> ParseError+unexpectError msg pos = newErrorMessage (SysUnExpect msg) pos+++-- | @many p@ applies the parser @p@ /zero/ or more times. Returns a+--    list of the returned values of @p@.+--+-- >  identifier  = do{ c  <- letter+-- >                  ; cs <- many (alphaNum <|> char '_')+-- >                  ; return (c:cs)+-- >                  }++many :: ParsecT s u m a -> ParsecT s u m [a]+many p+  = do xs <- manyAccum (:) p+       return (reverse xs)++-- | @many1 p@ applies the parser @p@ /one/ or more times. Returns a+-- list of the returned values of @p@.+--+-- >  word  = many1 letter++many1 :: ParsecT s u m a -> ParsecT s u m [a]+{-# INLINABLE many1 #-}+many1 p = do{ x <- p; xs <- many p; return (x:xs) }++-- | @skipMany p@ applies the parser @p@ /zero/ or more times, skipping+-- its result.+--+-- >  spaces  = skipMany space++skipMany :: ParsecT s u m a -> ParsecT s u m ()+skipMany p+  = do _ <- manyAccum (\_ _ -> []) p+       return ()++manyAccum :: (a -> [a] -> [a])+          -> ParsecT s u m a+          -> ParsecT s u m [a]+manyAccum acc p =+    ParsecT $ \s cok cerr eok _eerr ->+    let walk xs x s' _err =+            unParser p s'+              (seq xs $ walk $ acc x xs)  -- consumed-ok+              cerr                        -- consumed-err+              manyErr                     -- empty-ok+              (\e -> cok (acc x xs) s' e) -- empty-err+    in unParser p s (walk []) cerr manyErr (\e -> eok [] s e)++manyErr :: a+manyErr = error "Text.ParserCombinators.Parsec.Prim.many: combinator 'many' is applied to a parser that accepts an empty string."+++-- < Running a parser: monadic (runPT) and pure (runP)++runPT :: (Stream s m t)+      => ParsecT s u m a -> u -> SourceName -> s -> m (Either ParseError a)+{-# INLINABLE runPT #-}+runPT p u name s+    = do res <- runParsecT p (State s (initialPos name) u)+         r <- parserReply res+         case r of+           Ok x _ _  -> return (Right x)+           Error err -> return (Left err)+    where+        parserReply res+            = case res of+                Consumed r -> r+                Empty    r -> r++runP :: (Stream s Identity t)+     => Parsec s u a -> u -> SourceName -> s -> Either ParseError a+runP p u name s = runIdentity $ runPT p u name s++-- | The most general way to run a parser. @runParserT p state filePath+-- input@ runs parser @p@ on the input list of tokens @input@,+-- obtained from source @filePath@ with the initial user state @st@.+-- The @filePath@ is only used in error messages and may be the empty+-- string. Returns a computation in the underlying monad @m@ that return either a 'ParseError' ('Left') or a+-- value of type @a@ ('Right').++runParserT :: (Stream s m t)+           => ParsecT s u m a -> u -> SourceName -> s -> m (Either ParseError a)+runParserT = runPT++-- | The most general way to run a parser over the Identity monad. @runParser p state filePath+-- input@ runs parser @p@ on the input list of tokens @input@,+-- obtained from source @filePath@ with the initial user state @st@.+-- The @filePath@ is only used in error messages and may be the empty+-- string. Returns either a 'ParseError' ('Left') or a+-- value of type @a@ ('Right').+--+-- >  parseFromFile p fname+-- >    = do{ input <- readFile fname+-- >        ; return (runParser p () fname input)+-- >        }++runParser :: (Stream s Identity t)+          => Parsec s u a -> u -> SourceName -> s -> Either ParseError a+runParser = runP++-- | @parse p filePath input@ runs a parser @p@ over Identity without user+-- state. The @filePath@ is only used in error messages and may be the+-- empty string. Returns either a 'ParseError' ('Left')+-- or a value of type @a@ ('Right').+--+-- >  main    = case (parse numbers "" "11, 2, 43") of+-- >             Left err  -> print err+-- >             Right xs  -> print (sum xs)+-- >+-- >  numbers = commaSep integer++parse :: (Stream s Identity t)+      => Parsec s () a -> SourceName -> s -> Either ParseError a+parse p = runP p ()++-- | The expression @parseTest p input@ applies a parser @p@ against+-- input @input@ and prints the result to stdout. Used for testing+-- parsers.++parseTest :: (Stream s Identity t, Show a)+          => Parsec s () a -> s -> IO ()+parseTest p input+    = case parse p "" input of+        Left err -> do putStr "parse error at "+                       print err+        Right x  -> print x++-- < Parser state combinators++-- | Returns the current source position. See also 'SourcePos'.++getPosition :: (Monad m) => ParsecT s u m SourcePos+getPosition = do state <- getParserState+                 return (statePos state)++-- | Returns the current input++getInput :: (Monad m) => ParsecT s u m s+getInput = do state <- getParserState+              return (stateInput state)++-- | @setPosition pos@ sets the current source position to @pos@.++setPosition :: (Monad m) => SourcePos -> ParsecT s u m ()+setPosition pos+    = do _ <- updateParserState (\(State input _ user) -> State input pos user)+         return ()++-- | @setInput input@ continues parsing with @input@. The 'getInput' and+-- @setInput@ functions can for example be used to deal with #include+-- files.++setInput :: (Monad m) => s -> ParsecT s u m ()+setInput input+    = do _ <- updateParserState (\(State _ pos user) -> State input pos user)+         return ()++-- | Returns the full parser state as a 'State' record.++getParserState :: (Monad m) => ParsecT s u m (State s u)+getParserState = updateParserState id++-- | @setParserState st@ set the full parser state to @st@.++setParserState :: (Monad m) => State s u -> ParsecT s u m (State s u)+setParserState st = updateParserState (const st)++-- | @updateParserState f@ applies function @f@ to the parser state.++updateParserState :: (State s u -> State s u) -> ParsecT s u m (State s u)+updateParserState f =+    ParsecT $ \s _ _ eok _ ->+    let s' = f s+    in eok s' s' $ unknownError s'++-- < User state combinators++-- | Returns the current user state.++getState :: (Monad m) => ParsecT s u m u+getState = stateUser `liftM` getParserState++-- | @putState st@ set the user state to @st@.++putState :: (Monad m) => u -> ParsecT s u m ()+putState u = do _ <- updateParserState $ \s -> s { stateUser = u }+                return ()++-- | @modifyState f@ applies function @f@ to the user state. Suppose+-- that we want to count identifiers in a source, we could use the user+-- state as:+--+-- >  expr  = do{ x <- identifier+-- >            ; modifyState (+1)+-- >            ; return (Id x)+-- >            }++modifyState :: (Monad m) => (u -> u) -> ParsecT s u m ()+modifyState f = do _ <- updateParserState $ \s -> s { stateUser = f (stateUser s) }+                   return ()++-- XXX Compat++-- | An alias for putState for backwards compatibility.++setState :: (Monad m) => u -> ParsecT s u m ()+setState = putState++-- | An alias for modifyState for backwards compatibility.++updateState :: (Monad m) => (u -> u) -> ParsecT s u m ()+updateState = modifyState
+ src/Text/Parsec/String.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Parsec.String+-- Copyright   :  (c) Paolo Martini 2007+-- License     :  BSD-style (see the file libraries/parsec/LICENSE)+--+-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  portable+--+-- Make Strings an instance of 'Stream' with 'Char' token type.+--+-----------------------------------------------------------------------------++module Text.Parsec.String+    ( Parser, GenParser, parseFromFile+    ) where++import Text.Parsec.Error+import Text.Parsec.Prim++type Parser = Parsec String ()+type GenParser tok st = Parsec [tok] st++-- | @parseFromFile p filePath@ runs a string parser @p@ on the+-- input read from @filePath@ using 'Prelude.readFile'. Returns either a 'ParseError'+-- ('Left') or a value of type @a@ ('Right').+--+-- >  main    = do{ result <- parseFromFile numbers "digits.txt"+-- >              ; case result of+-- >                  Left err  -> print err+-- >                  Right xs  -> print (sum xs)+-- >              }+parseFromFile :: Parser a -> FilePath -> IO (Either ParseError a)+parseFromFile p fname+    = do input <- readFile fname+         return (runP p () fname input)
+ src/Text/Parsec/Text.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Parsec.String+-- Copyright   :  (c) Antoine Latter 2011+-- License     :  BSD-style (see the file libraries/parsec/LICENSE)+--+-- Maintainer  :  aslatter@gmail.com+-- Stability   :  provisional+-- Portability :  portable+--+-- Convenience definitions for working with 'Text.Text'.+--+-----------------------------------------------------------------------------++module Text.Parsec.Text+    ( Parser, GenParser, parseFromFile+    ) where++import qualified Data.Text as Text+import qualified Data.Text.IO as T++import Text.Parsec.Prim+import Text.Parsec.Error++type Parser = Parsec Text.Text ()+type GenParser st = Parsec Text.Text st++-- | @parseFromFile p filePath@ runs a strict text parser @p@ on the+-- input read from @filePath@ using 'Data.Text.IO.readFile'. Returns either a 'ParseError'+-- ('Left') or a value of type @a@ ('Right').+--+-- >  main    = do{ result <- parseFromFile numbers "digits.txt"+-- >              ; case result of+-- >                  Left err  -> print err+-- >                  Right xs  -> print (sum xs)+-- >              }+--+-- @since 3.1.14.0++parseFromFile :: Parser a -> FilePath -> IO (Either ParseError a)+parseFromFile p fname+    = do input <- T.readFile fname+         return (runP p () fname input)
+ src/Text/Parsec/Text/Lazy.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Parsec.String+-- Copyright   :  (c) Antoine Latter 2011+-- License     :  BSD-style (see the file libraries/parsec/LICENSE)+--+-- Maintainer  :  aslatter@gmail.com+-- Stability   :  provisional+-- Portability :  portable+--+-- Convenience definitions for working with lazy 'Text.Text'.+--+-----------------------------------------------------------------------------++module Text.Parsec.Text.Lazy+    ( Parser, GenParser, parseFromFile+    ) where++import qualified Data.Text.Lazy as Text+import qualified Data.Text.Lazy.IO as TL++import Text.Parsec.Prim+import Text.Parsec.Error++type Parser = Parsec Text.Text ()+type GenParser st = Parsec Text.Text st++-- | @parseFromFile p filePath@ runs a strict text parser @p@ on the+-- input read from @filePath@ using 'Data.Text.Lazy.IO.readFile'. Returns either a 'ParseError'+-- ('Left') or a value of type @a@ ('Right').+--+-- >  main    = do{ result <- parseFromFile numbers "digits.txt"+-- >              ; case result of+-- >                  Left err  -> print err+-- >                  Right xs  -> print (sum xs)+-- >              }+--+-- @since 3.1.14.0++parseFromFile :: Parser a -> FilePath -> IO (Either ParseError a)+parseFromFile p fname+    = do input <- TL.readFile fname+         return (runP p () fname input)
+ src/Text/Parsec/Token.hs view
@@ -0,0 +1,732 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE PolymorphicComponents #-}+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Parsec.Token+-- Copyright   :  (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+--+-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  non-portable (uses local universal quantification: PolymorphicComponents)+--+-- A helper module to parse lexical elements (tokens). See 'makeTokenParser'+-- for a description of how to use it.+--+-----------------------------------------------------------------------------++{-# OPTIONS_GHC -fno-warn-name-shadowing #-}++module Text.Parsec.Token+    ( LanguageDef+    , GenLanguageDef (..)+    , TokenParser+    , GenTokenParser (..)+    , makeTokenParser+    ) where++import Data.Char ( isAlpha, toLower, toUpper, isSpace, digitToInt )+import Data.Typeable ( Typeable )+import Data.List ( nub, sort )+import Control.Monad.Identity (Identity)++import Text.Parsec.Prim+import Text.Parsec.Char+import Text.Parsec.Combinator++-----------------------------------------------------------+-- Language Definition+-----------------------------------------------------------++type LanguageDef st = GenLanguageDef String st Identity++-- | The @GenLanguageDef@ type is a record that contains all parameterizable+-- features of the "Text.Parsec.Token" module. The module "Text.Parsec.Language"+-- contains some default definitions.++data GenLanguageDef s u m+    = LanguageDef {++    -- | Describes the start of a block comment. Use the empty string if the+    -- language doesn't support block comments. For example \"\/*\".++    commentStart   :: String,++    -- | Describes the end of a block comment. Use the empty string if the+    -- language doesn't support block comments. For example \"*\/\".++    commentEnd     :: String,++    -- | Describes the start of a line comment. Use the empty string if the+    -- language doesn't support line comments. For example \"\/\/\".++    commentLine    :: String,++    -- | Set to 'True' if the language supports nested block comments.++    nestedComments :: Bool,++    -- | This parser should accept any start characters of identifiers. For+    -- example @letter \<|> char \'_\'@.++    identStart     :: ParsecT s u m Char,++    -- | This parser should accept any legal tail characters of identifiers.+    -- For example @alphaNum \<|> char \'_\'@.++    identLetter    :: ParsecT s u m Char,++    -- | This parser should accept any start characters of operators. For+    -- example @oneOf \":!#$%&*+.\/\<=>?\@\\\\^|-~\"@++    opStart        :: ParsecT s u m Char,++    -- | This parser should accept any legal tail characters of operators.+    -- Note that this parser should even be defined if the language doesn't+    -- support user-defined operators, or otherwise the 'reservedOp'+    -- parser won't work correctly.++    opLetter       :: ParsecT s u m Char,++    -- | The list of reserved identifiers.++    reservedNames  :: [String],++    -- | The list of reserved operators.++    reservedOpNames:: [String],++    -- | Set to 'True' if the language is case sensitive.++    caseSensitive  :: Bool++    }+    deriving ( Typeable )++-----------------------------------------------------------+-- A first class module: TokenParser+-----------------------------------------------------------++type TokenParser st = GenTokenParser String st Identity++-- | The type of the record that holds lexical parsers that work on+-- @s@ streams with state @u@ over a monad @m@.++data GenTokenParser s u m+    = TokenParser {++        -- | This lexeme parser parses a legal identifier. Returns the identifier+        -- string. This parser will fail on identifiers that are reserved+        -- words. Legal identifier (start) characters and reserved words are+        -- defined in the 'LanguageDef' that is passed to+        -- 'makeTokenParser'. An @identifier@ is treated as+        -- a single token using 'try'.++        identifier       :: ParsecT s u m String,++        -- | The lexeme parser @reserved name@ parses @symbol+        -- name@, but it also checks that the @name@ is not a prefix of a+        -- valid identifier. A @reserved@ word is treated as a single token+        -- using 'try'.++        reserved         :: String -> ParsecT s u m (),++        -- | This lexeme parser parses a legal operator. Returns the name of the+        -- operator. This parser will fail on any operators that are reserved+        -- operators. Legal operator (start) characters and reserved operators+        -- are defined in the 'LanguageDef' that is passed to+        -- 'makeTokenParser'. An @operator@ is treated as a+        -- single token using 'try'.++        operator         :: ParsecT s u m String,++        -- |The lexeme parser @reservedOp name@ parses @symbol+        -- name@, but it also checks that the @name@ is not a prefix of a+        -- valid operator. A @reservedOp@ is treated as a single token using+        -- 'try'.++        reservedOp       :: String -> ParsecT s u m (),+++        -- | This lexeme parser parses a single literal character. Returns the+        -- literal character value. This parsers deals correctly with escape+        -- sequences. The literal character is parsed according to the grammar+        -- rules defined in the Haskell report (which matches most programming+        -- languages quite closely).++        charLiteral      :: ParsecT s u m Char,++        -- | This lexeme parser parses a literal string. Returns the literal+        -- string value. This parsers deals correctly with escape sequences and+        -- gaps. The literal string is parsed according to the grammar rules+        -- defined in the Haskell report (which matches most programming+        -- languages quite closely).++        stringLiteral    :: ParsecT s u m String,++        -- | This lexeme parser parses a natural number (a non-negative whole+        -- number). Returns the value of the number. The number can be+        -- specified in 'decimal', 'hexadecimal' or+        -- 'octal'. The number is parsed according to the grammar+        -- rules in the Haskell report.++        natural          :: ParsecT s u m Integer,++        -- | This lexeme parser parses an integer (a whole number). This parser+        -- is like 'natural' except that it can be prefixed with+        -- sign (i.e. \'-\' or \'+\'). Returns the value of the number. The+        -- number can be specified in 'decimal', 'hexadecimal'+        -- or 'octal'. The number is parsed according+        -- to the grammar rules in the Haskell report.++        integer          :: ParsecT s u m Integer,++        -- | This lexeme parser parses a floating point value. Returns the value+        -- of the number. The number is parsed according to the grammar rules+        -- defined in the Haskell report.++        float            :: ParsecT s u m Double,++        -- | This lexeme parser parses either 'natural' or a 'float'.+        -- Returns the value of the number. This parsers deals with+        -- any overlap in the grammar rules for naturals and floats. The number+        -- is parsed according to the grammar rules defined in the Haskell report.++        naturalOrFloat   :: ParsecT s u m (Either Integer Double),++        -- | Parses a non-negative whole number in the decimal system. Returns the+        -- value of the number.++        decimal          :: ParsecT s u m Integer,++        -- | Parses a non-negative whole number in the hexadecimal system. The+        -- number should be prefixed with \"x\" or \"X\". Returns the value of the+        -- number.++        hexadecimal      :: ParsecT s u m Integer,++        -- | Parses a non-negative whole number in the octal system. The number+        -- should be prefixed with \"o\" or \"O\". Returns the value of the+        -- number.++        octal            :: ParsecT s u m Integer,++        -- | Lexeme parser @symbol s@ parses 'string' @s@ and skips+        -- trailing white space.++        symbol           :: String -> ParsecT s u m String,++        -- | @lexeme p@ first applies parser @p@ and then the 'whiteSpace'+        -- parser, returning the value of @p@. Every lexical+        -- token (lexeme) is defined using @lexeme@, this way every parse+        -- starts at a point without white space. Parsers that use @lexeme@ are+        -- called /lexeme/ parsers in this document.+        --+        -- The only point where the 'whiteSpace' parser should be+        -- called explicitly is the start of the main parser in order to skip+        -- any leading white space.+        --+        -- >    mainParser  = do{ whiteSpace+        -- >                     ; ds <- many (lexeme digit)+        -- >                     ; eof+        -- >                     ; return (sum ds)+        -- >                     }++        lexeme           :: forall a. ParsecT s u m a -> ParsecT s u m a,++        -- | Parses any white space. White space consists of /zero/ or more+        -- occurrences of a 'space', a line comment or a block (multi+        -- line) comment. Block comments may be nested. How comments are+        -- started and ended is defined in the 'LanguageDef'+        -- that is passed to 'makeTokenParser'.++        whiteSpace       :: ParsecT s u m (),++        -- | Lexeme parser @parens p@ parses @p@ enclosed in parenthesis,+        -- returning the value of @p@.++        parens           :: forall a. ParsecT s u m a -> ParsecT s u m a,++        -- | Lexeme parser @braces p@ parses @p@ enclosed in braces (\'{\' and+        -- \'}\'), returning the value of @p@.++        braces           :: forall a. ParsecT s u m a -> ParsecT s u m a,++        -- | Lexeme parser @angles p@ parses @p@ enclosed in angle brackets (\'\<\'+        -- and \'>\'), returning the value of @p@.++        angles           :: forall a. ParsecT s u m a -> ParsecT s u m a,++        -- | Lexeme parser @brackets p@ parses @p@ enclosed in brackets (\'[\'+        -- and \']\'), returning the value of @p@.++        brackets         :: forall a. ParsecT s u m a -> ParsecT s u m a,++        -- | DEPRECATED: Use 'brackets'.++        squares          :: forall a. ParsecT s u m a -> ParsecT s u m a,++        -- | Lexeme parser |semi| parses the character \';\' and skips any+        -- trailing white space. Returns the string \";\".++        semi             :: ParsecT s u m String,++        -- | Lexeme parser @comma@ parses the character \',\' and skips any+        -- trailing white space. Returns the string \",\".++        comma            :: ParsecT s u m String,++        -- | Lexeme parser @colon@ parses the character \':\' and skips any+        -- trailing white space. Returns the string \":\".++        colon            :: ParsecT s u m String,++        -- | Lexeme parser @dot@ parses the character \'.\' and skips any+        -- trailing white space. Returns the string \".\".++        dot              :: ParsecT s u m String,++        -- | Lexeme parser @semiSep p@ parses /zero/ or more occurrences of @p@+        -- separated by 'semi'. Returns a list of values returned by+        -- @p@.++        semiSep          :: forall a . ParsecT s u m a -> ParsecT s u m [a],++        -- | Lexeme parser @semiSep1 p@ parses /one/ or more occurrences of @p@+        -- separated by 'semi'. Returns a list of values returned by @p@.++        semiSep1         :: forall a . ParsecT s u m a -> ParsecT s u m [a],++        -- | Lexeme parser @commaSep p@ parses /zero/ or more occurrences of+        -- @p@ separated by 'comma'. Returns a list of values returned+        -- by @p@.++        commaSep         :: forall a . ParsecT s u m a -> ParsecT s u m [a],++        -- | Lexeme parser @commaSep1 p@ parses /one/ or more occurrences of+        -- @p@ separated by 'comma'. Returns a list of values returned+        -- by @p@.++        commaSep1        :: forall a . ParsecT s u m a -> ParsecT s u m [a]+    }+    deriving ( Typeable )++-----------------------------------------------------------+-- Given a LanguageDef, create a token parser.+-----------------------------------------------------------++-- | The expression @makeTokenParser language@ creates a 'GenTokenParser'+-- record that contains lexical parsers that are+-- defined using the definitions in the @language@ record.+--+-- The use of this function is quite stylized - one imports the+-- appropriate language definition and selects the lexical parsers that+-- are needed from the resulting 'GenTokenParser'.+--+-- >  module Main where+-- >+-- >  import Text.Parsec+-- >  import qualified Text.Parsec.Token as P+-- >  import Text.Parsec.Language (haskellDef)+-- >+-- >  -- The parser+-- >  ...+-- >+-- >  expr  =   parens expr+-- >        <|> identifier+-- >        <|> ...+-- >+-- >+-- >  -- The lexer+-- >  lexer       = P.makeTokenParser haskellDef+-- >+-- >  parens      = P.parens lexer+-- >  braces      = P.braces lexer+-- >  identifier  = P.identifier lexer+-- >  reserved    = P.reserved lexer+-- >  ...++makeTokenParser :: (Stream s m Char)+                => GenLanguageDef s u m -> GenTokenParser s u m+{-# INLINABLE makeTokenParser #-}+makeTokenParser languageDef+    = TokenParser{ identifier = identifier+                 , reserved = reserved+                 , operator = operator+                 , reservedOp = reservedOp++                 , charLiteral = charLiteral+                 , stringLiteral = stringLiteral+                 , natural = natural+                 , integer = integer+                 , float = float+                 , naturalOrFloat = naturalOrFloat+                 , decimal = decimal+                 , hexadecimal = hexadecimal+                 , octal = octal++                 , symbol = symbol+                 , lexeme = lexeme+                 , whiteSpace = whiteSpace++                 , parens = parens+                 , braces = braces+                 , angles = angles+                 , brackets = brackets+                 , squares = brackets+                 , semi = semi+                 , comma = comma+                 , colon = colon+                 , dot = dot+                 , semiSep = semiSep+                 , semiSep1 = semiSep1+                 , commaSep = commaSep+                 , commaSep1 = commaSep1+                 }+    where++    -----------------------------------------------------------+    -- Bracketing+    -----------------------------------------------------------+    parens p        = between (symbol "(") (symbol ")") p+    braces p        = between (symbol "{") (symbol "}") p+    angles p        = between (symbol "<") (symbol ">") p+    brackets p      = between (symbol "[") (symbol "]") p++    semi            = symbol ";"+    comma           = symbol ","+    dot             = symbol "."+    colon           = symbol ":"++    commaSep p      = sepBy p comma+    semiSep p       = sepBy p semi++    commaSep1 p     = sepBy1 p comma+    semiSep1 p      = sepBy1 p semi+++    -----------------------------------------------------------+    -- Chars & Strings+    -----------------------------------------------------------+    charLiteral     = lexeme (between (char '\'')+                                      (char '\'' <?> "end of character")+                                      characterChar )+                    <?> "character"++    characterChar   = charLetter <|> charEscape+                    <?> "literal character"++    charEscape      = do{ _ <- char '\\'; escapeCode }+    charLetter      = satisfy (\c -> (c /= '\'') && (c /= '\\') && (c > '\026'))++++    stringLiteral   = lexeme (+                      do{ str <- between (char '"')+                                         (char '"' <?> "end of string")+                                         (many stringChar)+                        ; return (foldr (maybe id (:)) "" str)+                        }+                      <?> "literal string")++    stringChar      =   do{ c <- stringLetter; return (Just c) }+                    <|> stringEscape+                    <?> "string character"++    stringLetter    = satisfy (\c -> (c /= '"') && (c /= '\\') && (c > '\026'))++    stringEscape    = do{ _ <- char '\\'+                        ;     do{ _ <- escapeGap  ; return Nothing }+                          <|> do{ _ <- escapeEmpty; return Nothing }+                          <|> do{ esc <- escapeCode; return (Just esc) }+                        }++    escapeEmpty     = char '&'+    escapeGap       = do{ _ <- many1 space+                        ; char '\\' <?> "end of string gap"+                        }++++    -- escape codes+    escapeCode      = charEsc <|> charNum <|> charAscii <|> charControl+                    <?> "escape code"++    charControl     = do{ _ <- char '^'+                        ; code <- upper+                        ; return (toEnum (fromEnum code - fromEnum 'A' + 1))+                        }++    charNum         = do{ code <- decimal+                                  <|> do{ _ <- char 'o'; number 8 octDigit }+                                  <|> do{ _ <- char 'x'; number 16 hexDigit }+                        ; if code > 0x10FFFF+                          then fail "invalid escape sequence"+                          else return (toEnum (fromInteger code))+                        }++    charEsc         = choice (map parseEsc escMap)+                    where+                      parseEsc (c,code)     = do{ _ <- char c; return code }++    charAscii       = choice (map parseAscii asciiMap)+                    where+                      parseAscii (asc,code) = try (do{ _ <- string asc; return code })+++    -- escape code tables+    escMap          = zip ("abfnrtv\\\"\'") ("\a\b\f\n\r\t\v\\\"\'")+    asciiMap        = zip (ascii3codes ++ ascii2codes) (ascii3 ++ ascii2)++    ascii2codes     = ["BS","HT","LF","VT","FF","CR","SO","SI","EM",+                       "FS","GS","RS","US","SP"]+    ascii3codes     = ["NUL","SOH","STX","ETX","EOT","ENQ","ACK","BEL",+                       "DLE","DC1","DC2","DC3","DC4","NAK","SYN","ETB",+                       "CAN","SUB","ESC","DEL"]++    ascii2          = ['\BS','\HT','\LF','\VT','\FF','\CR','\SO','\SI',+                       '\EM','\FS','\GS','\RS','\US','\SP']+    ascii3          = ['\NUL','\SOH','\STX','\ETX','\EOT','\ENQ','\ACK',+                       '\BEL','\DLE','\DC1','\DC2','\DC3','\DC4','\NAK',+                       '\SYN','\ETB','\CAN','\SUB','\ESC','\DEL']+++    -----------------------------------------------------------+    -- Numbers+    -----------------------------------------------------------+    naturalOrFloat  = lexeme (natFloat) <?> "number"++    float           = lexeme floating   <?> "float"+    integer         = lexeme int        <?> "integer"+    natural         = lexeme nat        <?> "natural"+++    -- floats+    floating        = do{ n <- decimal+                        ; fractExponent n+                        }+++    natFloat        = do{ _ <- char '0'+                        ; zeroNumFloat+                        }+                      <|> decimalFloat++    zeroNumFloat    =  do{ n <- hexadecimal <|> octal+                         ; return (Left n)+                         }+                    <|> decimalFloat+                    <|> fractFloat (0 :: Integer)+                    <|> return (Left 0)++    decimalFloat    = do{ n <- decimal+                        ; option (Left n)+                                 (fractFloat n)+                        }++    fractFloat n    = do{ f <- fractExponent n+                        ; return (Right f)+                        }++    fractExponent n = do{ fract <- fraction+                        ; expo  <- option "" exponent'+                        ; readDouble (show n ++ fract ++ expo)+                        }+                    <|>+                      do{ expo <- exponent'+                        ; readDouble (show n ++ expo)+                        }+                      where+                        readDouble s =+                          case reads s of+                            [(x, "")] -> return x+                            _         -> parserZero++    fraction        = do{ _ <- char '.'+                        ; digits <- many1 digit <?> "fraction"+                        ; return ('.' : digits)+                        }+                      <?> "fraction"++    exponent'       = do{ _ <- oneOf "eE"+                        ; sign' <- fmap (:[]) (oneOf "+-") <|> return ""+                        ; e <- decimal <?> "exponent"+                        ; return ('e' : sign' ++ show e)+                        }+                      <?> "exponent"+++    -- integers and naturals+    int             = do{ f <- lexeme sign+                        ; n <- nat+                        ; return (f n)+                        }++    sign            =   (char '-' >> return negate)+                    <|> (char '+' >> return id)+                    <|> return id++    nat             = zeroNumber <|> decimal++    zeroNumber      = do{ _ <- char '0'+                        ; hexadecimal <|> octal <|> decimal <|> return 0+                        }+                      <?> ""++    decimal         = number 10 digit+    hexadecimal     = do{ _ <- oneOf "xX"; number 16 hexDigit }+    octal           = do{ _ <- oneOf "oO"; number 8 octDigit  }++    number base baseDigit+        = do{ digits <- many1 baseDigit+            ; let n = foldl (\x d -> base*x + toInteger (digitToInt d)) 0 digits+            ; seq n (return n)+            }++    -----------------------------------------------------------+    -- Operators & reserved ops+    -----------------------------------------------------------+    reservedOp name =+        lexeme $ try $+        do{ _ <- string name+          ; notFollowedBy (opLetter languageDef) <?> ("end of " ++ show name)+          }++    operator =+        lexeme $ try $+        do{ name <- oper+          ; if (isReservedOp name)+             then unexpected ("reserved operator " ++ show name)+             else return name+          }++    oper =+        do{ c <- (opStart languageDef)+          ; cs <- many (opLetter languageDef)+          ; return (c:cs)+          }+        <?> "operator"++    isReservedOp name =+        isReserved (sort (reservedOpNames languageDef)) name+++    -----------------------------------------------------------+    -- Identifiers & Reserved words+    -----------------------------------------------------------+    reserved name =+        lexeme $ try $+        do{ _ <- caseString name+          ; notFollowedBy (identLetter languageDef) <?> ("end of " ++ show name)+          }++    caseString name+        | caseSensitive languageDef  = string name+        | otherwise               = do{ walk name; return name }+        where+          walk []     = return ()+          walk (c:cs) = do{ _ <- caseChar c <?> msg; walk cs }++          caseChar c  | isAlpha c  = char (toLower c) <|> char (toUpper c)+                      | otherwise  = char c++          msg         = show name+++    identifier =+        lexeme $ try $+        do{ name <- ident+          ; if (isReservedName name)+             then unexpected ("reserved word " ++ show name)+             else return name+          }+++    ident+        = do{ c <- identStart languageDef+            ; cs <- many (identLetter languageDef)+            ; return (c:cs)+            }+        <?> "identifier"++    isReservedName name+        = isReserved theReservedNames caseName+        where+          caseName      | caseSensitive languageDef  = name+                        | otherwise               = map toLower name+++    isReserved names name+        = scan names+        where+          scan []       = False+          scan (r:rs)   = case (compare r name) of+                            LT  -> scan rs+                            EQ  -> True+                            GT  -> False++    theReservedNames+        | caseSensitive languageDef  = sort reserved+        | otherwise                  = sort . map (map toLower) $ reserved+        where+          reserved = reservedNames languageDef++++    -----------------------------------------------------------+    -- White space & symbols+    -----------------------------------------------------------+    symbol name+        = lexeme (string name)++    lexeme p+        = do{ x <- p; whiteSpace; return x  }+++    --whiteSpace+    whiteSpace+        | noLine && noMulti  = skipMany (simpleSpace <?> "")+        | noLine             = skipMany (simpleSpace <|> multiLineComment <?> "")+        | noMulti            = skipMany (simpleSpace <|> oneLineComment <?> "")+        | otherwise          = skipMany (simpleSpace <|> oneLineComment <|> multiLineComment <?> "")+        where+          noLine  = null (commentLine languageDef)+          noMulti = null (commentStart languageDef)+++    simpleSpace =+        skipMany1 (satisfy isSpace)++    oneLineComment =+        do{ _ <- try (string (commentLine languageDef))+          ; skipMany (satisfy (/= '\n'))+          ; return ()+          }++    multiLineComment =+        do { _ <- try (string (commentStart languageDef))+           ; inComment+           }++    inComment+        | nestedComments languageDef  = inCommentMulti+        | otherwise                = inCommentSingle++    inCommentMulti+        =   do{ _ <- try (string (commentEnd languageDef)) ; return () }+        <|> do{ multiLineComment                     ; inCommentMulti }+        <|> do{ skipMany1 (noneOf startEnd)          ; inCommentMulti }+        <|> do{ _ <- oneOf startEnd                  ; inCommentMulti }+        <?> "end of comment"+        where+          startEnd   = nub (commentEnd languageDef ++ commentStart languageDef)++    inCommentSingle+        =   do{ _ <- try (string (commentEnd languageDef)); return () }+        <|> do{ skipMany1 (noneOf startEnd)         ; inCommentSingle }+        <|> do{ _ <- oneOf startEnd                 ; inCommentSingle }+        <?> "end of comment"+        where+          startEnd   = nub (commentEnd languageDef ++ commentStart languageDef)
+ src/Text/ParserCombinators/Parsec.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Text.ParserCombinators.Parsec+-- Copyright   :  (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+--+-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  portable+--+-- Parsec compatibility module+--+-----------------------------------------------------------------------------++module Text.ParserCombinators.Parsec+    ( -- complete modules+      module Text.ParserCombinators.Parsec.Prim+    , module Text.ParserCombinators.Parsec.Combinator+    , module Text.ParserCombinators.Parsec.Char++    -- module Text.ParserCombinators.Parsec.Error+    , ParseError+    , errorPos++    -- module Text.ParserCombinators.Parsec.Pos+    , SourcePos+    , SourceName, Line, Column+    , sourceName, sourceLine, sourceColumn+    , incSourceLine, incSourceColumn+    , setSourceLine, setSourceColumn, setSourceName++    ) where++import Text.Parsec.String()++import Text.ParserCombinators.Parsec.Prim+import Text.ParserCombinators.Parsec.Combinator+import Text.ParserCombinators.Parsec.Char++import Text.ParserCombinators.Parsec.Error+import Text.ParserCombinators.Parsec.Pos
+ src/Text/ParserCombinators/Parsec/Char.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Text.ParserCombinators.Parsec.Char+-- Copyright   :  (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+--+-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  portable+--+-- Parsec compatibility module+--+-----------------------------------------------------------------------------++module Text.ParserCombinators.Parsec.Char+    ( CharParser,+      spaces,+      space,+      newline,+      tab,+      upper,+      lower,+      alphaNum,+      letter,+      digit,+      hexDigit,+      octDigit,+      char,+      string,+      anyChar,+      oneOf,+      noneOf,+      satisfy+    ) where+++import Text.Parsec.Char+import Text.Parsec.String++type CharParser st = GenParser Char st
+ src/Text/ParserCombinators/Parsec/Combinator.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Text.ParserCombinators.Parsec.Combinator+-- Copyright   :  (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+--+-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  portable+--+-- Parsec compatibility module+--+-----------------------------------------------------------------------------++module Text.ParserCombinators.Parsec.Combinator+    ( choice,+      count,+      between,+      option,+      optionMaybe,+      optional,+      skipMany1,+      many1,+      sepBy,+      sepBy1,+      endBy,+      endBy1,+      sepEndBy,+      sepEndBy1,+      chainl,+      chainl1,+      chainr,+      chainr1,+      eof,+      notFollowedBy,+      manyTill,+      lookAhead,+      anyToken+    ) where+++import Text.Parsec.Combinator
+ src/Text/ParserCombinators/Parsec/Error.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Text.ParserCombinators.Parsec.Error+-- Copyright   :  (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+--+-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  portable+--+-- Parsec compatibility module+--+-----------------------------------------------------------------------------++module Text.ParserCombinators.Parsec.Error+    ( Message (SysUnExpect,UnExpect,Expect,Message),+      messageString,+      messageCompare,+      messageEq,+      ParseError,+      errorPos,+      errorMessages,+      errorIsUnknown,+      showErrorMessages,+      newErrorMessage,+      newErrorUnknown,+      addErrorMessage,+      setErrorPos,+      setErrorMessage,+      mergeError+    ) where++import Text.Parsec.Error+++messageCompare :: Message -> Message -> Ordering+messageCompare = compare++messageEq :: Message -> Message -> Bool+messageEq = (==)
+ src/Text/ParserCombinators/Parsec/Expr.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Text.ParserCombinators.Parsec.Expr+-- Copyright   :  (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+--+-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  portable+--+-- Parsec compatibility module+--+-----------------------------------------------------------------------------++module Text.ParserCombinators.Parsec.Expr+    ( Assoc (AssocNone,AssocLeft,AssocRight),+      Operator(..),+      OperatorTable,+      buildExpressionParser+    ) where++import Text.Parsec.Expr(Assoc(..))+import qualified Text.Parsec.Expr as N+import Text.ParserCombinators.Parsec(GenParser)++import Control.Monad.Identity (Identity)++data Operator tok st a   = Infix  (GenParser tok st (a -> a -> a)) Assoc+                         | Prefix (GenParser tok st (a -> a))+                         | Postfix (GenParser tok st (a -> a))++type OperatorTable tok st a = [[Operator tok st a]]++convert :: Operator tok st a -> N.Operator [tok] st Identity a+convert (Infix p a) = N.Infix p a+convert (Prefix p)  = N.Prefix p+convert (Postfix p)  = N.Postfix p++buildExpressionParser :: OperatorTable tok st a+                      -> GenParser tok st a+                      -> GenParser tok st a+buildExpressionParser = N.buildExpressionParser . map (map convert)
+ src/Text/ParserCombinators/Parsec/Language.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Text.ParserCombinators.Parsec.Language+-- Copyright   :  (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+--+-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  portable+--+-- Parsec compatibility module+--+-----------------------------------------------------------------------------++module Text.ParserCombinators.Parsec.Language+    ( haskellDef,+      haskell,+      mondrianDef,+      mondrian,+      emptyDef,+      haskellStyle,+      javaStyle,+      LanguageDef,+      GenLanguageDef(..),+    ) where++import Text.Parsec.Token+import Text.Parsec.Language
+ src/Text/ParserCombinators/Parsec/Perm.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Text.ParserCombinators.Parsec.Perm+-- Copyright   :  (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+--+-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  portable+--+-- Parsec compatibility module+--+-----------------------------------------------------------------------------++module Text.ParserCombinators.Parsec.Perm+    ( PermParser,+      permute,+      (<||>),+      (<$$>),+      (<|?>),+      (<$?>)+    ) where++import Text.Parsec.Perm
+ src/Text/ParserCombinators/Parsec/Pos.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Text.ParserCombinators.Parsec.Pos+-- Copyright   :  (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+--+-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  portable+--+-- Parsec compatibility module+--+-----------------------------------------------------------------------------++module Text.ParserCombinators.Parsec.Pos+    ( SourceName,+      Line,+      Column,+      SourcePos,+      sourceLine,+      sourceColumn,+      sourceName,+      incSourceLine,+      incSourceColumn,+      setSourceLine,+      setSourceColumn,+      setSourceName,+      newPos,+      initialPos,+      updatePosChar,+      updatePosString+    ) where+++import Text.Parsec.Pos
+ src/Text/ParserCombinators/Parsec/Prim.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Text.ParserCombinators.Parsec.Prim+-- Copyright   :  (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+--+-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  portable+--+-- Parsec compatibility module+--+-----------------------------------------------------------------------------++module Text.ParserCombinators.Parsec.Prim+    ( (<?>),+      (<|>),+      Parser,+      GenParser,+      runParser,+      parse,+      parseFromFile,+      parseTest,+      token,+      tokens,+      tokenPrim,+      tokenPrimEx,+      try,+      label,+      labels,+      unexpected,+      pzero,+      many,+      skipMany,+      getState,+      setState,+      updateState,+      getPosition,+      setPosition,+      getInput,+      setInput,+      State(..),+      getParserState,+      setParserState+    ) where++import Text.Parsec.Prim hiding (runParser, try)+import qualified Text.Parsec.Prim as N -- 'N' for 'New'+import Text.Parsec.String++import Text.Parsec.Error+import Text.Parsec.Pos++pzero :: GenParser tok st a+pzero = parserZero++runParser :: GenParser tok st a+          -> st+          -> SourceName+          -> [tok]+          -> Either ParseError a+runParser = N.runParser++try :: GenParser tok st a -> GenParser tok st a+try = N.try
+ src/Text/ParserCombinators/Parsec/Token.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Text.ParserCombinators.Parsec.Token+-- Copyright   :  (c) Paolo Martini 2007+-- License     :  BSD-style (see the LICENSE file)+--+-- Maintainer  :  derek.a.elkins@gmail.com+-- Stability   :  provisional+-- Portability :  portable+--+-- Parsec compatibility module+--+-----------------------------------------------------------------------------++module Text.ParserCombinators.Parsec.Token+    ( LanguageDef,+      GenLanguageDef(..),+      TokenParser,+      GenTokenParser(..),+      makeTokenParser+    ) where++import Text.Parsec.Token
+ test/Bugs.hs view
@@ -0,0 +1,18 @@++module Bugs+       ( bugs+       ) where++import Test.Tasty++import qualified Bugs.Bug2+import qualified Bugs.Bug6+import qualified Bugs.Bug9+import qualified Bugs.Bug35++bugs :: [TestTree]+bugs = [ Bugs.Bug2.main+       , Bugs.Bug6.main+       , Bugs.Bug9.main+       , Bugs.Bug35.main+       ]
+ test/Bugs/Bug2.hs view
@@ -0,0 +1,27 @@++module Bugs.Bug2+       ( main+       ) where++import Test.Tasty+import Test.Tasty.HUnit++import Text.Parsec+import Text.Parsec.String+import qualified Text.Parsec.Token as P+import Text.Parsec.Language (haskellDef)++main :: TestTree+main =+  testCase "Control Char Parsing (#2)" $+  parseString "\"test\\^Bstring\"" @?= "test\^Bstring"++ where+   parseString :: String -> String+   parseString input =+      case parse parser "Example" input of+        Left{} -> error "Parse failure"+        Right str -> str++   parser :: Parser String+   parser = P.stringLiteral $ P.makeTokenParser haskellDef
+ test/Bugs/Bug35.hs view
@@ -0,0 +1,39 @@++module Bugs.Bug35 (main) where++import Text.Parsec+import Text.Parsec.Language+import Text.Parsec.String+import qualified Text.Parsec.Token as Token++import Test.Tasty+import Test.Tasty.HUnit++trickyFloats :: [String]+trickyFloats =+    [ "1.5339794352098402e-118"+    , "2.108934760892056e-59"+    , "2.250634744599241e-19"+    , "5.0e-324"+    , "5.960464477539063e-8"+    , "0.25996181067141905"+    , "0.3572019862807257"+    , "0.46817723004874223"+    , "0.9640035681058178"+    , "4.23808622486133"+    , "4.540362294799751"+    , "5.212384849884261"+    , "13.958257048123212"+    , "32.96176575630599"+    , "38.47735512322269"+    ]++float :: Parser Double+float = Token.float (Token.makeTokenParser emptyDef)++testBatch :: Assertion+testBatch = mapM_ testFloat trickyFloats+    where testFloat x = parse float "" x @?= Right (read x :: Double)++main :: TestTree+main = testCase "Quality of output of Text.Parsec.Token.float (#35)" testBatch
+ test/Bugs/Bug6.hs view
@@ -0,0 +1,24 @@++module Bugs.Bug6+       ( main+       ) where++import Test.Tasty+import Test.Tasty.HUnit++import Text.Parsec+import Text.Parsec.String++import Util++main :: TestTree+main =+  testCase "Look-ahead preserving error location (#6)" $+  parseErrors variable "return" @?= ["'return' is a reserved keyword"]++variable :: Parser String+variable = do+      x <- lookAhead (many1 letter)+      if x == "return"+       then fail "'return' is a reserved keyword"+       else string x
+ test/Bugs/Bug9.hs view
@@ -0,0 +1,44 @@+module Bugs.Bug9 ( main ) where++import           Control.Applicative            ((<$), (<$>), (<*))+import           Text.Parsec+import           Text.Parsec.Expr+import           Text.Parsec.Language           (haskellStyle)+import           Text.Parsec.String             (Parser)+import qualified Text.Parsec.Token              as P++import           Test.Tasty+import           Test.Tasty.HUnit++import           Util++data Expr = Const Integer | Op Expr Expr+  deriving Show++main :: TestTree+main =+  testCase "Tracing of current position in error message (#9)"+  $ result @?= ["unexpected '>'","expecting operator or end of input"]++  where+    result :: [String]+    result = parseErrors parseTopLevel "4 >> 5"++-- Syntax analysis++parseTopLevel :: Parser Expr+parseTopLevel = parseExpr <* eof++parseExpr :: Parser Expr+parseExpr = buildExpressionParser table (Const <$> integer)+  where+        table = [[ Infix (Op <$ reserved ">>>") AssocLeft ]]++        -- Lexical analysis++        lexer = P.makeTokenParser haskellStyle { P.reservedOpNames = [">>>"] }++        integer    = P.integer    lexer+        reserved   = P.reserved   lexer+        _reservedOp = P.reservedOp lexer+
+ test/Features.hs view
@@ -0,0 +1,14 @@+module Features+       ( features+       ) where++import Test.Tasty++import qualified Features.Feature80+import qualified Features.Feature150++features :: [TestTree]+features =+    [ Features.Feature80.main+    , Features.Feature150.main+    ]
+ test/Features/Feature150.hs view
@@ -0,0 +1,46 @@+module Features.Feature150 ( main ) where++import           Control.Applicative ((*>))+import           Control.Monad.Identity+import           Test.Tasty+import           Test.Tasty.HUnit++import           Text.Parsec++main :: TestTree+main =+  testCase "string' (#150)" $ do+    parseString (boot <|> bool) "boot" @?= "boot"+    parseFail   (boot <|> bool) "bool" @?= "no parse"+    parseFail   (boot <|> bool) "booz" @?= "no parse"++    parseString (boot' <|> bool') "boot" @?= "boot"+    parseString (boot' <|> bool') "bool" @?= "bool"+    parseFail   (boot' <|> bool') "booz" @?= "no parse"++    parseString (boot' <|> bool' <|> char 'b' *> many anyChar) "boomerang" @?= "oomerang"++ where+    boot :: ParsecT String () Identity String+    boot = string "boot"++    bool :: ParsecT String () Identity String+    bool = string "bool"++    boot' :: ParsecT String () Identity String+    boot' = string' "boot"++    bool' :: ParsecT String () Identity String+    bool' = string' "bool"++    parseString :: ParsecT String () Identity String -> String -> String+    parseString p input =+      case parse p "Example" input of+        Left{}    -> error "Parse failure"+        Right str -> str++    parseFail :: ParsecT String () Identity String -> String -> String+    parseFail p input =+      case parse p "Example" input of+        Left{}  -> "no parse"+        Right _ -> error "Parsed but shouldn't"
+ test/Features/Feature80.hs view
@@ -0,0 +1,47 @@+module Features.Feature80 ( main ) where++import           Control.Applicative            (pure)+import           Control.Monad.Identity+import           Data.List.NonEmpty+import           Data.Semigroup+import           Test.Tasty+import           Test.Tasty.HUnit++import           Text.Parsec++main :: TestTree+main =+  testCase "Monoid instance (#80)" $ do+    parseString (as <> bs) "aabbb" @?= "aabbb"+    parseString (mempty <> as) "aabbb" @?= "aa"+    parseString (as <> mempty) "aabbb" @?= "aa"+    parseString (sconcat $ fromList [as, mempty, bs]) "aabbb" @?= "aabbb"+    parseString (mconcat [as, mempty, bs]) "aabbb" @?= "aabbb"+    parseString (mempty :: ParsecT String () Identity String) "aabbb" @?= ""+    parseString (stimes (2::Int) str_a) "aabbb" @?= "aa"+    parseFail   (stimes (3::Int) str_a) "aabbb" @?= "no parse"+    parseString ((one ch_a) <> (one ch_a) <> bs) "aabbb" @?= "aabbb"++ where+   one = fmap pure++   as :: ParsecT String () Identity String+   as = many $ char 'a'+   bs :: ParsecT String () Identity String+   bs = many $ char 'b'+   ch_a :: ParsecT String () Identity Char+   ch_a = char 'a'+   str_a :: ParsecT String () Identity String+   str_a = string "a"++   parseString :: ParsecT String () Identity String -> String -> String+   parseString p input =+      case parse p "Example" input of+        Left{}    -> error "Parse failure"+        Right str -> str++   parseFail :: ParsecT String () Identity String -> String -> String+   parseFail p input =+      case parse p "Example" input of+        Left{}  -> "no parse"+        Right _ -> error "Parsed but shouldn't"
+ test/Main.hs view
@@ -0,0 +1,12 @@++import Test.Tasty++import Bugs ( bugs )+import Features ( features )++main :: IO ()+main = do+  defaultMain $ testGroup "All"+    [ testGroup "Bugs" bugs+    , testGroup "Features" features+    ]
+ test/Util.hs view
@@ -0,0 +1,14 @@++module Util where++import Text.Parsec+import Text.Parsec.String ( Parser )++-- | Returns the error messages associated+-- with a failed parse.+parseErrors :: Parser a -> String -> [String]+parseErrors p input =+  case parse p "" input of+    Left err ->+      drop 1 $ lines $ show err+    Right{} -> []
+ test/issue127.hs view
@@ -0,0 +1,14 @@+-- this should run in constant memory+module Main (main) where+  +import Text.Parsec+import System.Environment (getArgs)+import Control.Monad (replicateM_)++main :: IO ()+main = do+  n <- getArgs >>= \args -> return $ case args of+      arg : _ -> read arg+      _       -> 1000000++  print $ runParser (replicateM_ n $ return ()) () "test" ""
+ test/issue171.hs view
@@ -0,0 +1,29 @@+-- this should be fast+module Main (main) where++import Control.DeepSeq (NFData (..))+import System.CPUTime (getCPUTime)+import Text.Printf (printf)+import Test.Tasty (defaultMain)+import Test.Tasty.HUnit (testCaseSteps, assertBool)++import Text.Parsec+import Text.Parsec.String (Parser)++main :: IO ()+main = defaultMain $ testCaseSteps "issue-171" $ \info -> do+  time0 <- getCPUTime+  check $ concat $ replicate 100000 "a "+  time1 <- getCPUTime+  let diff = (time1 - time0) `div` 1000000000+  info $ printf "%d milliseconds\n" diff+  assertBool "" (diff < 200)++parser :: Parser [String]+parser = many (char 'a' <|> char 'b') `sepBy` char ' '++check :: String -> IO ()+check s = putStrLn $ either onError (const "") $ parse parser {- important: pass input as SourceName -} s s++onError :: ParseError -> String+onError err = rnf (show err) `seq` "error"
+ test/issue175.hs view
@@ -0,0 +1,26 @@+module Main (main) where++import Text.Parsec+import Text.Parsec.Error+import Text.Parsec.String (Parser)+import Text.Parsec.Pos (newPos)++import Test.Tasty (defaultMain)+import Test.Tasty.HUnit (assertFailure, testCaseSteps, (@?=))++main :: IO ()+main = defaultMain $ testCaseSteps "issue175" $ \info -> do+    case parse p "" "x" of+        Right _ -> assertFailure "Unexpected success"+        -- with setPosition the "longest match" is arbitrary+        -- megaparsec tracks consumed tokens separately, but we don't.+        -- so our position is arbitrary.+        Left err -> do+            info $ show err+            errorPos err @?= newPos "aaa" 9 1  -- can be arbitrary+            length (errorMessages err) @?= 2++p :: Parser Char+p = p1 <|> p2 where+    p1 = setPosition (newPos "aaa" 9 1) >> char 'a'+    p2 = setPosition (newPos "zzz" 1 1) >> char 'b'