parsec1 1.0.0.7 → 1.0.0.8

raw patch · 8 files changed

+1003/−1047 lines, 8 filesdep ~basePVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• LICENSE +24/−16
• Text/ParserCombinators/Parsec.hs +50/−50
• Text/ParserCombinators/Parsec/Char.hs +102/−93
• Text/ParserCombinators/Parsec/Combinator.hs +202/−206
• Text/ParserCombinators/Parsec/Error.hs +122/−126
• Text/ParserCombinators/Parsec/Pos.hs +71/−78
• Text/ParserCombinators/Parsec/Prim.hs +421/−470
• parsec1.cabal +11/−8

@@ -1,21 +1,29 @@-Copyright 1999-2000, Daan Leijen. All rights reserved.+BSD 3-Clause License +Copyright (c) 1999-2000, Daan Leijen, 2021 Christian Maeder+All rights reserved.+ Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -* Redistributions of source code must retain the above copyright notice,-  this list of conditions and the following disclaimer.-* Redistributions in binary form must reproduce the above copyright-  notice, this list of conditions and the following disclaimer in the-  documentation and/or other materials provided with the distribution.+1. Redistributions of source code must retain the above copyright notice, this+   list of conditions and the following disclaimer. -This software is provided by the copyright holders "as is" and any express or-implied warranties, including, but not limited to, the implied warranties of-merchantability and fitness for a particular purpose are disclaimed. In no-event shall the copyright holders be liable for any direct, indirect,-incidental, special, exemplary, or consequential damages (including, but not-limited to, procurement of substitute goods or services; loss of use, data,-or profits; or business interruption) however caused and on any theory of-liability, whether in contract, strict liability, or tort (including-negligence or otherwise) arising in any way out of the use of this software,-even if advised of the possibility of such damage.+2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+   contributors may be used to endorse or promote products derived from+   this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -1,54 +1,54 @@--------------------------------------------------------------------------------- |--- Module      :  Text.ParserCombinators.Parsec--- Copyright   :  (c) Daan Leijen 1999-2001--- License     :  BSD-style (see the file libraries/parsec/LICENSE)--- --- Maintainer  :  Antoine Latter <aslatter@gmail.com>--- Stability   :  provisional--- Portability :  portable------ Parsec, the Fast Monadic Parser combinator library, see--- <http://www.cs.uu.nl/people/daan/parsec.html>.------ Inspired by:------ * Graham Hutton and Erik Meijer:---   Monadic Parser Combinators.---   Technical report NOTTCS-TR-96-4. ---   Department of Computer Science, University of Nottingham, 1996. ---   <http://www.cs.nott.ac.uk/~gmh/monparsing.ps>------ * Andrew Partridge, David Wright: ---   Predictive parser combinators need four values to report errors.---   Journal of Functional Programming 6(2): 355-364, 1996------ This helper module exports elements from the basic libraries.---------------------------------------------------------------------------------+{- |+Module      :  Text.ParserCombinators.Parsec+Copyright   :  (c) Daan Leijen 1999-2001+License     :  BSD-style (see the file libraries/parsec/LICENSE) -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+Maintainer  :  Christian Maeder <chr.maeder@web.de>+Stability   :  provisional+Portability :  portable -             ) where+Parsec, the Fast Monadic Parser combinator library. -import Text.ParserCombinators.Parsec.Pos            -- textual positions-import Text.ParserCombinators.Parsec.Error          -- parse errors-import Text.ParserCombinators.Parsec.Prim           -- primitive combinators-import Text.ParserCombinators.Parsec.Combinator     -- derived combinators-import Text.ParserCombinators.Parsec.Char           -- character parsers+Inspired by: +Graham Hutton and Erik Meijer:+Monadic Parser Combinators.+Technical report NOTTCS-TR-96-4.+Department of Computer Science, University of Nottingham, 1996.+<https://www.cs.nott.ac.uk/~gmh/monparsing.ps>++Andrew Partridge, David Wright:+Predictive parser combinators need four values to report errors.+Journal of Functional Programming 6(2): 355-364, 1996++This helper module exports elements from the basic libraries.+-}++module Text.ParserCombinators.Parsec+  ( -- complete modules+    module Text.ParserCombinators.Parsec.Char+  , module Text.ParserCombinators.Parsec.Combinator+  , module Text.ParserCombinators.Parsec.Prim+    -- module Text.ParserCombinators.Parsec.Error+  , ParseError+  , errorPos+    -- module Text.ParserCombinators.Parsec.Pos+  , Column+  , Line+  , SourceName+  , SourcePos+  , incSourceColumn+  , incSourceLine+  , setSourceColumn+  , setSourceLine+  , setSourceName+  , sourceColumn+  , sourceLine+  , sourceName+  ) where++import Text.ParserCombinators.Parsec.Char+import Text.ParserCombinators.Parsec.Combinator+import Text.ParserCombinators.Parsec.Error+import Text.ParserCombinators.Parsec.Pos+import Text.ParserCombinators.Parsec.Prim

@@ -1,139 +1,148 @@--------------------------------------------------------------------------------- |--- Module      :  Text.ParserCombinators.Parsec.Char--- Copyright   :  (c) Daan Leijen 1999-2001--- License     :  BSD-style (see the file libraries/parsec/LICENSE)--- --- Maintainer  :  Antoine Latter <aslatter@gmail.com>--- Stability   :  provisional--- Portability :  portable------ Commonly used character parsers.--- ------------------------------------------------------------------------------+{- |+Module      :  Text.ParserCombinators.Parsec.Char+Copyright   :  (c) Daan Leijen 1999-2001+License     :  BSD-style (see the file LICENSE) +Maintainer  :  Christian Maeder <chr.maeder@web.de>+Stability   :  provisional+Portability :  portable++Commonly used character parsers+-}+ module Text.ParserCombinators.Parsec.Char-                  ( CharParser-                  , spaces, space-                  , newline, tab-                  , upper, lower, alphaNum, letter-                  , digit, hexDigit, octDigit-                  , char, string-                  , anyChar, oneOf, noneOf-                  , satisfy-                  ) where+  ( CharParser+  , alphaNum+  , anyChar+  , char+  , digit+  , hexDigit+  , letter+  , lower+  , newline+  , noneOf+  , octDigit+  , oneOf+  , satisfy+  , space+  , spaces+  , string+  , tab+  , upper+  ) where -import Prelude import Data.Char-import Text.ParserCombinators.Parsec.Pos( updatePosChar, updatePosString )++import Text.ParserCombinators.Parsec.Pos (updatePosChar, updatePosString) import Text.ParserCombinators.Parsec.Prim --------------------------------------------------------------- Type of character parsers-------------------------------------------------------------type CharParser st a    = GenParser Char st a+{- ---------------------------------------------------------+Type of character parsers+--------------------------------------------------------- -}+type CharParser st a = GenParser Char st a --------------------------------------------------------------- Character parsers------------------------------------------------------------+{- ---------------------------------------------------------+Character parsers+--------------------------------------------------------- -} --- | @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 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 :: [Char] -> CharParser st Char-oneOf cs            = satisfy (\c -> elem c cs)+oneOf cs = satisfy (`elem` 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"+{- | 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 :: [Char] -> CharParser st Char-noneOf cs           = satisfy (\c -> not (elem c cs))+noneOf cs = satisfy (`notElem` cs)  -- | Skips /zero/ or more white space characters. See also 'skipMany'. spaces :: CharParser st ()-spaces              = skipMany space        <?> "white space"          +spaces = skipMany space <?> "white space" --- | Parses a white space character (any character which satisfies 'isSpace')--- Returns the parsed character.+{- | Parses a white space character (any character which satisfies 'isSpace')+Returns the parsed character. -} space :: CharParser st Char-space               = satisfy (isSpace)     <?> "space"+space = satisfy isSpace <?> "space"  -- | Parses a newline character (\'\\n\'). Returns a newline character. newline :: CharParser st Char-newline             = char '\n'             <?> "new-line"+newline = char '\n' <?> "new-line"  -- | Parses a tab character (\'\\t\'). Returns a tab character. tab :: CharParser st Char-tab                 = char '\t'             <?> "tab"+tab = char '\t' <?> "tab" --- | Parses an upper case letter (a character between \'A\' and \'Z\').--- Returns the parsed character.+{- | Parses an upper case letter  according to 'isUpper'.+Returns the parsed character. -} upper :: CharParser st Char-upper               = satisfy (isUpper)     <?> "uppercase letter"+upper = satisfy isUpper <?> "uppercase letter" --- | Parses a lower case character (a character between \'a\' and \'z\').--- Returns the parsed character.+{- | Parses a lower case character according to 'isLower'.+Returns the parsed character. -} lower :: CharParser st Char-lower               = satisfy (isLower)     <?> "lowercase letter"+lower = satisfy isLower <?> "lowercase letter" --- | Parses a letter or digit (a character between \'0\' and \'9\').--- Returns the parsed character.+{- | Parses an alphabetic or numeric Unicode characters according to+'isAlphaNum'. Returns the parsed character. -} alphaNum :: CharParser st Char-alphaNum            = satisfy (isAlphaNum)  <?> "letter or digit"+alphaNum = satisfy isAlphaNum <?> "letter or digit" --- | Parses a letter (an upper case or lower case character). Returns the--- parsed character.+{- | Parses an alphabetic Unicode characters according to 'isAlpha'.+Returns the parsed character. -} letter :: CharParser st Char-letter              = satisfy (isAlpha)     <?> "letter"+letter = satisfy isAlpha <?> "letter" --- | Parses a digit. Returns the parsed character.+{- | Parses a digit (\'0\' ... \'9\') according to 'isDigit'.+Returns the parsed character. -} digit :: CharParser st Char-digit               = satisfy (isDigit)     <?> "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.+{- | Parses a hexadecimal digit (a digit or a letter between \'a\' and+\'f\' or \'A\' and \'F\'). Returns the parsed character. -} hexDigit :: CharParser st Char-hexDigit            = satisfy (isHexDigit)  <?> "hexadecimal digit"+hexDigit = satisfy isHexDigit <?> "hexadecimal digit" --- | Parses an octal digit (a character between \'0\' and \'7\'). Returns--- the parsed character.+{- | Parses an octal digit (\'0\' ... \'7\') according to 'isOctDigit'.+Returns the parsed character. -} octDigit :: CharParser st Char-octDigit            = satisfy (isOctDigit)  <?> "octal digit"+octDigit = satisfy isOctDigit <?> "octal digit" --- | @char c@ parses a single character @c@. Returns the parsed--- character (i.e. @c@).------ >  semiColon  = char ';'+{- | @char c@ parses a single character @c@. Returns the parsed+character (i.e. @c@).++>  semiColon  = char ';' -} char :: Char -> CharParser st Char-char c              = satisfy (==c)  <?> show [c]+char c = satisfy (== c) <?> show [c]  -- | This parser succeeds for any character. Returns the parsed character. anyChar :: CharParser st Char-anyChar             = satisfy (const True)+anyChar = satisfy (const True) --------------------------------------------------------------- Primitive character parsers------------------------------------------------------------+{- ---------------------------------------------------------+Primitive character parsers+--------------------------------------------------------- -} --- | 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)+{- | 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 (`elem` cs) -} satisfy :: (Char -> Bool) -> CharParser st Char-satisfy f           = tokenPrim (\c -> show [c]) -                                (\pos c cs -> updatePosChar pos c) -                                (\c -> if f c then Just c else Nothing)+satisfy f = tokenPrim (\ c -> show [c])+                                (\ pos c _ -> 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 s@ parses a sequence of characters given by @s@. Returns+the parsed string (i.e. @s@).++>  divOrMod    =   string "div"+>              <|> string "mod" -} string :: String -> CharParser st String-string s            = tokens show updatePosString s+string = tokens show updatePosString

@@ -1,258 +1,254 @@--------------------------------------------------------------------------------- |--- Module      :  Text.ParserCombinators.Parsec.Combinator--- Copyright   :  (c) Daan Leijen 1999-2001--- License     :  BSD-style (see the file libraries/parsec/LICENSE)------ Maintainer  :  Antoine Latter <aslatter@gmail.com>--- Stability   :  provisional--- Portability :  portable------ Commonly used generic combinators---------------------------------------------------------------------------------+{- |+Module      :  Text.ParserCombinators.Parsec.Combinator+Copyright   :  (c) Daan Leijen 1999-2001+License     :  BSD-style (see the file LICENSE) -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+Maintainer  :  Christian Maeder <chr.maeder@web.de>+Stability   :  provisional+Portability :  portable -                        -- tricky combinators-                        , manyTill, lookAhead, anyToken-                        ) where+Commonly used generic combinators+-} +module Text.ParserCombinators.Parsec.Combinator+  ( between+  , chainl+  , chainl1+  , chainr+  , chainr1+  , choice+  , count+  , endBy+  , endBy1+  , eof+  , many1+  , notFollowedBy+  , option+  , optionMaybe+  , optional+  , sepBy+  , sepBy1+  , sepEndBy+  , sepEndBy1+  , skipMany1+    -- tricky combinators+  , anyToken+  , lookAhead+  , manyTill+  ) where+ import Control.Monad import Text.ParserCombinators.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 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 :: [GenParser tok st a] -> GenParser tok st a-choice ps           = foldr (<|>) mzero ps+choice = foldr (<|>) mzero --- | @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 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 (digitToInt <$> digit) -} option :: a -> GenParser tok st a -> GenParser tok st a-option x p          = p <|> return x+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 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 :: GenParser tok st a -> GenParser tok st (Maybe a)-optionMaybe p       = option Nothing (liftM Just p)+optionMaybe p = option Nothing (fmap 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 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 :: GenParser tok st a -> GenParser tok st ()-optional p          = do{ p; return ()} <|> return ()+optional p = () <$ p <|> return () --- | @between open close p@ parses @open@, followed by @p@ and @close@.--- Returns the value returned by @p@.------ >  braces  = between (symbol "{") (symbol "}")+{- | @between open close p@ parses @open@, followed by @p@ and @close@.+Returns the value returned by @p@.++>  braces  = between (symbol "{") (symbol "}") -} between :: GenParser tok st open -> GenParser tok st close             -> GenParser tok st a -> GenParser tok st a-between open close p-                    = do{ open; x <- p; close; return x }-+between open close p = open *> p <* close --- | @skipMany1 p@ applies the parser @p@ /one/ or more times, skipping--- its result.+{- | @skipMany1 p@ applies the parser @p@ /one/ or more times, skipping+its result. -} skipMany1 :: GenParser tok st a -> GenParser tok st ()-skipMany1 p         = do{ p; skipMany p }-{--skipMany p          = scan-                    where-                      scan  = do{ p; scan } <|> return ()--}+skipMany1 p = p *> skipMany p --- | @many1 p@ applies the parser @p@ /one/ or more times. Returns a--- list of the returned values of @p@.------ >  word  = many1 letter+{- | @many1 p@ applies the parser @p@ /one/ or more times. Returns a+list of the returned values of @p@.++>  word  = many1 letter -} many1 :: GenParser tok st a -> GenParser tok st [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 [])--}+many1 p = do+  x <- p+  xs <- many p+  return (x : xs) --- | @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 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 :: GenParser tok st a -> GenParser tok st sep -> GenParser tok st [a]-sepBy p sep         = sepBy1 p sep <|> return []+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 p sep@ parses /one/ or more occurrences of @p@, separated+by @sep@. Returns a list of values returned by @p@. -} sepBy1 :: GenParser tok st a -> GenParser tok st sep -> GenParser tok st [a]-sepBy1 p sep        = do{ x <- p-                        ; xs <- many (sep >> p)-                        ; return (x:xs)-                        }+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 p sep@ parses /one/ or more occurrences of @p@,+separated and optionally ended by @sep@. Returns a list of values+returned by @p@. -} sepEndBy1 :: GenParser tok st a -> GenParser tok st sep -> GenParser tok st [a]-sepEndBy1 p sep     = do{ x <- p-                        ; do{ sep-                            ; xs <- sepEndBy p sep-                            ; return (x:xs)-                            }-                          <|> return [x]-                        }+sepEndBy1 p sep = do+  x <- p+  do+      xs <- sep *> 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 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 :: GenParser tok st a -> GenParser tok st sep -> GenParser tok st [a]-sepEndBy p sep      = sepEndBy1 p sep <|> return []+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 p sep@ parses /one/ or more occurrences of @p@, seperated+and ended by @sep@. Returns a list of values returned by @p@. -} endBy1 :: GenParser tok st a -> GenParser tok st sep -> GenParser tok st [a]-endBy1 p sep        = many1 (do{ x <- p; sep; return x })+endBy1 p sep = many1 (p <* sep) --- | @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 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 :: GenParser tok st a -> GenParser tok st sep -> GenParser tok st [a]-endBy p sep         = many (do{ x <- p; sep; return x })+endBy p sep = many (p <* sep) --- | @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 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 :: Int -> GenParser tok st a -> GenParser tok st [a]-count n p           | n <= 0    = return []-                    | otherwise = sequence (replicate n p)+count n p | n <= 0 = return []+                    | otherwise = replicateM 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 :: GenParser tok st a -> GenParser tok st (a -> a -> a) -> a -> GenParser tok st a-chainr p op x       = chainr1 p op <|> return x+{- | @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 :: GenParser tok st a -> GenParser tok st (a -> a -> a) -> a+  -> GenParser tok st 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 :: GenParser tok st a -> GenParser tok st (a -> a -> a) -> a -> GenParser tok st a-chainl p op x       = chainl1 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 :: GenParser tok st a -> GenParser tok st (a -> a -> a) -> a+  -> GenParser tok st 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` 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 :: GenParser tok st a -> GenParser tok st (a -> a -> a) -> GenParser tok st a-chainl1 p op        = do{ x <- p; rest x }-                    where-                      rest x    = do{ f <- op-                                    ; y <- p-                                    ; rest (f x y)-                                    }-                                <|> 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. --- | @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 :: GenParser tok st a -> GenParser tok st (a -> a -> a) -> GenParser tok st a-chainr1 p op        = scan+>  expr    = term   `chainl1` addop+>  term    = factor `chainl1` mulop+>  factor  = parens expr <|> integer+>+>  mulop   =   symbol "*" *> return (*)+>          <|> symbol "/" *> return (div)+>+>  addop   =   symbol "+" *> return (+)+>          <|> symbol "-" *> return (-) -}+chainl1 :: GenParser tok st a -> GenParser tok st (a -> a -> a)+  -> GenParser tok st 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 :: GenParser tok st a -> GenParser tok st (a -> a -> a)+  -> GenParser tok st a+chainr1 p op = scan                     where-                      scan      = do{ x <- p; rest x }+                      scan = do+                        x <- p+                        rest x -                      rest x    = do{ f <- op-                                    ; y <- scan-                                    ; return (f x y)-                                    }-                                <|> return x+                      rest x = do+                          f <- op+                          f x <$> scan+                        <|> return x --------------------------------------------------------------- Tricky combinators------------------------------------------------------------+{- ---------------------------------------------------------+Tricky combinators+--------------------------------------------------------- -} --- | The parser @anyToken@ accepts any kind of token. It is for example--- used to implement 'eof'. Returns the accepted token.+{- | The parser @anyToken@ accepts any kind of token. It is for example+used to implement 'eof'. Returns the accepted token. -} anyToken :: Show tok => GenParser tok st tok-anyToken            = tokenPrim show (\pos tok toks -> pos) Just+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"+{- | 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 :: Show tok => GenParser tok st ()-eof                 = notFollowedBy anyToken <?> "end of input"+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 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 (string "let" <* notFollowedBy alphaNum) -} notFollowedBy :: Show a => GenParser tok st a -> GenParser tok st ()-notFollowedBy p     = try (do{ c <- p; unexpected (show c) }-                           <|> return ()-                          )+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 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   = string "<!--" *> manyTill anyChar (try (string "-->"))++Note the overlapping parsers @anyChar@ and @string \"-->\"@, and+therefore the use of the 'try' combinator. -} manyTill :: GenParser tok st a -> GenParser tok st end -> GenParser tok st [a]-manyTill p end      = scan-                    where-                      scan  = do{ end; return [] }-                            <|>-                              do{ x <- p; xs <- scan; return (x:xs) }+manyTill p end = scan where+  scan = [] <$ end <|> do+    x <- p+    xs <- scan+    return (x : xs)

@@ -1,133 +1,132 @@--------------------------------------------------------------------------------- |--- Module      :  Text.ParserCombinators.Parsec.Error--- Copyright   :  (c) Daan Leijen 1999-2001--- License     :  BSD-style (see the file libraries/parsec/LICENSE)------ Maintainer  :  Antoine Latter <aslatter@gmail.com>--- Stability   :  provisional--- Portability :  portable------ Parse errors---------------------------------------------------------------------------------+{- |+Module      :  Text.ParserCombinators.Parsec.Error+Copyright   :  (c) Daan Leijen 1999-2001+License     :  BSD-style (see the file LICENSE) -module Text.ParserCombinators.Parsec.Error-                  ( Message(SysUnExpect,UnExpect,Expect,Message)-                  , messageString, messageCompare, messageEq+Maintainer  :  Christian Maeder <chr.maeder@web.de>+Stability   :  provisional+Portability :  portable -                  , ParseError, errorPos, errorMessages, errorIsUnknown-                  , showErrorMessages+Parse errors+-} -                  , newErrorMessage, newErrorUnknown-                  , addErrorMessage, setErrorPos, setErrorMessage-                  , mergeError-                  )-                  where+module Text.ParserCombinators.Parsec.Error+  ( Message (SysUnExpect, UnExpect, Expect, Message)+  , ParseError+  , addErrorMessage+  , errorIsUnknown+  , errorMessages+  , errorPos+  , mergeError+  , messageCompare+  , messageEq+  , messageString+  , newErrorMessage+  , newErrorUnknown+  , setErrorMessage+  , setErrorPos+  , showErrorMessages+  ) where  -import Prelude-import Data.List (nub,sortBy)+import Data.List (nub, sortBy)+ import Text.ParserCombinators.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+{- | This abstract data type represents parse error messages. There are+four kinds of messages: -messageToEnum msg-    = case msg of SysUnExpect _ -> 0-                  UnExpect _    -> 1-                  Expect _      -> 2-                  Message _     -> 3+>  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 Eq++messageToEnum :: Message -> Int+messageToEnum msg = case msg of+  SysUnExpect _ -> 0+  UnExpect _ -> 1+  Expect _ -> 2+  Message _ -> 3+ messageCompare :: Message -> Message -> Ordering messageCompare msg1 msg2     = compare (messageToEnum msg1) (messageToEnum msg2)  -- | Extract the message string from an error message messageString :: Message -> String-messageString msg-    = case msg of SysUnExpect s -> s-                  UnExpect s    -> s-                  Expect s      -> s-                  Message s     -> s+messageString msg = case msg of+  SysUnExpect s -> s+  UnExpect s -> s+  Expect s -> s+  Message s -> s  messageEq :: Message -> Message -> Bool messageEq msg1 msg2-    = (messageCompare msg1 msg2 == EQ)+    = messageCompare msg1 msg2 == EQ  --- | 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]+{- | 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] deriving Eq  -- | Extracts the source position from the parse error errorPos :: ParseError -> SourcePos-errorPos (ParseError pos msgs)-    = pos+errorPos (ParseError pos _msgs) = pos  -- | Extracts the list of error messages from the parse error errorMessages :: ParseError -> [Message]-errorMessages (ParseError pos msgs)-    = sortBy messageCompare msgs+errorMessages (ParseError _pos msgs) = sortBy messageCompare msgs  errorIsUnknown :: ParseError -> Bool-errorIsUnknown (ParseError pos msgs)-    = null msgs+errorIsUnknown (ParseError _pos msgs) = null msgs  --------------------------------------------------------------- Create parse errors------------------------------------------------------------+{- ---------------------------------------------------------+Create parse errors+--------------------------------------------------------- -} newErrorUnknown :: SourcePos -> ParseError-newErrorUnknown pos-    = ParseError pos []+newErrorUnknown pos = ParseError pos []  newErrorMessage :: Message -> SourcePos -> ParseError-newErrorMessage msg pos-    = ParseError pos [msg]+newErrorMessage msg pos = ParseError pos [msg]  addErrorMessage :: Message -> ParseError -> ParseError-addErrorMessage msg (ParseError pos msgs)-    = ParseError pos (msg:msgs)+addErrorMessage msg (ParseError pos msgs) = ParseError pos (msg : msgs)  setErrorPos :: SourcePos -> ParseError -> ParseError-setErrorPos pos (ParseError _ msgs)-    = ParseError pos msgs+setErrorPos pos (ParseError _ msgs) = ParseError pos msgs  setErrorMessage :: Message -> ParseError -> ParseError setErrorMessage msg (ParseError pos msgs)-    = ParseError pos (msg:filter (not . messageEq msg) msgs)+    = ParseError pos (msg : filter (not . messageEq msg) msgs)   mergeError :: ParseError -> ParseError -> ParseError@@ -142,57 +141,54 @@         GT -> e1         LT -> e2 --------------------------------------------------------------- Show Parse Errors------------------------------------------------------------+{- ---------------------------------------------------------+Show Parse Errors+--------------------------------------------------------- -} instance Show ParseError where-  show err-    = show (errorPos err) ++ ":" +++  show err = show (errorPos err) ++ ":" ++       showErrorMessages "or" "unknown parse error"                         "expecting" "unexpected" "end of input"                        (errorMessages err) - -- | Language independent show function 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]+    | otherwise = concatMap ("\n" ++) $ clean+                 [showSysUnExpect, showUnExpect, showExpect, showMessages]     where-      (sysUnExpect,msgs1)   = span (messageEq (SysUnExpect "")) msgs-      (unExpect,msgs2)      = span (messageEq (UnExpect "")) msgs1-      (expect,messages)     = span (messageEq (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+      (sysUnExpect, msgs1) = span (messageEq (SysUnExpect "")) msgs+      (unExpect, msgs2) = span (messageEq (UnExpect "")) msgs1+      (expect, messages) = span (messageEq (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) -      --helpers-      showMany pre msgs = case (clean (map messageString msgs)) of-                            [] -> ""-                            ms | null pre  -> commasOr ms-                               | otherwise -> pre ++ " " ++ commasOr ms+      showMessages = showMany "" messages -      commasOr []       = ""-      commasOr [m]      = m-      commasOr ms       = commaSep (init ms) ++ " " ++ msgOr ++ " " ++ last ms+      -- helpers+      showMany pre es = case clean (map messageString es) of+        [] -> ""+        ms | null pre -> commasOr ms+           | otherwise -> pre ++ " " ++ commasOr ms -      commaSep          = seperate ", " . clean-      semiSep           = seperate "; " . clean+      commasOr ms = case ms of+        [] -> ""+        [m] -> m+        _ -> commaSep (init ms) ++ " " ++ msgOr ++ " " ++ last ms -      seperate sep []   = ""-      seperate sep [m]  = m-      seperate sep (m:ms) = m ++ sep ++ seperate sep ms+      commaSep = seperate ", " . clean -      clean             = nub . filter (not.null)+      seperate sep ms = case ms of+        [] -> ""+        [m] -> m+        m : rs -> m ++ sep ++ seperate sep rs +      clean = nub . filter (not . null)

@@ -1,114 +1,107 @@--------------------------------------------------------------------------------- |--- Module      :  Text.ParserCombinators.Parsec.Pos--- Copyright   :  (c) Daan Leijen 1999-2001--- License     :  BSD-style (see the file libraries/parsec/LICENSE)------ Maintainer  :  Antoine Latter <aslatter@gmail.com>--- Stability   :  provisional--- Portability :  portable------ Textual source positions.---------------------------------------------------------------------------------+{- |+Module      :  Text.ParserCombinators.Parsec.Pos+Copyright   :  (c) Daan Leijen 1999-2001+License     :  BSD-style (see the file LICENSE) +Maintainer  :  Christian Maeder <chr.maeder@web.de>+Stability   :  provisional+Portability :  portable++Textual source positions+-}+ module Text.ParserCombinators.Parsec.Pos-                  ( SourceName, Line, Column-                  , SourcePos-                  , sourceLine, sourceColumn, sourceName-                  , incSourceLine, incSourceColumn-                  , setSourceLine, setSourceColumn, setSourceName-                  , newPos, initialPos-                  , updatePosChar, updatePosString-                  ) where+  ( Column+  , Line+  , SourceName+  , SourcePos+  , incSourceColumn+  , incSourceLine+  , initialPos+  , newPos+  , setSourceColumn+  , setSourceLine+  , setSourceName+  , sourceColumn+  , sourceLine+  , sourceName+  , updatePosChar+  , updatePosString+  ) where --------------------------------------------------------------- Source Positions, a file name, a line and a column.--- upper left is (1,1)-------------------------------------------------------------type SourceName     = String-type Line           = Int-type Column         = Int+{- ---------------------------------------------------------+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)+{- | 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 :: SourceName -- ^ the name of the source from a position+  , sourceLine :: !Line      -- ^ the line number from a source position+  , sourceColumn :: !Column  -- ^ the column number from a source position+  } deriving (Eq, Ord) --- | Create a new 'SourcePos' with the given source name,--- line number and column number.+{- | Create a new 'SourcePos' with the given source name,+line number and column number. -} newPos :: SourceName -> Line -> Column -> SourcePos-newPos sourceName line column-    = SourcePos sourceName line column+newPos = SourcePos --- | Create a new 'SourcePos' with the given source name,--- and line number and column number set to 1, the upper left.+{- | 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 sourceName-    = newPos sourceName 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+initialPos name = newPos name 1 1  -- | Increments the line number of a source position. incSourceLine :: SourcePos -> Line -> SourcePos-incSourceLine (SourcePos name line column) n = SourcePos name (line+n) column+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)+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+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+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+setSourceColumn (SourcePos name line _column) = SourcePos name line --- | The expression @updatePosString pos s@ updates the source position--- @pos@ by calling 'updatePosChar' on every character in @s@, ie.--- @foldl updatePosChar pos string@.+{- | 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-    = forcePos (foldl updatePosChar pos string)--updatePosChar   :: SourcePos -> Char -> SourcePos-updatePosChar pos@(SourcePos name line column) c-    = forcePos $-      case c of-        '\n' -> SourcePos name (line+1) 1-        '\t' -> SourcePos name line (column + 8 - ((column-1) `mod` 8))-        _    -> SourcePos name line (column + 1)+updatePosString pos string = forcePos (foldl updatePosChar pos string) +updatePosChar :: SourcePos -> Char -> SourcePos+updatePosChar (SourcePos name line column) c = forcePos $ case c of+  '\n' -> SourcePos name (line + 1) 1+  '\t' -> SourcePos name line (column + 8 - ((column - 1) `mod` 8))+  _ -> SourcePos name line (column + 1)  forcePos :: SourcePos -> SourcePos-forcePos pos@(SourcePos name line column)-    = seq line (seq column (pos))+forcePos pos@(SourcePos _name line column) = seq line (seq column pos) --------------------------------------------------------------- Show positions------------------------------------------------------------+{- ---------------------------------------------------------+Show positions+--------------------------------------------------------- -} instance Show SourcePos where   show (SourcePos name line column)     | null name = showLineColumn     | otherwise = "\"" ++ name ++ "\" " ++ showLineColumn     where-      showLineColumn    = "(line " ++ show line +++      showLineColumn = "(line " ++ show line ++                           ", column " ++ show column ++                           ")"

@@ -1,560 +1,512 @@--------------------------------------------------------------------------------- |--- Module      :  Text.ParserCombinators.Parsec.Prim--- Copyright   :  (c) Daan Leijen 1999-2001--- License     :  BSD-style (see the file libraries/parsec/LICENSE)------ Maintainer  :  Antoine Latter <aslatter@gmail.com>--- Stability   :  provisional--- Portability :  portable------ The primitive parser combinators.-----------------------------------------------------------------------------------module Text.ParserCombinators.Parsec.Prim-                   ( -- operators: label a parser, alternative-                     (<?>), (<|>)--                   -- basic types-                   , Parser, GenParser-                   , runParser, parse, parseFromFile, parseTest--                   -- primitive parsers:-                   -- instance Functor Parser     : fmap-                   -- instance Monad Parser       : return, >>=, fail-                   -- instance MonadPlus Parser   : mzero (pzero), mplus (<|>)-                   , token, tokens, tokenPrim, tokenPrimEx-                   , try, label, labels, lookAhead, unexpected, pzero+{-# LANGUAGE CPP #-}+{- |+Module      :  Text.ParserCombinators.Parsec.Prim+Copyright   :  (c) Daan Leijen 1999-2001+License     :  BSD-style (see the file LICENSE) -                   -- primitive because of space behaviour-                   , many, skipMany+Maintainer  :  Christian Maeder <chr.maeder@web.de>+Stability   :  provisional+Portability :  portable -                   -- user state manipulation-                   , getState, setState, updateState+The primitive parser combinators.+-} -                   -- state manipulation-                   , getPosition, setPosition-                   , getInput, setInput-                   , State(..), getParserState, setParserState-                 ) where+module Text.ParserCombinators.Parsec.Prim+  ( -- operators: label a parser, alternative+    (*>)+  , (<$)+  , (<$>)+  , (<*)+  , (<*>)+  , (<?>)+  , (<|>)+    -- basic types+  , GenParser+  , Parser+  , parse+  , parseFromFile+  , parseTest+  , runParser+    -- primitive parsers+  , label+  , labels+  , lookAhead+  , pzero+  , token+  , tokenPrim+  , tokenPrimEx+  , tokens+  , try+  , unexpected+    -- primitive because of space behaviour+  , many+  , skipMany+    -- user state manipulation+  , getState+  , setState+  , updateState+    -- state manipulation+  , State (..)+  , getInput+  , getParserState+  , getPosition+  , setInput+  , setParserState+  , setPosition+  ) where -import Prelude-import Text.ParserCombinators.Parsec.Pos import Text.ParserCombinators.Parsec.Error+import Text.ParserCombinators.Parsec.Pos+ import Control.Applicative import Control.Monad++#if __GLASGOW_HASKELL__ >= 801 import Control.Monad.Fail+#endif --------------------------------------------------------------- Operators:--- <?>  gives a name to a parser (which is used in error messages)--- <|>  is the choice operator-------------------------------------------------------------infix  0 <?>+infix 0 <?> --- | 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.+{- | 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. -} (<?>) :: GenParser tok st a -> String -> GenParser tok st a-p <?> msg           = label p msg+p <?> msg = label p msg --------------------------------------------------------------- User state combinators------------------------------------------------------------+{- ---------------------------------------------------------+User state combinators+--------------------------------------------------------- -}  -- | Returns the current user state. getState :: GenParser tok st st-getState        = do{ state <- getParserState-                    ; return (stateUser state)-                    }+getState = stateUser <$> getParserState  -- | @setState st@ set the user state to @st@. setState :: st -> GenParser tok st ()-setState st     = do{ updateParserState (\(State input pos _) -> State input pos st)-                    ; return ()-                    }+setState st =+  () <$ updateParserState (\ (State input pos _) -> State input pos st) --- | @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)--- >            }-updateState :: (st -> st) -> GenParser tok st ()-updateState f   = do{ updateParserState (\(State input pos user) -> State input pos (f user))-                    ; 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) -}+updateState :: (st -> st) -> GenParser tok st ()+updateState f =+  () <$ updateParserState (\ (State input pos user) -> State input pos (f user)) --------------------------------------------------------------- Parser state combinators------------------------------------------------------------+{- ---------------------------------------------------------+Parser state combinators+--------------------------------------------------------- -}  -- | Returns the current source position. See also 'SourcePos'. getPosition :: GenParser tok st SourcePos-getPosition         = do{ state <- getParserState; return (statePos state) }+getPosition = statePos <$> getParserState  -- | Returns the current input getInput :: GenParser tok st [tok]-getInput            = do{ state <- getParserState; return (stateInput state) }-+getInput = stateInput <$> getParserState  -- | @setPosition pos@ sets the current source position to @pos@. setPosition :: SourcePos -> GenParser tok st ()-setPosition pos     = do{ updateParserState (\(State input _ user) -> State input pos user)-                        ; return ()-                        }+setPosition pos =+  () <$ updateParserState (\ (State input _ user) -> State input pos user)  -- | @setInput input@ continues parsing with @input@. setInput :: [tok] -> GenParser tok st ()-setInput input      = do{ updateParserState (\(State _ pos user) -> State input pos user)-                        ; return ()-                        }+setInput input =+  () <$ updateParserState (\ (State _ pos user) -> State input pos user)  -- | Returns the full parser state as a 'State' record.-getParserState      :: GenParser tok st (State tok st)-getParserState      =  updateParserState id+getParserState :: GenParser tok st (State tok st)+getParserState = updateParserState id  -- | @setParserState st@ set the full parser state to @st@.-setParserState      :: State tok st -> GenParser tok st (State tok st)-setParserState st   = updateParserState (const st)--+setParserState :: State tok st -> GenParser tok st (State tok st)+setParserState st = updateParserState (const st)  --------------------------------------------------------------- Parser definition.--- GenParser tok st a:---  General parser for tokens of type "tok",---  a user state "st" and a result type "a"-------------------------------------------------------------type Parser a           = GenParser Char () a--newtype GenParser tok st a = Parser (State tok st -> Consumed (Reply tok st a))-runP (Parser p)            = p+{- ---------------------------------------------------------+Parser definition.+GenParser tok st a:+General parser for tokens of type "tok",+a user state "st" and a result type "a"+--------------------------------------------------------- -}+type Parser a = GenParser Char () a -data Consumed a         = Consumed a                --input is consumed-                        | Empty !a                  --no input is consumed+newtype GenParser tok st a = Parser+  { runP :: State tok st -> Consumed (Reply tok st a) } -data Reply tok st a     = Ok !a !(State tok st) ParseError    --parsing succeeded with "a"-                        | Error ParseError                    --parsing failed+data Consumed a+  = Consumed a                -- input is consumed+  | Empty !a                  -- no input is consumed -data State tok st       = State { stateInput :: [tok]-                                , statePos   :: !SourcePos-                                , stateUser  :: !st-                                }+data Reply tok st a+  = Ok !a !(State tok st) ParseError    -- parsing succeeded with "a"+  | Error ParseError                    -- parsing failed +data State tok st = State+  { stateInput :: [tok]+  , statePos :: !SourcePos+  , stateUser :: !st } --------------------------------------------------------------- run a parser------------------------------------------------------------+{- ---------------------------------------------------------+run a parser+--------------------------------------------------------- -} parseFromFile :: Parser a -> SourceName -> IO (Either ParseError a)-parseFromFile p fname-    = do{ input <- readFile fname-        ; return (parse p fname input)-        }+parseFromFile p fname = do+  input <- readFile fname+  return $ parse p fname input --- | The expression @parseTest p input@ applies a parser @p@ against--- input @input@ and prints the result to stdout. Used for testing--- parsers.+{- | The expression @parseTest p input@ applies a parser @p@ against+input @input@ and prints the result to stdout. Used for testing+parsers. -} parseTest :: Show a => GenParser tok () a -> [tok] -> IO ()-parseTest p input-    = case (runParser p () "" input) of-        Left err -> do{ putStr "parse error at "-                      ; print err-                      }-        Right x  -> print x+parseTest p input = case runParser p () "" input of+  Left err -> putStr "parse error at " >> print err+  Right x -> print x --- | @parse p filePath input@ runs a parser @p@ 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 p filePath input@ runs a parser @p@ 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 :: GenParser tok () a -> SourceName -> [tok] -> Either ParseError a-parse p name input-    = runParser p () name input+parse p = runParser p () --- | The most general way to run a parser. @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 :: GenParser tok st a -> st -> SourceName -> [tok] -> Either ParseError a-runParser p st name input-    = case parserReply (runP p (State input (initialPos name) st)) of-        Ok x _ _    -> Right x-        Error err   -> Left err+{- | The most general way to run a parser. @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'). -parserReply result-    = case result of-        Consumed reply -> reply-        Empty reply    -> reply+>  parseFromFile p fname = do+>    input <- readFile fname+>    return (runParser p () fname input) -}+runParser :: GenParser tok st a -> st -> SourceName -> [tok]+  -> Either ParseError a+runParser p st name input =+  case parserReply . runP p $ State input (initialPos name) st of+    Ok x _ _ -> Right x+    Error err -> Left err +parserReply :: Consumed p -> p+parserReply result = case result of+  Consumed reply -> reply+  Empty reply -> reply --------------------------------------------------------------- Functor: fmap------------------------------------------------------------++{- ---------------------------------------------------------+Functor: fmap+--------------------------------------------------------- -} instance Functor (GenParser tok st) where-  fmap f p  = parsecMap f p+  fmap f p = parsecMap f p  parsecMap :: (a -> b) -> GenParser tok st a -> GenParser tok st b-parsecMap f (Parser p)-    = Parser (\state ->-        case (p state) of-          Consumed reply -> Consumed (mapReply reply)-          Empty    reply -> Empty    (mapReply reply)-      )-    where-      mapReply reply-        = case reply of-            Ok x state err -> let fx = f x-                              in seq fx (Ok fx state err)-            Error err      -> Error err+parsecMap f (Parser p) = Parser $ \ state -> case p state of+    Consumed reply -> Consumed $ mapReply reply+    Empty reply -> Empty $ mapReply reply+  where+    mapReply reply = case reply of+      Ok x state err -> let fx = f x in seq fx $ Ok fx state err+      Error err -> Error err +{- ---------------------------------------------------------+Monad: return, sequence (>>=) and fail+--------------------------------------------------------- -}+instance Monad (GenParser tok st) where+  return = parsecReturn+  (>>=) = parsecBind+  (>>) = (*>)+#if !MIN_VERSION_base (4, 13, 0)+  fail = parsecFail+#endif --------------------------------------------------------------- Monad: return, sequence (>>=) and fail------------------------------------------------------------+#if __GLASGOW_HASKELL__ >= 801 instance MonadFail (GenParser tok st) where   fail = parsecFail--instance Monad (GenParser tok st) where-  return x   = parsecReturn x-  p >>= f    = parsecBind p f+#endif  instance Applicative (GenParser tok st) where-  pure = return+  pure = parsecReturn   (<*>) = ap+  p1 *> p2 = p1 >>= const p2+  p1 <* p2 = p1 >>= (<$ p2)  parsecReturn :: a -> GenParser tok st a-parsecReturn x-  = Parser (\state -> Empty (Ok x state (unknownError state)))--parsecBind :: GenParser tok st a -> (a -> GenParser tok st b) -> GenParser tok st b-parsecBind (Parser p) f-    = Parser (\state ->-        case (p state) of-          Consumed reply1-            -> Consumed $-               case (reply1) of-                 Ok x state1 err1 -> case runP (f x) state1 of-                                       Empty reply2    -> mergeErrorReply err1 reply2-                                       Consumed reply2 -> reply2-                 Error err1       -> Error err1--          Empty reply1-            -> case (reply1) of-                 Ok x state1 err1 -> case runP (f x) state1 of-                                       Empty reply2 -> Empty (mergeErrorReply err1 reply2)-                                       other        -> other-                 Error err1       -> Empty (Error err1)-      )+parsecReturn x = Parser $ \ state -> Empty . Ok x state $ unknownError state -mergeErrorReply err1 reply-  = case reply of-      Ok x state err2 -> Ok x state (mergeError err1 err2)-      Error err2      -> Error (mergeError err1 err2)+parsecBind :: GenParser tok st a -> (a -> GenParser tok st b)+  -> GenParser tok st b+parsecBind (Parser p) f = Parser $ \ state -> case p state of+  Consumed reply1 -> Consumed $ case reply1 of+    Ok x state1 err1 -> case runP (f x) state1 of+      Empty reply2 -> mergeErrorReply err1 reply2+      Consumed reply2 -> reply2+    Error err1 -> Error err1+  Empty reply1 -> case reply1 of+    Ok x state1 err1 -> case runP (f x) state1 of+      Empty reply2 -> Empty (mergeErrorReply err1 reply2)+      other -> other+    Error err1 -> Empty (Error err1) +mergeErrorReply :: ParseError -> Reply tok st a -> Reply tok st a+mergeErrorReply err1 reply = case reply of+  Ok x state err2 -> Ok x state (mergeError err1 err2)+  Error err2 -> Error (mergeError err1 err2)  parsecFail :: String -> GenParser tok st a-parsecFail msg-  = Parser (\state ->-      Empty (Error (newErrorMessage (Message msg) (statePos state))))-+parsecFail msg =+  Parser $ Empty . Error . newErrorMessage (Message msg) . statePos --------------------------------------------------------------- MonadPlus: alternative (mplus) and mzero------------------------------------------------------------+{- ---------------------------------------------------------+MonadPlus: alternative (mplus) and mzero+--------------------------------------------------------- -} instance MonadPlus (GenParser tok st) where-  mzero         = parsecZero-  mplus p1 p2   = parsecPlus p1 p2+  mzero = parsecZero+  mplus p1 p2 = parsecPlus p1 p2  instance Alternative (GenParser tok st) where-    (<|>) = mplus-    empty = mzero-    many = manyAux+  (<|>) = mplus+  empty = mzero+  many = manyAux  pzero :: GenParser tok st a pzero = parsecZero --- | @parsecZero@ always fails without consuming any input. @parsecZero@ is defined--- equal to the 'mzero' member of the 'MonadPlus' class and to the 'Control.Applicative.empty' member--- of the 'Control.Applicative.Applicative' class.+{- | @parsecZero@ always fails without consuming any input. @parsecZero@ is+defined equal to the 'mzero' member of the 'MonadPlus' class and to the+'Control.Applicative.empty' member of the 'Control.Applicative.Applicative'+class. -} parsecZero :: GenParser tok st a-parsecZero-    = Parser (\state -> Empty (Error (unknownError state)))+parsecZero = Parser $ Empty . Error . unknownError  parsecPlus :: GenParser tok st a -> GenParser tok st a -> GenParser tok st a-parsecPlus (Parser p1) (Parser p2)-    = Parser (\state ->-        case (p1 state) of-          Empty (Error err) -> case (p2 state) of-                                 Empty reply -> Empty (mergeErrorReply err reply)-                                 consumed    -> consumed-          other             -> other-      )+parsecPlus (Parser p1) (Parser p2) = Parser $ \ state -> case p1 state of+  Empty (Error err) -> case p2 state of+    Empty reply -> Empty $ mergeErrorReply err reply+    consumed -> consumed+  other -> other +{- | The parser @try p@ behaves like parser @p@, except that it+pretends that it hasn't consumed any input when an error occurs. -{---- variant that favors a consumed reply over an empty one, even it is not the first alternative.-          empty@(Empty reply) -> case reply of-                                   Error err ->-                                     case (p2 state) of-                                       Empty reply -> Empty (mergeErrorReply err reply)-                                       consumed    -> consumed-                                   ok ->-                                     case (p2 state) of-                                       Empty reply -> empty-                                       consumed    -> consumed-          consumed  -> consumed--}+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: --- | 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+>  expr        = letExpr <|> identifier <?> "expression"+>+>  letExpr     = 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     = try (string "let") *>+>  identifier  = many1 letter -} try :: GenParser tok st a -> GenParser tok st a-try (Parser p)-    = Parser (\state ->-        case (p state) of-          Consumed (Error err)  -> Empty (Error err)-          Consumed ok           -> Consumed ok    -- was: Empty ok-          empty                 -> empty-      )+try (Parser p) = Parser $ \ state -> case p state of+  Consumed (Error err) -> Empty (Error err)+  Consumed ok -> Consumed ok    -- was: Empty ok+  mty -> mty  -- | @lookAhead p@ parses @p@ without consuming any input. lookAhead :: GenParser tok st a -> GenParser tok st a-lookAhead p         = do{ state <- getParserState-                        ; x <- p'-                        ; setParserState state-                        ; return x-                        }-  where p' = Parser $ \ state -> case runP p state of-          Consumed ok@Ok{} -> Empty ok-          reply -> reply+lookAhead p = Parser $ \ state -> case runP p state of+  Consumed (Ok r _ _) -> Empty $ Ok r state $ unknownError state+  reply -> reply --- | 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 :: (tok -> String) -> (tok -> SourcePos) -> (tok -> Maybe a) -> GenParser tok st a-token show tokpos test-  = tokenPrim show nextpos test-  where-    nextpos _ _   (tok:toks)  = tokpos tok-    nextpos _ tok []          = tokpos tok+{- | 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@. --- | 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 :: (tok -> String) -> (SourcePos -> tok -> [tok] -> SourcePos) -> (tok -> Maybe a) -> GenParser tok st a-tokenPrim show nextpos test-    = tokenPrimEx show nextpos Nothing test+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: --- | The most primitive token recogniser. The expression @tokenPrimEx show nextpos mbnextstate test@,--- recognises tokens when @test@ returns @Just x@ (and returns the value @x@). Tokens are shown in--- error messages using @show@. The position is calculated using @nextpos@, and finally, @mbnextstate@,--- can hold a function that updates the user state on every token recognised (nice to count tokens :-).--- The function is packed into a 'Maybe' type for performance reasons.-tokenPrimEx :: (tok -> String) ->-               (SourcePos -> tok -> [tok] -> SourcePos) ->-               Maybe (SourcePos -> tok -> [tok] -> st -> st) ->-               (tok -> Maybe a) ->-               GenParser tok st a-tokenPrimEx show nextpos mbNextState test-    = case mbNextState of-        Nothing-          -> Parser (\state@(State input pos user) ->-              case input of-                (c:cs) -> case test c of-                            Just x  -> let newpos   = nextpos pos c cs-                                           newstate = State cs newpos user-                                       in seq newpos $ seq newstate $-                                          Consumed (Ok x newstate (newErrorUnknown newpos))-                            Nothing -> Empty (sysUnExpectError (show c) pos)-                []     -> Empty (sysUnExpectError "" pos)-             )-        Just nextState-          -> Parser (\state@(State input pos user) ->-              case input of-                (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 $-                                          Consumed (Ok x newstate (newErrorUnknown newpos))-                            Nothing -> Empty (sysUnExpectError (show c) pos)-                []     -> Empty (sysUnExpectError "" pos)-             )+>  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 :: (tok -> String) -> (tok -> SourcePos) -> (tok -> Maybe a)+  -> GenParser tok st a+token shw tokpos = tokenPrim shw nextpos where+    nextpos _ tok ts = case ts of+      t : _ -> tokpos t+      _ -> 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 :: (tok -> String) -> (SourcePos -> tok -> [tok] -> SourcePos)+  -> (tok -> Maybe a) -> GenParser tok st a+tokenPrim shw nextpos = tokenPrimEx shw nextpos Nothing++{- | The most primitive token recogniser. The expression+@tokenPrimEx show nextpos mbnextstate test@, recognises tokens when @test@+returns @Just x@ (and returns the value @x@). Tokens are shown in error+messages using @show@. The position is calculated using @nextpos@, and finally,+@mbnextstate@, can hold a function that updates the user state on every token+recognised (nice to count tokens :-).+The function is packed into a 'Maybe' type for performance reasons. -}+tokenPrimEx :: (tok -> String) -> (SourcePos -> tok -> [tok] -> SourcePos)+  -> Maybe (SourcePos -> tok -> [tok] -> st -> st) -> (tok -> Maybe a)+  -> GenParser tok st a+tokenPrimEx shw nextpos mbNextState test = case mbNextState of+  Nothing -> Parser $ \ (State input pos user) -> case input of+    c : cs -> case test c of+      Just x -> let+        newpos = nextpos pos c cs+        newstate = State cs newpos user+        in seq newpos . seq newstate .+              Consumed . Ok x newstate $ newErrorUnknown newpos+      Nothing -> Empty (sysUnExpectError (shw c) pos)+    [] -> Empty (sysUnExpectError "" pos)+  Just nextState -> Parser $ \ (State input pos user) -> case input of+    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 .+              Consumed . Ok x newstate $ newErrorUnknown newpos+      Nothing -> Empty $ sysUnExpectError (shw c) pos+    [] -> Empty $ sysUnExpectError "" pos+ label :: GenParser tok st a -> String -> GenParser tok st a-label p msg-  = labels p [msg]+label p msg = labels p [msg]  labels :: GenParser tok st a -> [String] -> GenParser tok st a-labels (Parser p) msgs-    = Parser (\state ->-        case (p state) of-          Empty reply -> Empty $-                         case (reply) of-                           Error err        -> Error (setExpectErrors err msgs)-                           Ok x state1 err  | errorIsUnknown err -> reply-                                            | otherwise -> Ok x state1 (setExpectErrors err msgs)-          other       -> other-      )-+labels (Parser p) msgs = Parser $ \ state -> case p state of+  Empty reply -> Empty $ case reply of+    Error err -> Error $ setExpectErrors err msgs+    Ok x state1 err -> if errorIsUnknown err then reply else+      Ok x state1 $ setExpectErrors err msgs+  other -> other  -- | @updateParserState f@ applies function @f@ to the parser state.-updateParserState :: (State tok st -> State tok st) -> GenParser tok st (State tok st)-updateParserState f-    = Parser (\state -> let newstate = f state-                        in Empty (Ok state newstate (unknownError newstate)))+updateParserState :: (State tok st -> State tok st)+  -> GenParser tok st (State tok st)+updateParserState f = Parser $ \ state -> let newstate = f state in+  Empty . Ok state newstate $ unknownError newstate --- | 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'.+{- | 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.ParserCombinators.Parsec.Combinator.notFollowedBy'. -} unexpected :: String -> GenParser tok st a-unexpected msg-    = Parser (\state -> Empty (Error (newErrorMessage (UnExpect msg) (statePos state))))+unexpected msg =+  Parser $ Empty . Error . newErrorMessage (UnExpect msg) . statePos +setExpectErrors :: ParseError -> [String] -> ParseError+setExpectErrors err ms = case ms of+  [] -> setErrorMessage (Expect "") err+  [msg] -> setErrorMessage (Expect msg) err+  msg : msgs -> foldr (addErrorMessage . Expect)+    (setErrorMessage (Expect msg) err) msgs -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+sysUnExpectError :: String -> SourcePos -> Reply tok st a+sysUnExpectError msg = Error . newErrorMessage (SysUnExpect msg) -sysUnExpectError msg pos  = Error (newErrorMessage (SysUnExpect msg) pos)-unknownError state        = newErrorUnknown (statePos state)+unknownError :: State tok st -> ParseError+unknownError = newErrorUnknown . statePos --------------------------------------------------------------- Parsers unfolded for space:--- if many and skipMany are not defined as primitives,--- they will overflow the stack on large inputs------------------------------------------------------------+{- ---------------------------------------------------------+Parsers unfolded for space:+if many and skipMany are not defined as primitives,+they will overflow the stack on large inputs+--------------------------------------------------------- -} --- | @manyAux 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)--- >                  }+{- | @manyAux 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) -} manyAux :: GenParser tok st a -> GenParser tok st [a]-manyAux p-  = do{ xs <- manyAccum (:) p-      ; return (reverse xs)-      }+manyAux 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 p@ applies the parser @p@ /zero/ or more times, skipping+its result.++>  spaces = skipMany space -} skipMany :: GenParser tok st a -> GenParser tok st ()-skipMany p-  = do{ manyAccum (\x xs -> []) p-      ; return ()-      }+skipMany p = () <$ manyAccum (\ _ _ -> []) p  manyAccum :: (a -> [a] -> [a]) -> GenParser tok st a -> GenParser tok st [a]-manyAccum accum (Parser p)-  = Parser (\state ->-    let walk xs state r = case r of-                           Empty (Error err)          -> Ok xs state err-                           Empty ok                   -> error "Text.ParserCombinators.Parsec.Prim.many: combinator 'many' is applied to a parser that accepts an empty string."-                           Consumed (Error err)       -> Error err-                           Consumed (Ok x state' err) -> let ys = accum x xs-                                                         in seq ys (walk ys state' (p state'))-    in case (p state) of-         Empty reply  -> case reply of-                           Ok x state' err -> error "Text.ParserCombinators.Parsec.Prim.many: combinator 'many' is applied to a parser that accepts an empty string."-                           Error err       -> Empty (Ok [] state err)-         consumed     -> Consumed $ walk [] state consumed)--+manyAccum accum (Parser p) = Parser $ \ state -> let+  errMty = error $ "Text.ParserCombinators.Parsec.Prim.many: combinator "+    ++ "'many' is applied to a parser that accepts an empty string."+  walk xs st r = case r of+    Empty (Error err) -> Ok xs st err+    Empty _ -> errMty+    Consumed (Error err) -> Error err+    Consumed (Ok x state' _) -> let ys = accum x xs in+      seq ys . walk ys state' $ p state'+  in case p state of+  Empty reply -> case reply of+    Ok {} -> errMty+    Error err -> Empty (Ok [] state err)+  consumed -> Consumed $ walk [] state consumed --------------------------------------------------------------- Parsers unfolded for speed:---  tokens------------------------------------------------------------+{- ---------------------------------------------------------+Parsers unfolded for speed:+tokens+--------------------------------------------------------- -}  {- specification of @tokens@: tokens showss nextposs s@@ -567,28 +519,27 @@     nextpos pos c = nextposs pos [c] -} -tokens :: Eq tok => ([tok] -> String) -> (SourcePos -> [tok] -> SourcePos) -> [tok] -> GenParser tok st [tok]-tokens shows nextposs s-    = Parser (\state@(State input pos user) ->-       let-        ok cs             = let newpos   = nextposs pos s-                                newstate = State cs newpos user-                            in seq newpos $ seq newstate $-                               (Ok s newstate (newErrorUnknown newpos))--        errEof            = Error (setErrorMessage (Expect (shows s))-                                     (newErrorMessage (SysUnExpect "") pos))-        errExpect r       = Error $ setErrorMessage (Expect (shows s))-            $ newErrorMessage (SysUnExpect $ shows $ reverse r) pos--        walk _ [] cs        = ok cs-        walk r xs []        = errExpect r-        walk r (x:xs) (c:cs)| x == c        = walk (x : r) xs cs-                          | otherwise     = errExpect $ c : r--        walk1 [] cs        = Empty (ok cs)-        walk1 xs []        = Empty (errEof)-        walk1 (x:xs) (c:cs)| x == c        = Consumed (walk [x] xs cs)-                           | otherwise     = Empty (errExpect [c] )+tokens :: Eq tok => ([tok] -> String) -> (SourcePos -> [tok] -> SourcePos)+  -> [tok] -> GenParser tok st [tok]+tokens shws nextposs s = Parser $ \ (State input pos user) -> let+  ok cs = let+    newpos = nextposs pos s+    newstate = State cs newpos user+    in seq newpos . seq newstate . Ok s newstate $ newErrorUnknown newpos+  errMsg m = Error . setErrorMessage (Expect (shws s)) $ newErrorMessage+    (SysUnExpect m) pos+  errEof = errMsg ""+  errExpect = errMsg . shws . reverse+  walk r xs cs = case xs of+    [] -> ok cs+    x : rs -> case cs of+      [] -> errExpect r+      c : ss -> if x == c then walk (x : r) rs ss else errExpect $ c : r -       in walk1 s input)+  walk1 xs cs = case xs of+    [] -> Empty $ ok cs+    x : rs -> case cs of+      [] -> Empty errEof+      c : ss ->+        if x == c then Consumed $ walk [x] rs ss else Empty $ errExpect [c]+  in walk1 s input

@@ -1,5 +1,5 @@ name:           parsec1-version:        1.0.0.7+version:        1.0.0.8 license:        BSD3 license-file:   LICENSE maintainer:     chr.maeder@web.de@@ -13,13 +13,15 @@     This package is the core haskell98 part of the parsec2     package as originally created by Daan Leijen. It is intended to     preserve its simplicity and portability.-    .-    This version differs from the pervious one only by a MonadFail-    instance to let it compile with ghc-8.8.  build-type:     Simple-cabal-version:      >= 1.6-library {+cabal-version:      >= 1.10++source-repository head+  type: git+  location: https://github.com/cmaeder/parsec1++library   exposed-modules:     Text.ParserCombinators.Parsec.Error,     Text.ParserCombinators.Parsec.Char,@@ -27,5 +29,6 @@     Text.ParserCombinators.Parsec.Pos,     Text.ParserCombinators.Parsec.Prim,     Text.ParserCombinators.Parsec-  build-depends:    base >= 4.9 && < 5-}+  build-depends:    base < 5+  other-extensions: CPP+  default-language: Haskell98