megaparsec 4.3.0 → 4.4.0

raw patch · 22 files changed

+1013/−585 lines, 22 filesdep +faildep +semigroupsdep ~basedep ~megaparsecdep ~test-framework-hunitPVP ok

version bump matches the API change (PVP)

Dependencies added: fail, semigroups

Dependency ranges changed: base, megaparsec, test-framework-hunit, transformers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +38/−0
• README.md +14/−0
• Text/Megaparsec.hs +2/−0
• Text/Megaparsec/Char.hs +12/−0
• Text/Megaparsec/Combinator.hs +15/−12
• Text/Megaparsec/Error.hs +52/−40
• Text/Megaparsec/Expr.hs +0/−3
• Text/Megaparsec/Lexer.hs +11/−5
• Text/Megaparsec/Prim.hs +225/−116
• benchmarks/Main.hs +0/−2
• megaparsec.cabal +125/−117
• old-tests/Bugs/Bug9.hs +1/−2
• tests/Char.hs +34/−36
• tests/Combinator.hs +25/−16
• tests/Error.hs +18/−16
• tests/Expr.hs +4/−5
• tests/Lexer.hs +21/−22
• tests/Main.hs +8/−9
• tests/Perm.hs +11/−3
• tests/Pos.hs +12/−13
• tests/Prim.hs +328/−156
• tests/Util.hs +57/−12

@@ -1,3 +1,41 @@+## Megaparsec 4.4.0++* Now state returned on failure is the exact state of parser at the moment+  when it failed, which makes incremental parsing feature much better and+  opens possibilities for features like “on-the-fly” recovering from parse+  errors.++* The `count` combinator now works with `Applicative` instances (previously+  it worked only with instances of `Alternative`). It's now also faster.++* `tokens` and parsers built upon it (such as `string` and `string'`)+  backtrack automatically on failure now, that is, when they fail, they+  never consume any input. This is done to make their consumption model+  match how error messages are reported (which becomes an important thing as+  user gets more control with primitives like `withRecovery`). This means,+  in particular, that it's no longer necessary to use `try` with+  `tokens`-based parsers. This new feature *does not* affect performance in+  any way.++* New primitive parser `withRecovery` added. The parser allows to recover+  from parse errors “on-the-fly” and continue parsing. Once parsing is+  finished, several parse errors may be reported or ignored altogether.++* `eitherP` combinator added.++* Removed `Enum` instance of `Message` type. This was Parsec's legacy that+  we should eliminate now. `Message` does not constitute enumeration,+  `toEnum` was never properly defined for it. The idea to use `fromEnum` to+  determine type of `Message` is also ugly, for this purpose new functions+  `isUnexpected`, `isExpected`, and `isMessage` are defined in+  `Text.Megaparsec.Error`.++* Minor tweak in signature of `MonadParsec` type class. Collection of+  constraints changed from `Alternative m, Monad m, Stream s t` to+  `Alternative m, MonadPlus m, Stream s t`. This is done to make it easier+  to write more abstract code with older GHC where such primitives as+  `guard` are defined for instances of `MonadPlus`, not `Alternative`.+ ## Megaparsec 4.3.0  * Canonicalized `Applicative`/`Monad` instances. Thanks to Herbert Valerio

@@ -3,6 +3,7 @@ [![License FreeBSD](https://img.shields.io/badge/license-FreeBSD-brightgreen.svg)](http://opensource.org/licenses/BSD-2-Clause) [![Hackage](https://img.shields.io/hackage/v/megaparsec.svg?style=flat)](https://hackage.haskell.org/package/megaparsec) [![Stackage Nightly](http://stackage.org/package/megaparsec/badge/nightly)](http://stackage.org/nightly/package/megaparsec)+[![Stackage LTS](http://stackage.org/package/megaparsec/badge/lts)](http://stackage.org/lts/package/megaparsec) [![Build Status](https://travis-ci.org/mrkkrp/megaparsec.svg?branch=master)](https://travis-ci.org/mrkkrp/megaparsec) [![Coverage Status](https://coveralls.io/repos/mrkkrp/megaparsec/badge.svg?branch=master&service=github)](https://coveralls.io/github/mrkkrp/megaparsec?branch=master) @@ -18,6 +19,7 @@     * [Megaparsec and Attoparsec](#megaparsec-and-attoparsec)     * [Megaparsec and Parsec](#megaparsec-and-parsec)     * [Megaparsec and Parsers](#megaparsec-and-parsers)+* [Related packages](#related-packages) * [Authors](#authors) * [Contribution](#contribution) * [License](#license)@@ -74,6 +76,10 @@ * `notFollowedBy` succeeds when its argument fails, it does not consume   input. +* `withRecovery` allows to recover from parse errors “on-the-fly” and+  continue parsing. Once parsing is finished, several parse errors may be+  reported or ignored altogether.+ * `eof` only succeeds at the end of input.  * `token` is used to parse single token.@@ -253,6 +259,14 @@ naming of things, different set of “core” functions, etc., different approach to lexer. So it didn't happen, Megaparsec has minimal dependencies, it is feature-rich and self-contained.++## Related packages++The following packages are designed to be used with Megaparsec:++* [`hspec-megaparsec`](https://hackage.haskell.org/package/hspec-megaparsec)+  — utilities for testing Megaparsec parsers with with+  [Hspec](https://hackage.haskell.org/package/hspec).  ## Authors 

@@ -67,6 +67,7 @@   , try   , lookAhead   , notFollowedBy+  , withRecovery   , eof   , token   , tokens@@ -74,6 +75,7 @@   , choice   , count   , count'+  , eitherP   , endBy   , endBy1   , manyTill

@@ -67,6 +67,9 @@ import Control.Applicative ((<$>), pure) #endif +----------------------------------------------------------------------------+-- Simple parsers+ -- | Parses a newline character.  newline :: MonadParsec s m Char => m Char@@ -98,6 +101,9 @@ space :: MonadParsec s m Char => m () space = skipMany spaceChar +----------------------------------------------------------------------------+-- Categories of characters+ -- | Parses control characters, which are the non-printing characters of the -- Latin-1 subset of Unicode. @@ -243,6 +249,9 @@   , (PrivateUse          , "private-use Unicode character")   , (NotAssigned         , "non-assigned Unicode character") ] +----------------------------------------------------------------------------+-- More general parsers+ -- | @char c@ parses a single character @c@. -- -- > semicolon = char ';'@@ -325,6 +334,9 @@   where testChar x = if f x                      then Right x                      else Left . pure . Unexpected . showToken $ x++----------------------------------------------------------------------------+-- Sequence of characters  -- | @string s@ parses a sequence of characters given by @s@. Returns -- the parsed string (i.e. @s@).

@@ -17,6 +17,7 @@   , choice   , count   , count'+  , eitherP   , endBy   , endBy1   , manyTill@@ -36,6 +37,7 @@  #if !MIN_VERSION_base(4,8,0) import Data.Foldable (Foldable)+import Data.Traversable (sequenceA) #endif  -- | @between open close p@ parses @open@, followed by @p@ and @close@.@@ -57,13 +59,11 @@ -- | @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.------ This parser is defined in terms of 'count'', like this:------ > count n = count' n n -count :: Alternative m => Int -> m a -> m [a]-count n = count' n n+count :: Applicative m => Int -> m a -> m [a]+count n p+  | n <= 0    = pure []+  | otherwise = sequenceA (replicate n p) {-# INLINE count #-}  -- | @count\' m n p@ parses from @m@ to @n@ occurrences of @p@. If @n@ is@@ -81,6 +81,14 @@       let f t ts = maybe [] (:ts) t       in f <$> optional p <*> count' 0 (pred n) p +-- | Combine two alternatives.+--+-- @since 4.4.0++eitherP :: Alternative m => m a -> m b -> m (Either a b)+eitherP a b = (Left <$> a) <|> (Right <$> b)+{-# INLINE eitherP #-}+ -- | @endBy p sep@ parses /zero/ or more occurrences of @p@, separated -- and ended by @sep@. Returns a list of values returned by @p@. --@@ -101,14 +109,10 @@ -- 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 that we need to use 'try' since parsers @anyChar@ and @string--- \"-->\"@ overlap and @string \"-->\"@ could consume input before failing.+-- > simpleComment = string "<!--" >> manyTill anyChar (string "-->")  manyTill :: Alternative m => m a -> m end -> m [a] manyTill p end = ([] <$ end) <|> someTill p end-{-# INLINE manyTill #-}  -- | @someTill p end@ works similarly to @manyTill p end@, but @p@ should -- succeed at least once.@@ -148,7 +152,6 @@  sepEndBy :: Alternative m => m a -> m sep -> m [a] sepEndBy p sep = sepEndBy1 p sep <|> pure []-{-# INLINE sepEndBy #-}  -- | @sepEndBy1 p sep@ parses /one/ or more occurrences of @p@, -- separated and optionally ended by @sep@. Returns a list of values

@@ -13,6 +13,9 @@  module Text.Megaparsec.Error   ( Message (..)+  , isUnexpected+  , isExpected+  , isMessage   , messageString   , badMessage   , ParseError@@ -31,47 +34,55 @@ where  import Control.Exception (Exception)+import Data.Foldable (find, concat) import Data.List (intercalate)-import Data.Maybe (fromMaybe)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Maybe (fromMaybe, fromJust)+import Data.Semigroup (Semigroup((<>))) import Data.Typeable (Typeable)+import Prelude hiding (concat)+import qualified Data.List.NonEmpty as NE  import Text.Megaparsec.Pos  #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) import Data.Foldable (foldMap)-import Data.Monoid+import Data.Monoid (Monoid(..)) #endif --- | This data type represents parse error messages. There are three kinds--- of messages:------ > data Message = Unexpected String--- >              | Expected   String--- >              | Message    String------ The fine distinction between different kinds of parse errors allows the--- system to generate quite good error messages for the user.+-- | This data type represents parse error messages.  data Message   = Unexpected !String -- ^ Parser ran into an unexpected token   | Expected   !String -- ^ What is expected instead   | Message    !String -- ^ General-purpose error message component-  deriving (Show, Eq)+  deriving (Show, Eq, Ord) -instance Enum Message where-  fromEnum (Unexpected _) = 0-  fromEnum (Expected   _) = 1-  fromEnum (Message    _) = 2-  toEnum _ = error "Text.Megaparsec.Error: toEnum is undefined for Message"+-- | Check if given 'Message' is created with 'Unexpected' constructor.+--+-- @since 4.4.0 -instance Ord Message where-  compare m1 m2 =-    case compare (fromEnum m1) (fromEnum m2) of-      LT -> LT-      EQ -> compare (messageString m1) (messageString m2)-      GT -> GT+isUnexpected :: Message -> Bool+isUnexpected (Unexpected _) = True+isUnexpected _              = False +-- | Check if given 'Message' is created with 'Expected' constructor.+--+-- @since 4.4.0++isExpected :: Message -> Bool+isExpected (Expected _) = True+isExpected _            = False++-- | Check if given 'Message' is created with 'Message' constructor.+--+-- @since 4.4.0++isMessage :: Message -> Bool+isMessage (Message _) = True+isMessage _           = False+ -- | Extract the message string from an error message.  messageString :: Message -> String@@ -86,9 +97,7 @@  -- | The data type @ParseError@ represents parse errors. It provides the -- source position ('SourcePos') of the error and a list of error messages--- ('Message'). A @ParseError@ can be returned by the function--- 'Text.Parsec.Prim.parse'. @ParseError@ is an instance of the 'Show' and--- 'Eq' type classes.+-- ('Message').  data ParseError = ParseError   { -- | Extract the source position from 'ParseError'.@@ -102,8 +111,11 @@  instance Monoid ParseError where   mempty  = newErrorUnknown (initialPos "")-  mappend = mergeError+  mappend = (<>) +instance Semigroup ParseError where+  (<>) = mergeError+ instance Exception ParseError  -- | Test whether given 'ParseError' has associated collection of error@@ -160,8 +172,8 @@ setErrorMessage :: Message -> ParseError -> ParseError setErrorMessage m (ParseError pos ms) =   if badMessage m then err else addErrorMessage m err-  where err = ParseError pos xs-        xs  = filter ((/= fromEnum m) . fromEnum) ms+  where err = ParseError pos (filter (not . f) ms)+        f   = fromJust $ find ($ m) [isUnexpected, isExpected, isMessage]  -- | @setErrorPos pos err@ returns 'ParseError' identical to @err@, but with -- position @pos@.@@ -181,6 +193,7 @@     LT -> e2     EQ -> addErrorMessages ms2 e1     GT -> e1+{-# INLINE mergeError #-}  -- | @showMessages ms@ transforms list of error messages @ms@ into -- their textual representation.@@ -188,29 +201,28 @@ showMessages :: [Message] -> String showMessages [] = "unknown parse error" showMessages ms = tail $ foldMap (fromMaybe "") (zipWith f ns rs)-  where (unexpected,    ms') = span ((== 0) . fromEnum) ms-        (expected, messages) = span ((== 1) . fromEnum) ms'+  where (unexpected,    ms') = span isUnexpected ms+        (expected, messages) = span isExpected   ms'         f prefix m = (prefix ++) <$> m         ns = ["\nunexpected ","\nexpecting ","\n"]         rs = (renderMsgs orList <$> [unexpected, expected]) ++-             [renderMsgs (intercalate "\n") messages]+             [renderMsgs (concat . NE.intersperse "\n") messages]  -- | Render collection of messages. If the collection is empty, return -- 'Nothing', otherwise return textual representation of the messages inside -- 'Just'.  renderMsgs-  :: ([String] -> String) -- ^ Function to combine results+  :: (NonEmpty String -> String) -- ^ Function to combine results   -> [Message]         -- ^ Collection of messages to render   -> Maybe String      -- ^ Result, if any-renderMsgs _ [] = Nothing-renderMsgs f ms = Just . f $ messageString <$> ms+-- renderMsgs _ [] = Nothing+renderMsgs f ms = f . fmap messageString <$> NE.nonEmpty ms  -- | Print a pretty list where items are separated with commas and the word -- “or” according to rules of English punctuation. -orList :: [String] -> String-orList []    = ""-orList [x]   = x-orList [x,y] = x ++ " or " ++ y-orList xs    = intercalate ", " (init xs) ++ ", or " ++ last xs+orList :: NonEmpty String -> String+orList (x:|[])  = x+orList (x:|[y]) = x ++ " or " ++ y+orList xs       = intercalate ", " (NE.init xs) ++ ", or " ++ NE.last xs

@@ -73,9 +73,6 @@ -- > binary  name f = InfixL  (reservedOp name >> return f) -- > prefix  name f = Prefix  (reservedOp name >> return f) -- > postfix name f = Postfix (reservedOp name >> return f)------ Please note that multi-character operators should use 'try' in order to--- be reported correctly in error messages.  makeExprParser :: MonadParsec s m t => m a -> [[Operator m a]] -> m a makeExprParser = foldl addPrecLevel

@@ -62,7 +62,8 @@ import Control.Applicative ((<$>), (<*), (*>), (<*>), pure) #endif --- White space and indentation+----------------------------------------------------------------------------+-- White space  -- | @space spaceChar lineComment blockComment@ produces parser that can -- parse white space in general. It's expected that you create such a parser@@ -148,7 +149,7 @@   => String            -- ^ Line comment prefix   -> m () skipLineComment prefix = p >> void (manyTill C.anyChar n)-  where p = try (C.string prefix)+  where p = C.string prefix         n = lookAhead C.newline  -- | @skipBlockComment start end@ skips non-nested block comment starting@@ -159,9 +160,10 @@   -> String            -- ^ End of block comment   -> m () skipBlockComment start end = p >> void (manyTill C.anyChar n)-  where p = try (C.string start)-        n = try (C.string end)+  where p = C.string start+        n = C.string end +---------------------------------------------------------------------------- -- Indentation  -- | Return current indentation level.@@ -279,6 +281,7 @@ ii :: String ii = "incorrect indentation" +---------------------------------------------------------------------------- -- Character and string literals  -- | The lexeme parser parses a single literal character without@@ -297,11 +300,14 @@  charLiteral :: MonadParsec s m Char => m Char charLiteral = label "literal character" $ do-  r@(x:_) <- lookAhead $ count' 1 8 C.anyChar+  -- The @~@ is needed to avoid requiring a MonadFail constraint,+  -- and we do know that r will be non-empty if count' succeeds.+  ~r@(x:_) <- lookAhead $ count' 1 8 C.anyChar   case listToMaybe (readLitChar r) of     Just (c, r') -> count (length r - length r') C.anyChar >> return c     Nothing      -> unexpected (showToken x) +---------------------------------------------------------------------------- -- Numbers  -- | This type class abstracts the concept of signed number in context of

@@ -14,7 +14,7 @@ {-# OPTIONS_HADDOCK not-home #-}  module Text.Megaparsec.Prim-  ( -- * Used data-types+  ( -- * Data types     State (..)   , Stream (..)   , StorableStream (..)@@ -44,6 +44,7 @@ where  import Control.Monad+import qualified Control.Monad.Fail as Fail import Control.Monad.Cont.Class import Control.Monad.Error.Class import Control.Monad.Identity@@ -51,7 +52,7 @@ import Control.Monad.State.Class hiding (state) import Control.Monad.Trans import Control.Monad.Trans.Identity-import Data.Monoid+import Data.Semigroup import qualified Control.Applicative as A import qualified Control.Monad.Trans.Reader as L import qualified Control.Monad.Trans.State.Lazy as L@@ -74,6 +75,9 @@ import Control.Applicative ((<$>), (<*), pure) #endif +----------------------------------------------------------------------------+-- Data types+ -- | This is Megaparsec state, it's parametrized over stream type @s@.  data State s = State@@ -82,6 +86,17 @@   , stateTabWidth :: !Int }   deriving (Show, Eq) +-- | From two states, return the one with greater textual position. If the+-- positions are equal, prefer the latter state.++longestMatch :: State s -> State s -> State s+longestMatch s1@(State _ pos1 _) s2@(State _ pos2 _) =+  case pos1 `compare` pos2 of+    LT -> s2+    EQ -> s2+    GT -> s1+{-# INLINE longestMatch #-}+ -- | All information available after parsing. This includes consumption of -- input, success (with return value) or failure (with parse error), parser -- state at the end of parsing.@@ -126,34 +141,41 @@ -- unexpected 'a' -- expecting 'r' or end of input -newtype Hints = Hints [[String]] deriving Monoid+newtype Hints = Hints [[String]] deriving (Monoid, Semigroup)  -- | Convert 'ParseError' record into 'Hints'.  toHints :: ParseError -> Hints toHints err = Hints hints   where hints = if null msgs then [] else [messageString <$> msgs]-        msgs  = filter ((== 1) . fromEnum) $ errorMessages err+        msgs  = filter isExpected (errorMessages err)  -- | @withHints hs c@ makes “error” continuation @c@ use given hints @hs@. -- -- Note that if resulting continuation gets 'ParseError' where all messages -- are created with 'Message' constructor, hints are ignored. -withHints :: Hints -> (ParseError -> m b) -> ParseError -> m b+withHints+  :: Hints             -- ^ Hints to use+  -> (ParseError -> State s -> m b) -- ^ Continuation to influence+  -> ParseError        -- ^ First argument of resulting continuation+  -> State s           -- ^ Second argument of resulting continuation+  -> m b withHints (Hints xs) c e =-  let isMessage (Message _) = True-      isMessage _           = False-  in (if all isMessage (errorMessages e)-      then c-      else c . addErrorMessages (Expected <$> concat xs))-     e+  if all isMessage (errorMessages e)+    then c e+    else c (addErrorMessages (Expected <$> concat xs) e)  -- | @accHints hs c@ results in “OK” continuation that will add given hints -- @hs@ to third argument of original continuation @c@. -accHints :: Hints -> (a -> State s -> Hints -> m b) ->-            a -> State s -> Hints -> m b+accHints+  :: Hints             -- ^ 'Hints' to add+  -> (a -> State s -> Hints -> m b) -- ^ An “OK” continuation to alter+  -> a                 -- ^ First argument of resulting continuation+  -> State s           -- ^ Second argument of resulting continuation+  -> Hints             -- ^ Third argument of resulting continuation+  -> m b accHints hs1 c x s hs2 = c x s (hs1 <> hs2)  -- | Replace most recent group of hints (if any) with given string. Used in@@ -168,6 +190,10 @@ -- determined by the stream.  class (ShowToken t, ShowToken [t]) => Stream s t | s -> t where++  -- | Get next token from the stream. If the stream is empty, return+  -- 'Nothing'.+   uncons :: s -> Maybe (t, s)  instance (ShowToken t, ShowToken [t]) => Stream [t] t where@@ -221,19 +247,18 @@ -- that takes five arguments: -- --     * State. It includes input stream, position in input stream and---     user's backtracking state.+--     current value of tab width. -----     * “Consumed-OK” continuation (cok). This is just a function that---     takes three arguments: result of parsing, state after parsing, and---     hints (see their description above). This continuation is called when+--     * “Consumed-OK” continuation (cok). This is a function that takes+--     three arguments: result of parsing, state after parsing, and hints+--     (see their description above). This continuation is called when --     something has been consumed during parsing and result is OK (no error --     occurred). -- --     * “Consumed-error” continuation (cerr). This function is called when --     some part of input stream has been consumed and parsing resulted in---     an error. When error happens, parsing stops and we're only interested---     in error message, so this continuation takes 'ParseError' as its only---     argument.+--     an error. This continuation takes 'ParseError' and state information+--     at the time error occurred. -- --     * “Empty-OK” continuation (eok). The function takes the same --     arguments as “consumed-OK” continuation. “Empty-OK” is called when no@@ -241,8 +266,8 @@ -- --     * “Empty-error” continuation (eerr). The function is called when no --     input has been consumed, but nonetheless parsing resulted in an---     error. Just like “consumed-error”, the continuation take single---     argument — 'ParseError' record.+--     error. Just like “consumed-error”, the continuation takes+--     'ParseError' record and state information. -- -- You call specific continuation when you want to proceed in that specific -- branch of control flow.@@ -258,9 +283,9 @@ newtype ParsecT s m a = ParsecT   { unParser :: forall b. State s              -> (a -> State s -> Hints -> m b) -- consumed-OK-             -> (ParseError -> m b)            -- consumed-error+             -> (ParseError -> State s -> m b) -- consumed-error              -> (a -> State s -> Hints -> m b) -- empty-OK-             -> (ParseError -> m b)            -- empty-error+             -> (ParseError -> State s -> m b) -- empty-error              -> m b }  instance Functor (ParsecT s m) where@@ -284,7 +309,7 @@  manyAcc :: ParsecT s m a -> ParsecT s m [a] manyAcc p = ParsecT $ \s cok cerr eok _ ->-  let errToHints c err = c (toHints err)+  let errToHints c err _ = c (toHints err)       walk xs x s' _ =         unParser p s'         (seq xs $ walk $ x:xs)       -- consumed-OK@@ -301,6 +326,9 @@ instance Monad (ParsecT s m) where   return = pure   (>>=)  = pBind+  fail   = Fail.fail++instance Fail.MonadFail (ParsecT s m) where   fail   = pFail  pPure :: a -> ParsecT s m a@@ -317,11 +345,11 @@ {-# INLINE pBind #-}  pFail :: String -> ParsecT s m a-pFail msg = ParsecT $ \s _ _ _ eerr ->-  eerr $ newErrorMessage (Message msg) (statePos s)+pFail msg = ParsecT $ \s@(State _ pos _) _ _ _ eerr ->+  eerr (newErrorMessage (Message msg) pos) s {-# INLINE pFail #-} --- | Low-level creation of the ParsecT type.+-- | Low-level creation of the 'ParsecT' type.  mkPT :: Monad m => (State s -> m (Reply s a)) -> ParsecT s m a mkPT k = ParsecT $ \s cok cerr eok eerr -> do@@ -330,11 +358,11 @@     Consumed ->       case result of         OK    x -> cok x s' mempty-        Error e -> cerr e+        Error e -> cerr e s'     Virgin ->       case result of         OK    x -> eok x s' mempty-        Error e -> eerr e+        Error e -> eerr e s'  instance MonadIO m => MonadIO (ParsecT s m) where   liftIO = lift . liftIO@@ -364,14 +392,15 @@   mplus = pPlus  pZero :: ParsecT s m a-pZero = ParsecT $ \(State _ pos _) _ _ _ eerr -> eerr $ newErrorUnknown pos+pZero = ParsecT $ \s@(State _ pos _) _ _ _ eerr ->+  eerr (newErrorUnknown pos) s  pPlus :: ParsecT s m a -> ParsecT s m a -> ParsecT s m a pPlus m n = ParsecT $ \s cok cerr eok eerr ->-  let meerr err =-        let ncerr   err' = cerr (err' <> err)-            neok x s' hs = eok x s' (toHints err <> hs)-            neerr   err' = eerr (err' <> err)+  let meerr err ms =+        let ncerr err' s' = cerr (err' <> err) (longestMatch ms s')+            neok x s' hs  = eok x s' (toHints err <> hs)+            neerr err' s' = eerr (err' <> err) (longestMatch ms s')         in unParser n s cok ncerr neok neerr   in unParser m s cok cerr eok meerr {-# INLINE pPlus #-}@@ -379,12 +408,13 @@ instance MonadTrans (ParsecT s) where   lift amb = ParsecT $ \s _ _ eok _ -> amb >>= \a -> eok a s mempty +---------------------------------------------------------------------------- -- Primitive combinators  -- | Type class describing parsers independent of input type. -class (A.Alternative m, Monad m, Stream s t)-      => MonadParsec s m t | m -> s t where+class (A.Alternative m, MonadPlus m, Stream s t)+  => MonadParsec s m t | m -> s t where    -- | The most general way to stop parsing and report 'ParseError'.   --@@ -439,6 +469,11 @@   -- 1:1:   -- unexpected "le"   -- expecting "let" or "lexical"+  --+  -- Please note that as of Megaparsec 4.4.0, 'string' backtracks+  -- automatically (see 'tokens'), so it does not need 'try'. However, the+  -- examples above demonstrate the idea behind 'try' so well that it was+  -- decided to keep them.    try :: m a -> m a @@ -455,6 +490,23 @@    notFollowedBy :: m a -> m () +  -- | @withRecovery r p@ allows continue parsing even if parser @p@+  -- fails. In this case @r@ is called with actual 'ParseError' as its+  -- argument. Typical usage is to return value signifying failure to parse+  -- this particular object and to consume some part of input up to start of+  -- next object.+  --+  -- Note that if @r@ fails, original error message is reported as if+  -- without 'withRecovery'. In no way recovering parser @r@ can influence+  -- error messages.+  --+  -- @since 4.4.0++  withRecovery+    :: (ParseError -> m a) -- ^ How to recover from failure+    -> m a             -- ^ Original parser+    -> m a             -- ^ Parser that can recover from failures+   -- | This parser only succeeds at the end of the input.    eof :: m ()@@ -473,9 +525,12 @@   -- >                      then Right x   -- >                      else Left . pure . Unexpected . showToken $ x -  token :: (Int -> SourcePos -> t -> SourcePos) -- ^ Next position calculating function-        -> (t -> Either [Message] a) -- ^ Matching function for the token to parse-        -> m a+  token+    :: (Int -> SourcePos -> t -> SourcePos)+       -- ^ Next position calculating function+    -> (t -> Either [Message] a)+       -- ^ Matching function for the token to parse+    -> m a    -- | The parser @tokens posFromTok test@ parses list of tokens and returns   -- it. @posFromTok@ is called with three arguments: tab width, initial@@ -487,12 +542,31 @@   -- This can be used for example to write 'Text.Megaparsec.Char.string':   --   -- > string = tokens updatePosString (==)+  --+  -- Note that beginning from Megaparsec 4.4.0, this is an auto-backtracking+  -- primitive, which means that if it fails, it never consumes any+  -- input. This is done to make its consumption model match how error+  -- messages for this primitive are reported (which becomes an important+  -- thing as user gets more control with primitives like 'withRecovery'):+  --+  -- >>> parseTest (string "abc") "abd"+  -- 1:1:+  -- unexpected "abd"+  -- expecting "abc"+  --+  -- This means, in particular, that it's no longer necessary to use 'try'+  -- with 'tokens'-based parsers, such as 'Text.Megaparsec.Char.string' and+  -- 'Text.Megaparsec.Char.string''. This new feature /does not/ affect+  -- performance in any way.    tokens :: Eq t-         => (Int -> SourcePos -> [t] -> SourcePos) -- ^ Computes position of tokens-         -> (t -> t -> Bool)      -- ^ Predicate to check equality of tokens-         -> [t]                   -- ^ List of tokens to parse-         -> m [t]+    => (Int -> SourcePos -> [t] -> SourcePos)+       -- ^ Computes position of tokens+    -> (t -> t -> Bool)+       -- ^ Predicate to check equality of tokens+    -> [t]+       -- ^ List of tokens to parse+    -> m [t]    -- | Returns the full parser state as a 'State' record. @@ -508,6 +582,7 @@   try               = pTry   lookAhead         = pLookAhead   notFollowedBy     = pNotFollowedBy+  withRecovery      = pWithRecovery   eof               = pEof   token             = pToken   tokens            = pTokens@@ -515,8 +590,8 @@   updateParserState = pUpdateParserState  pFailure :: [Message] -> ParsecT s m a-pFailure msgs = ParsecT $ \(State _ pos _) _ _ _ eerr ->-  eerr $ newErrorMessages msgs pos+pFailure msgs = ParsecT $ \s@(State _ pos _) _ _ _ eerr ->+  eerr (newErrorMessages msgs pos) s  pLabel :: String -> ParsecT s m a -> ParsecT s m a pLabel l p = ParsecT $ \s cok cerr eok eerr ->@@ -527,7 +602,8 @@   in unParser p s cok' cerr eok' eerr'  pTry :: ParsecT s m a -> ParsecT s m a-pTry p = ParsecT $ \s cok _ eok eerr -> unParser p s cok eerr eok eerr+pTry p = ParsecT $ \s cok _ eok eerr ->+  unParser p s cok eerr eok eerr {-# INLINE pTry #-}  pLookAhead :: ParsecT s m a -> ParsecT s m a@@ -539,54 +615,75 @@ pNotFollowedBy :: Stream s t => ParsecT s m a -> ParsecT s m () pNotFollowedBy p = ParsecT $ \s@(State input pos _) _ _ eok eerr ->   let l = maybe eoi (showToken . fst) (uncons input)-      cok' _ _ _ = eerr $ unexpectedErr l pos-      cerr'    _ = eok () s mempty-      eok' _ _ _ = eerr $ unexpectedErr l pos-      eerr'    _ = eok () s mempty+      cok' _ _ _ = eerr (unexpectedErr l pos) s+      cerr'  _ _ = eok () s mempty+      eok' _ _ _ = eerr (unexpectedErr l pos) s+      eerr'  _ _ = eok () s mempty   in unParser p s cok' cerr' eok' eerr' +pWithRecovery :: Stream s t+  => (ParseError -> ParsecT s m a)+  -> ParsecT s m a+  -> ParsecT s m a+pWithRecovery r p = ParsecT $ \s cok cerr eok eerr ->+  let mcerr err ms =+        let rcok x s' _ = cok x s' mempty+            rcerr   _ _ = cerr err ms+            reok x s' _ = eok x s' (toHints err)+            reerr   _ _ = cerr err ms+        in unParser (r err) ms rcok rcerr reok reerr+      meerr err ms =+        let rcok x s' _ = cok x s' (toHints err)+            rcerr   _ _ = eerr err ms+            reok x s' _ = eok x s' (toHints err)+            reerr   _ _ = eerr err ms+        in unParser (r err) ms rcok rcerr reok reerr+  in unParser p s cok mcerr eok meerr+{-# INLINE pWithRecovery #-}+ pEof :: Stream s t => ParsecT s m () pEof = label eoi $ ParsecT $ \s@(State input pos _) _ _ eok eerr ->   case uncons input of     Nothing    -> eok () s mempty-    Just (x,_) -> eerr $ unexpectedErr (showToken x) pos+    Just (x,_) -> eerr (unexpectedErr (showToken x) pos) s {-# INLINE pEof #-}  pToken :: Stream s t-       => (Int -> SourcePos -> t -> SourcePos)-       -> (t -> Either [Message] a)-       -> ParsecT s m a-pToken nextpos test = ParsecT $ \(State input pos w) cok _ _ eerr ->+  => (Int -> SourcePos -> t -> SourcePos)+  -> (t -> Either [Message] a)+  -> ParsecT s m a+pToken nextpos test = ParsecT $ \s@(State input pos w) cok _ _ eerr ->     case uncons input of-      Nothing     -> eerr $ unexpectedErr eoi pos+      Nothing     -> eerr (unexpectedErr eoi pos) s       Just (c,cs) ->         case test c of-          Left ms -> eerr $ addErrorMessages ms (newErrorUnknown pos)+          Left ms -> eerr (addErrorMessages ms (newErrorUnknown pos)) s           Right x -> let newpos   = nextpos w pos c                          newstate = State cs newpos w                      in seq newpos $ seq newstate $ cok x newstate mempty {-# INLINE pToken #-}  pTokens :: Stream s t-        => (Int -> SourcePos -> [t] -> SourcePos)-        -> (t -> t -> Bool)-        -> [t]-        -> ParsecT s m [t]+  => (Int -> SourcePos -> [t] -> SourcePos)+  -> (t -> t -> Bool)+  -> [t]+  -> ParsecT s m [t] pTokens _ _ [] = ParsecT $ \s _ _ eok _ -> eok [] s mempty-pTokens nextpos test tts = ParsecT $ \(State input pos w) cok cerr _ eerr ->-  let errExpect x = setErrorMessage (Expected $ showToken tts)-                    (newErrorMessage (Unexpected x) pos)-      walk [] is rs = let pos' = nextpos w pos tts-                          s'   = State rs pos' w-                      in cok (reverse is) s' mempty+pTokens nextpos test tts = ParsecT $ \s@(State input pos w) cok _ _ eerr ->+  let r = showToken . reverse+      errExpect x = setErrorMessage (Expected $ showToken tts)+        (newErrorMessage (Unexpected x) pos)+      walk [] is rs =+        let pos' = nextpos w pos tts+            s'   = State rs pos' w+        in cok (reverse is) s' mempty       walk (t:ts) is rs =-        let errorCont = if null is then eerr else cerr-            what      = if null is then eoi  else showToken $ reverse is+        let what = if null is then eoi  else r is         in case uncons rs of-             Nothing -> errorCont . errExpect $ what+             Nothing -> eerr (errExpect what) s              Just (x,xs)                | test t x  -> walk ts (x:is) xs-               | otherwise -> errorCont . errExpect . showToken $ reverse (x:is)+               | otherwise -> eerr (errExpect $ r (x:is)) s   in walk tts [] input {-# INLINE pTokens #-} @@ -620,6 +717,7 @@ eoi :: String eoi = "end of input" +---------------------------------------------------------------------------- -- Parser state combinators  -- | Returns the current input.@@ -662,10 +760,11 @@ setParserState :: MonadParsec s m t => State s -> m () setParserState st = updateParserState (const st) +---------------------------------------------------------------------------- -- Running a parser  -- | @parse p file input@ runs parser @p@ over 'Identity' (see 'runParserT'--- if you're using the 'ParserT' monad transformer; 'parse' itself is just a+-- if you're using the 'ParsecT' monad transformer; 'parse' itself is just a -- synonym for 'runParser'). It returns either a 'ParseError' ('Left') or a -- value of type @a@ ('Right'). 'show' or 'print' can be used to turn -- 'ParseError' into the string representation of the error message. See@@ -678,10 +777,10 @@ -- > numbers = commaSep integer  parse :: Stream s t-      => Parsec s a -- ^ Parser to run-      -> String     -- ^ Name of source file-      -> s          -- ^ Input for parser-      -> Either ParseError a+  => Parsec s a -- ^ Parser to run+  -> String     -- ^ Name of source file+  -> s          -- ^ Input for parser+  -> Either ParseError a parse = runParser  -- | @parseMaybe p input@ runs parser @p@ on @input@ and returns result@@ -717,10 +816,10 @@ -- > parseFromFile p file = runParser p file <$> readFile file  runParser :: Stream s t-          => Parsec s a -- ^ Parser to run-          -> String     -- ^ Name of source file-          -> s          -- ^ Input for parser-          -> Either ParseError a+  => Parsec s a -- ^ Parser to run+  -> String     -- ^ Name of source file+  -> s          -- ^ Input for parser+  -> Either ParseError a runParser p name s = snd $ runParser' p (initialState name s)  -- | The function is similar to 'runParser' with the difference that it@@ -731,9 +830,9 @@ -- @since 4.2.0  runParser' :: Stream s t-           => Parsec s a -- ^ Parser to run-           -> State s    -- ^ Initial state-           -> (State s, Either ParseError a)+  => Parsec s a -- ^ Parser to run+  -> State s    -- ^ Initial state+  -> (State s, Either ParseError a) runParser' p = runIdentity . runParserT' p  -- | @runParserT p file input@ runs parser @p@ on the input list of tokens@@ -743,7 +842,10 @@ -- value of type @a@ ('Right').  runParserT :: (Monad m, Stream s t)-           => ParsecT s m a -> String -> s -> m (Either ParseError a)+  => ParsecT s m a -- ^ Parser to run+  -> String        -- ^ Name of source file+  -> s             -- ^ Input for parser+  -> m (Either ParseError a) runParserT p name s = snd `liftM` runParserT' p (initialState name s)  -- | This function is similar to 'runParserT', but like 'runParser'' it@@ -753,9 +855,9 @@ -- @since 4.2.0  runParserT' :: (Monad m, Stream s t)-            => ParsecT s m a -- ^ Parser to run-            -> State s       -- ^ Initial state-            -> m (State s, Either ParseError a)+  => ParsecT s m a -- ^ Parser to run+  -> State s       -- ^ Initial state+  -> m (State s, Either ParseError a) runParserT' p s = do   (Reply s' _ result) <- runParsecT p s   case result of@@ -771,14 +873,14 @@ -- are built upon this.  runParsecT :: Monad m-           => ParsecT s m a -- ^ Parser to run-           -> State s       -- ^ Initial state-           -> m (Reply s a)+  => ParsecT s m a -- ^ Parser to run+  -> State s       -- ^ Initial state+  -> m (Reply s a) runParsecT p s = unParser p s cok cerr eok eerr-  where cok a s' _ = return $ Reply s' Consumed (OK a)-        cerr err   = return $ Reply s  Consumed (Error err)-        eok a s' _ = return $ Reply s' Virgin   (OK a)-        eerr err   = return $ Reply s  Virgin   (Error err)+  where cok a s' _  = return $ Reply s' Consumed (OK a)+        cerr err s' = return $ Reply s' Consumed (Error err)+        eok a s' _  = return $ Reply s' Virgin   (OK a)+        eerr err s' = return $ Reply s' Virgin   (Error err)  -- | @parseFromFile p filename@ runs parser @p@ on the input read from -- @filename@. Returns either a 'ParseError' ('Left') or a value of type @a@@@ -791,93 +893,100 @@ -- >     Right xs -> print $ sum xs  parseFromFile :: StorableStream s t-              => Parsec s a -- ^ Parser to run-              -> FilePath   -- ^ Name of file to parse-              -> IO (Either ParseError a)+  => Parsec s a -- ^ Parser to run+  -> FilePath   -- ^ Name of file to parse+  -> IO (Either ParseError a) parseFromFile p filename = runParser p filename <$> fromFile filename +---------------------------------------------------------------------------- -- Instances of 'MonadParsec' -instance (MonadPlus m, MonadParsec s m t) =>-         MonadParsec s (L.StateT e m) t where+instance MonadParsec s m t => MonadParsec s (L.StateT e m) t where+  failure                    = lift . failure   label n       (L.StateT m) = L.StateT $ label n . m   try           (L.StateT m) = L.StateT $ try . m   lookAhead     (L.StateT m) = L.StateT $ \s ->     (,s) . fst <$> lookAhead (m s)   notFollowedBy (L.StateT m) = L.StateT $ \s ->     notFollowedBy (fst <$> m s) >> return ((),s)-  failure                    = lift . failure+  withRecovery r (L.StateT m) = L.StateT $ \s ->+    withRecovery (\e -> L.runStateT (r e) s) (m s)   eof                        = lift eof   token  f e                 = lift $ token  f e   tokens f e ts              = lift $ tokens f e ts   getParserState             = lift getParserState   updateParserState f        = lift $ updateParserState f -instance (MonadPlus m, MonadParsec s m t)-         => MonadParsec s (S.StateT e m) t where+instance MonadParsec s m t => MonadParsec s (S.StateT e m) t where+  failure                    = lift . failure   label n       (S.StateT m) = S.StateT $ label n . m   try           (S.StateT m) = S.StateT $ try . m   lookAhead     (S.StateT m) = S.StateT $ \s ->     (,s) . fst <$> lookAhead (m s)   notFollowedBy (S.StateT m) = S.StateT $ \s ->     notFollowedBy (fst <$> m s) >> return ((),s)-  failure                    = lift . failure+  withRecovery r (S.StateT m) = S.StateT $ \s ->+    withRecovery (\e -> S.runStateT (r e) s) (m s)   eof                        = lift eof   token  f e                 = lift $ token  f e   tokens f e ts              = lift $ tokens f e ts   getParserState             = lift getParserState   updateParserState f        = lift $ updateParserState f -instance (MonadPlus m, MonadParsec s m t)-         => MonadParsec s (L.ReaderT e m) t where+instance MonadParsec s m t => MonadParsec s (L.ReaderT e m) t where+  failure                     = lift . failure   label n       (L.ReaderT m) = L.ReaderT $ label n . m   try           (L.ReaderT m) = L.ReaderT $ try . m   lookAhead     (L.ReaderT m) = L.ReaderT $ lookAhead . m   notFollowedBy (L.ReaderT m) = L.ReaderT $ notFollowedBy . m-  failure                     = lift . failure+  withRecovery r (L.ReaderT m) = L.ReaderT $ \s ->+    withRecovery (\e -> L.runReaderT (r e) s) (m s)   eof                         = lift eof   token  f e                  = lift $ token  f e   tokens f e ts               = lift $ tokens f e ts   getParserState              = lift getParserState   updateParserState f         = lift $ updateParserState f -instance (MonadPlus m, Monoid w, MonadParsec s m t)-         => MonadParsec s (L.WriterT w m) t where+instance (Monoid w, MonadParsec s m t) => MonadParsec s (L.WriterT w m) t where+  failure                     = lift . failure   label n       (L.WriterT m) = L.WriterT $ label n m   try           (L.WriterT m) = L.WriterT $ try m   lookAhead     (L.WriterT m) = L.WriterT $     (,mempty) . fst <$> lookAhead m   notFollowedBy (L.WriterT m) = L.WriterT $     (,mempty) <$> notFollowedBy (fst <$> m)-  failure                     = lift . failure+  withRecovery r (L.WriterT m) = L.WriterT $+    withRecovery (L.runWriterT . r) m   eof                         = lift eof   token  f e                  = lift $ token  f e   tokens f e ts               = lift $ tokens f e ts   getParserState              = lift getParserState   updateParserState f         = lift $ updateParserState f -instance (MonadPlus m, Monoid w, MonadParsec s m t)-         => MonadParsec s (S.WriterT w m) t where+instance (Monoid w, MonadParsec s m t) => MonadParsec s (S.WriterT w m) t where+  failure                     = lift . failure   label n       (S.WriterT m) = S.WriterT $ label n m   try           (S.WriterT m) = S.WriterT $ try m   lookAhead     (S.WriterT m) = S.WriterT $     (,mempty) . fst <$> lookAhead m   notFollowedBy (S.WriterT m) = S.WriterT $     (,mempty) <$> notFollowedBy (fst <$> m)-  failure                     = lift . failure+  withRecovery r (S.WriterT m) = S.WriterT $+    withRecovery (S.runWriterT . r) m   eof                         = lift eof   token  f e                  = lift $ token  f e   tokens f e ts               = lift $ tokens f e ts   getParserState              = lift getParserState   updateParserState f         = lift $ updateParserState f -instance (Monad m, MonadParsec s m t)-         => MonadParsec s (IdentityT m) t where+instance MonadParsec s m t => MonadParsec s (IdentityT m) t where+  failure                     = lift . failure   label n       (IdentityT m) = IdentityT $ label n m   try                         = IdentityT . try . runIdentityT   lookAhead     (IdentityT m) = IdentityT $ lookAhead m   notFollowedBy (IdentityT m) = IdentityT $ notFollowedBy m-  failure                     = lift . failure+  withRecovery r (IdentityT m) = IdentityT $+    withRecovery (runIdentityT . r) m   eof                         = lift eof   token  f e                  = lift $ token  f e   tokens f e ts               = lift $ tokens f e ts

@@ -1,4 +1,3 @@--- -*- Mode: Haskell; -*- -- -- Criterion benchmarks for Megaparsec. --@@ -138,7 +137,6 @@         ""         (pack $ replicate (size-1) 'a' ++ "b")   ]-  benchManual :: [Benchmark] benchManual =

@@ -1,4 +1,3 @@--- -*- Mode: Haskell-Cabal; -*- -- -- Cabal config for Megaparsec. --@@ -27,143 +26,152 @@ -- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -- POSSIBILITY OF SUCH DAMAGE. -name:                megaparsec-version:             4.3.0-cabal-version:       >= 1.10-license:             BSD2-license-file:        LICENSE.md-author:              Megaparsec contributors,-                     Paolo Martini <paolo@nemail.it>,-                     Daan Leijen <daan@microsoft.com>+name:                 megaparsec+version:              4.4.0+cabal-version:        >= 1.10+license:              BSD2+license-file:         LICENSE.md+author:               Megaparsec contributors,+                      Paolo Martini <paolo@nemail.it>,+                      Daan Leijen <daan@microsoft.com> -maintainer:          Mark Karpov <markkarpov@opmbx.org>-homepage:            https://github.com/mrkkrp/megaparsec-bug-reports:         https://github.com/mrkkrp/megaparsec/issues-category:            Parsing-synopsis:            Monadic parser combinators-build-type:          Simple+maintainer:           Mark Karpov <markkarpov@opmbx.org>+homepage:             https://github.com/mrkkrp/megaparsec+bug-reports:          https://github.com/mrkkrp/megaparsec/issues+category:             Parsing+synopsis:             Monadic parser combinators+build-type:           Simple description: -    This is industrial-strength monadic parser combinator library. Megaparsec is-    a fork of Parsec library originally written by Daan Leijen.+  This is industrial-strength monadic parser combinator library. Megaparsec+  is a fork of Parsec library originally written by Daan Leijen. -extra-source-files:  AUTHORS.md-                   , CHANGELOG.md-                   , README.md+extra-source-files:   AUTHORS.md+                    , CHANGELOG.md+                    , README.md  flag dev-  description:       Turn on development settings.-  manual:            True-  default:           False+  description:        Turn on development settings.+  manual:             True+  default:            False  library-  build-depends:     base                   >= 4.6 && < 5-                   , mtl                    == 2.*-                   , transformers           == 0.4.*-                   , bytestring-                   , text                   >= 0.2 && < 1.3-  default-extensions:-                     CPP-                   , DeriveDataTypeable-                   , FlexibleContexts-                   , FlexibleInstances-                   , FunctionalDependencies-                   , GeneralizedNewtypeDeriving-                   , MultiParamTypeClasses-                   , PolymorphicComponents-                   , TupleSections-                   , UndecidableInstances-  exposed-modules:   Text.Megaparsec-                   , Text.Megaparsec.ByteString-                   , Text.Megaparsec.ByteString.Lazy-                   , Text.Megaparsec.Char-                   , Text.Megaparsec.Combinator-                   , Text.Megaparsec.Error-                   , Text.Megaparsec.Expr-                   , Text.Megaparsec.Lexer-                   , Text.Megaparsec.Perm-                   , Text.Megaparsec.Pos-                   , Text.Megaparsec.Prim-                   , Text.Megaparsec.ShowToken-                   , Text.Megaparsec.String-                   , Text.Megaparsec.Text-                   , Text.Megaparsec.Text.Lazy+  build-depends:      base         >= 4.6 && < 5+                    , bytestring+                    , mtl          == 2.*+                    , text         >= 0.2+                    , transformers >= 0.4 && < 0.6++  if !impl(ghc >= 8.0)+    -- packages providing modules that moved into base-4.9.0.0+    build-depends:    fail         == 4.9.*+                    , semigroups   == 0.18.*++  default-extensions: CPP+                    , DeriveDataTypeable+                    , FlexibleContexts+                    , FlexibleInstances+                    , FunctionalDependencies+                    , GeneralizedNewtypeDeriving+                    , MultiParamTypeClasses+                    , PolymorphicComponents+                    , TupleSections+                    , UndecidableInstances+  exposed-modules:    Text.Megaparsec+                    , Text.Megaparsec.ByteString+                    , Text.Megaparsec.ByteString.Lazy+                    , Text.Megaparsec.Char+                    , Text.Megaparsec.Combinator+                    , Text.Megaparsec.Error+                    , Text.Megaparsec.Expr+                    , Text.Megaparsec.Lexer+                    , Text.Megaparsec.Perm+                    , Text.Megaparsec.Pos+                    , Text.Megaparsec.Prim+                    , Text.Megaparsec.ShowToken+                    , Text.Megaparsec.String+                    , Text.Megaparsec.Text+                    , Text.Megaparsec.Text.Lazy   if flag(dev)-    ghc-options:     -Wall -Werror+    ghc-options:      -Wall -Werror+    if impl(ghc >= 8.0)+      ghc-options:    -Wcompat+      ghc-options:    -Wnoncanonical-monadfail-instances+      ghc-options:    -Wnoncanonical-monoid-instances   else-    ghc-options:     -O2 -Wall-  default-language:  Haskell2010+    ghc-options:      -O2 -Wall+  default-language:   Haskell2010  test-suite old-tests-  main-is:           Main.hs-  hs-source-dirs:    old-tests-  type:              exitcode-stdio-1.0+  main-is:            Main.hs+  hs-source-dirs:     old-tests+  type:               exitcode-stdio-1.0   if flag(dev)-    ghc-options:     -Wall -Werror+    ghc-options:      -Wall -Werror   else-    ghc-options:     -O2 -Wall-  other-modules:     Bugs-                   , Bugs.Bug2-                   , Bugs.Bug6-                   , Bugs.Bug9-                   , Bugs.Bug35-                   , Bugs.Bug39-                   , Util-  build-depends:     base                   >= 4.6 && < 5-                   , megaparsec             >= 4.3-                   , HUnit                  >= 1.2 && < 1.4-                   , test-framework         >= 0.6 && < 1-                   , test-framework-hunit   >= 0.2 && < 0.4-  default-extensions:-                     CPP-                   , FlexibleContexts-  default-language:  Haskell2010+    ghc-options:      -O2 -Wall+  other-modules:      Bugs+                    , Bugs.Bug2+                    , Bugs.Bug6+                    , Bugs.Bug9+                    , Bugs.Bug35+                    , Bugs.Bug39+                    , Util+  build-depends:      base                 >= 4.6 && < 5+                    , HUnit                >= 1.2 && < 1.4+                    , megaparsec           >= 4.4.0+                    , test-framework       >= 0.6 && < 1+                    , test-framework-hunit >= 0.2 && < 0.4+  default-extensions: CPP+                    , FlexibleContexts+  default-language:   Haskell2010  test-suite tests-  main-is:           Main.hs-  hs-source-dirs:    tests-  type:              exitcode-stdio-1.0+  main-is:            Main.hs+  hs-source-dirs:     tests+  type:               exitcode-stdio-1.0   if flag(dev)-    ghc-options:     -Wall -Werror+    ghc-options:      -Wall -Werror   else-    ghc-options:     -O2 -Wall-  other-modules:     Char-                   , Combinator-                   , Error-                   , Expr-                   , Lexer-                   , Perm-                   , Pos-                   , Prim-                   , Util-  build-depends:     base                   >= 4.6 && < 5-                   , megaparsec             >= 4.3-                   , mtl                    == 2.*-                   , transformers           == 0.4.*-                   , QuickCheck             >= 2.4 && < 3-                   , test-framework         >= 0.6 && < 1-                   , test-framework-quickcheck2 >= 0.3 && < 0.4-  default-extensions:-                     CPP-                   , FlexibleContexts-                   , FlexibleInstances-  default-language:  Haskell2010+    ghc-options:      -O2 -Wall+  other-modules:      Char+                    , Combinator+                    , Error+                    , Expr+                    , Lexer+                    , Perm+                    , Pos+                    , Prim+                    , Util+  build-depends:      base           >= 4.6 && < 5+                    , HUnit          >= 1.2 && < 1.4+                    , QuickCheck     >= 2.4 && < 3+                    , megaparsec     >= 4.4.0+                    , mtl            == 2.*+                    , test-framework >= 0.6 && < 1+                    , test-framework-hunit       >= 0.3 && < 0.4+                    , test-framework-quickcheck2 >= 0.3 && < 0.4+                    , transformers   >= 0.4 && < 0.6+  default-extensions: CPP+                    , FlexibleContexts+                    , FlexibleInstances+  default-language:   Haskell2010  benchmark benchmarks-  main-is:           Main.hs-  hs-source-dirs:    benchmarks-  type:              exitcode-stdio-1.0+  main-is:            Main.hs+  hs-source-dirs:     benchmarks+  type:               exitcode-stdio-1.0   if flag(dev)-    ghc-options:     -O2 -Wall -Werror+    ghc-options:      -O2 -Wall -Werror   else-    ghc-options:     -O2 -Wall-  build-depends:     base                   >= 4.6 && < 5-                   , megaparsec             >= 4.3-                   , criterion              >= 0.6.2.1 && < 1.2-                   , text                   >= 1.2 && < 2-                   , bytestring             >= 0.10 && < 2-  default-language:  Haskell2010+    ghc-options:      -O2 -Wall+  build-depends:      base       >= 4.6 && < 5+                    , bytestring >= 0.10 && < 2+                    , criterion  >= 0.6.2.1 && < 1.2+                    , megaparsec >= 4.4.0+                    , text       >= 0.2+  default-language:   Haskell2010  source-repository head-  type:              git-  location:          https://github.com/mrkkrp/megaparsec.git+  type:               git+  location:           https://github.com/mrkkrp/megaparsec.git

@@ -1,4 +1,3 @@- module Bugs.Bug9 (main) where  import Control.Applicative (empty)@@ -41,7 +40,7 @@ integer = lexeme L.integer  operator :: String -> Parser String-operator = try . L.symbol sc+operator = L.symbol sc  parseTopLevel :: Parser Expr parseTopLevel = parseExpr <* eof

@@ -1,4 +1,3 @@--- -*- Mode: Haskell; -*- -- -- QuickCheck tests for Megaparsec's character parsers. --@@ -48,39 +47,39 @@  tests :: Test tests = testGroup "Character parsers"-        [ testProperty "newline"         prop_newline-        , testProperty "crlf"            prop_crlf-        , testProperty "eol"             prop_eol-        , testProperty "tab"             prop_tab-        , testProperty "space"           prop_space-        , testProperty "controlChar"     prop_controlChar-        , testProperty "spaceChar"       prop_spaceChar-        , testProperty "upperChar"       prop_upperChar-        , testProperty "lowerChar"       prop_lowerChar-        , testProperty "letterChar"      prop_letterChar-        , testProperty "alphaNumChar"    prop_alphaNumChar-        , testProperty "printChar"       prop_printChar-        , testProperty "digitChar"       prop_digitChar-        , testProperty "hexDigitChar"    prop_hexDigitChar-        , testProperty "octDigitChar"    prop_octDigitChar-        , testProperty "markChar"        prop_markChar-        , testProperty "numberChar"      prop_numberChar-        , testProperty "punctuationChar" prop_punctuationChar-        , testProperty "symbolChar"      prop_symbolChar-        , testProperty "separatorChar"   prop_separatorChar-        , testProperty "asciiChar"       prop_asciiChar-        , testProperty "latin1Char"      prop_latin1Char-        , testProperty "charCategory"    prop_charCategory-        , testProperty "char"            prop_char-        , testProperty "char'"           prop_char'-        , testProperty "anyChar"         prop_anyChar-        , testProperty "oneOf"           prop_oneOf-        , testProperty "oneOf'"          prop_oneOf'-        , testProperty "noneOf"          prop_noneOf-        , testProperty "noneOf'"         prop_noneOf'-        , testProperty "string"          prop_string-        , testProperty "string'"         prop_string'_0-        , testProperty "string' (case)"  prop_string'_1 ]+  [ testProperty "newline"         prop_newline+  , testProperty "crlf"            prop_crlf+  , testProperty "eol"             prop_eol+  , testProperty "tab"             prop_tab+  , testProperty "space"           prop_space+  , testProperty "controlChar"     prop_controlChar+  , testProperty "spaceChar"       prop_spaceChar+  , testProperty "upperChar"       prop_upperChar+  , testProperty "lowerChar"       prop_lowerChar+  , testProperty "letterChar"      prop_letterChar+  , testProperty "alphaNumChar"    prop_alphaNumChar+  , testProperty "printChar"       prop_printChar+  , testProperty "digitChar"       prop_digitChar+  , testProperty "hexDigitChar"    prop_hexDigitChar+  , testProperty "octDigitChar"    prop_octDigitChar+  , testProperty "markChar"        prop_markChar+  , testProperty "numberChar"      prop_numberChar+  , testProperty "punctuationChar" prop_punctuationChar+  , testProperty "symbolChar"      prop_symbolChar+  , testProperty "separatorChar"   prop_separatorChar+  , testProperty "asciiChar"       prop_asciiChar+  , testProperty "latin1Char"      prop_latin1Char+  , testProperty "charCategory"    prop_charCategory+  , testProperty "char"            prop_char+  , testProperty "char'"           prop_char'+  , testProperty "anyChar"         prop_anyChar+  , testProperty "oneOf"           prop_oneOf+  , testProperty "oneOf'"          prop_oneOf'+  , testProperty "noneOf"          prop_noneOf+  , testProperty "noneOf'"         prop_noneOf'+  , testProperty "string"          prop_string+  , testProperty "string'"         prop_string'_0+  , testProperty "string' (case)"  prop_string'_1 ]  instance Arbitrary GeneralCategory where   arbitrary = elements@@ -132,8 +131,7 @@           | "\r\n" `isPrefixOf` s = posErr 2 s [uneCh (s !! 2), exEof]           | otherwise   = posErr 0 s [ uneStr (take 2 s)                                      , uneCh '\r'-                                     , exSpec "crlf newline"-                                     , exSpec "newline" ]+                                     , exSpec "end of line" ]  prop_tab :: String -> Property prop_tab = checkChar tab (== '\t') (Just "tab")

@@ -1,4 +1,3 @@--- -*- Mode: Haskell; -*- -- -- QuickCheck tests for Megaparsec's generic parser combinators. --@@ -30,6 +29,7 @@ module Combinator (tests) where  import Control.Applicative+import Data.Char (isLetter, isDigit) import Data.List (intersperse) import Data.Maybe (fromMaybe, maybeToList, isNothing, fromJust) @@ -44,21 +44,22 @@  tests :: Test tests = testGroup "Generic parser combinators"-        [ testProperty "combinator between"   prop_between-        , testProperty "combinator choice"    prop_choice-        , testProperty "combinator count"     prop_count-        , testProperty "combinator count'"    prop_count'-        , testProperty "combinator endBy"     prop_endBy-        , testProperty "combinator endBy1"    prop_endBy1-        , testProperty "combinator manyTill"  prop_manyTill-        , testProperty "combinator someTill"  prop_someTill-        , testProperty "combinator option"    prop_option-        , testProperty "combinator sepBy"     prop_sepBy-        , testProperty "combinator sepBy1"    prop_sepBy1-        , testProperty "combinator sepEndBy"  prop_sepEndBy-        , testProperty "combinator sepEndBy1" prop_sepEndBy1-        , testProperty "combinator skipMany"  prop_skipMany-        , testProperty "combinator skipSome"  prop_skipSome ]+  [ testProperty "combinator between"   prop_between+  , testProperty "combinator choice"    prop_choice+  , testProperty "combinator count"     prop_count+  , testProperty "combinator count'"    prop_count'+  , testProperty "combinator eitherP"   prop_eitherP+  , testProperty "combinator endBy"     prop_endBy+  , testProperty "combinator endBy1"    prop_endBy1+  , testProperty "combinator manyTill"  prop_manyTill+  , testProperty "combinator someTill"  prop_someTill+  , testProperty "combinator option"    prop_option+  , testProperty "combinator sepBy"     prop_sepBy+  , testProperty "combinator sepBy1"    prop_sepBy1+  , testProperty "combinator sepEndBy"  prop_sepEndBy+  , testProperty "combinator sepEndBy1" prop_sepEndBy1+  , testProperty "combinator skipMany"  prop_skipMany+  , testProperty "combinator skipSome"  prop_skipSome ]  prop_between :: String -> Char -> NonNegative Int -> String -> Property prop_between pre c n' post = checkParser p r s@@ -100,6 +101,14 @@           | x < m            = posErr x s [uneEof, exCh 'x']           | otherwise        = posErr n s [uneCh 'x', exEof]         s = replicate x 'x'++prop_eitherP :: Char -> Property+prop_eitherP ch = checkParser p r s+  where p = eitherP letterChar digitChar+        r | isLetter ch = Right (Left  ch)+          | isDigit  ch = Right (Right ch)+          | otherwise   = posErr 0 s [uneCh ch, exSpec "letter", exSpec "digit"]+        s = pure ch  prop_endBy :: NonNegative Int -> Char -> Property prop_endBy n' c = checkParser p r s

@@ -1,4 +1,3 @@--- -*- Mode: Haskell; -*- -- -- QuickCheck tests for Megaparsec's parse errors. --@@ -31,7 +30,9 @@  module Error (tests) where +import Data.Foldable (find) import Data.List (isPrefixOf, isInfixOf)+import Data.Maybe (fromJust) import Data.Monoid ((<>))  import Test.Framework@@ -49,20 +50,20 @@  tests :: Test tests = testGroup "Parse errors"-        [ testProperty "monoid left identity"            prop_monoid_left_id-        , testProperty "monoid right identity"           prop_monoid_right_id-        , testProperty "monoid associativity"            prop_monoid_assoc-        , testProperty "extraction of message string"    prop_messageString-        , testProperty "creation of new error messages"  prop_newErrorMessage-        , testProperty "messages are always well-formed" prop_wellFormedMessages-        , testProperty "copying of error positions"      prop_parseErrorCopy-        , testProperty "setting of error position"       prop_setErrorPos-        , testProperty "addition of error message"       prop_addErrorMessage-        , testProperty "setting of error message"        prop_setErrorMessage-        , testProperty "position of merged error"        prop_mergeErrorPos-        , testProperty "messages of merged error"        prop_mergeErrorMsgs-        , testProperty "position of error is visible"    prop_visiblePos-        , testProperty "message components are visible"  prop_visibleMsgs ]+  [ testProperty "monoid left identity"            prop_monoid_left_id+  , testProperty "monoid right identity"           prop_monoid_right_id+  , testProperty "monoid associativity"            prop_monoid_assoc+  , testProperty "extraction of message string"    prop_messageString+  , testProperty "creation of new error messages"  prop_newErrorMessage+  , testProperty "messages are always well-formed" prop_wellFormedMessages+  , testProperty "copying of error positions"      prop_parseErrorCopy+  , testProperty "setting of error position"       prop_setErrorPos+  , testProperty "addition of error message"       prop_addErrorMessage+  , testProperty "setting of error message"        prop_setErrorMessage+  , testProperty "position of merged error"        prop_mergeErrorPos+  , testProperty "messages of merged error"        prop_mergeErrorMsgs+  , testProperty "position of error is visible"    prop_visiblePos+  , testProperty "message components are visible"  prop_visibleMsgs ]  instance Arbitrary Message where   arbitrary = ($) <$> elements constructors <*> arbitrary@@ -121,7 +122,8 @@   where new    = setErrorMessage msg err         msgs   = errorMessages new         added  = msg `elem` msgs && not (errorIsUnknown new)-        unique = length (filter (== fromEnum msg) (fromEnum <$> msgs)) == 1+        unique = length (filter f msgs) == 1+        f      = fromJust $ find ($ msg) [isUnexpected, isExpected, isMessage]  prop_mergeErrorPos :: ParseError -> ParseError -> Bool prop_mergeErrorPos e1 e2 = errorPos (mergeError e1 e2) == max pos1 pos2

@@ -1,4 +1,3 @@--- -*- Mode: Haskell; -*- -- -- QuickCheck tests for Megaparsec's expression parsers. --@@ -49,10 +48,10 @@  tests :: Test tests = testGroup "Expression parsers"-        [ testProperty "correctness of expression parser" prop_correctness-        , testProperty "error message on empty input"     prop_empty_error-        , testProperty "error message on missing term"    prop_missing_term-        , testProperty "error message on missing op"      prop_missing_op ]+  [ testProperty "correctness of expression parser" prop_correctness+  , testProperty "error message on empty input"     prop_empty_error+  , testProperty "error message on missing term"    prop_missing_term+  , testProperty "error message on missing op"      prop_missing_op ]  -- Algebraic structures to build abstract syntax tree of our expression. 

@@ -1,4 +1,3 @@--- -*- Mode: Haskell; -*- -- -- QuickCheck tests for Megaparsec's lexer. --@@ -64,25 +63,25 @@  tests :: Test tests = testGroup "Lexer"-        [ testProperty "space combinator"       prop_space-        , testProperty "symbol combinator"      prop_symbol-        , testProperty "symbol' combinator"     prop_symbol'-        , testProperty "indentLevel"            prop_indentLevel-        , testProperty "indentGuard combinator" prop_indentGuard-        , testProperty "nonIndented combinator" prop_nonIndented-        , testProperty "indentBlock combinator" prop_indentBlock-        , testProperty "indentBlock (many)"     prop_indentMany-        , testProperty "charLiteral"            prop_charLiteral-        , testProperty "integer"                prop_integer-        , testProperty "decimal"                prop_decimal-        , testProperty "hexadecimal"            prop_hexadecimal-        , testProperty "octal"                  prop_octal-        , testProperty "float 0"                prop_float_0-        , testProperty "float 1"                prop_float_1-        , testProperty "number 0"               prop_number_0-        , testProperty "number 1"               prop_number_1-        , testProperty "number 2 (signed)"      prop_number_2-        , testProperty "signed"                 prop_signed ]+  [ testProperty "space combinator"       prop_space+  , testProperty "symbol combinator"      prop_symbol+  , testProperty "symbol' combinator"     prop_symbol'+  , testProperty "indentLevel"            prop_indentLevel+  , testProperty "indentGuard combinator" prop_indentGuard+  , testProperty "nonIndented combinator" prop_nonIndented+  , testProperty "indentBlock combinator" prop_indentBlock+  , testProperty "indentBlock (many)"     prop_indentMany+  , testProperty "charLiteral"            prop_charLiteral+  , testProperty "integer"                prop_integer+  , testProperty "decimal"                prop_decimal+  , testProperty "hexadecimal"            prop_hexadecimal+  , testProperty "octal"                  prop_octal+  , testProperty "float 0"                prop_float_0+  , testProperty "float 1"                prop_float_1+  , testProperty "number 0"               prop_number_0+  , testProperty "number 1"               prop_number_1+  , testProperty "number 2 (signed)"      prop_number_2+  , testProperty "signed"                 prop_signed ]  -- White space @@ -321,8 +320,8 @@         s = if i <= length z then take i z ++ "?" ++ drop i z else z  quasiCorrupted :: NonNegative Integer -> Int-               -> (Integer -> String -> String) -> String-               -> (Either ParseError Integer, String)+  -> (Integer -> String -> String) -> String+  -> (Either ParseError Integer, String) quasiCorrupted n' i shower l = (r, s)   where n = getNonNegative n'         r | i > length z = Right n

@@ -1,4 +1,3 @@--- -*- Mode: Haskell; -*- -- -- QuickCheck tests for Megaparsec, main module. --@@ -42,11 +41,11 @@  main :: IO () main = defaultMain-       [ Pos.tests-       , Error.tests-       , Prim.tests-       , Combinator.tests-       , Char.tests-       , Expr.tests-       , Perm.tests-       , Lexer.tests ]+  [ Pos.tests+  , Error.tests+  , Prim.tests+  , Combinator.tests+  , Char.tests+  , Expr.tests+  , Perm.tests+  , Lexer.tests ]

@@ -1,4 +1,3 @@--- -*- Mode: Haskell; -*- -- -- QuickCheck tests for Megaparsec's permutation phrases parsers. --@@ -37,14 +36,16 @@ import Test.QuickCheck  import Text.Megaparsec.Char+import Text.Megaparsec.Lexer (integer) import Text.Megaparsec.Perm  import Util  tests :: Test tests = testGroup "Permutation phrases parsers"-        [ testProperty "permutation parser pure" prop_pure-        , testProperty "permutation test 0"      prop_perm_0 ]+  [ testProperty "permutation parser pure" prop_pure+  , testProperty "permutation test 0"      prop_perm_0+  , testProperty "combinator (<$$>)"       prop_ddcomb ]  data CharRows = CharRows   { getChars :: (Char, Char, Char)@@ -93,3 +94,10 @@         cis  = elemIndices c s         prec = take (cis !! 1) s         s    = getInput v++prop_ddcomb :: NonNegative Integer -> Property+prop_ddcomb n' = checkParser (makePermParser p) r s+  where p = succ <$$> integer+        r = Right (succ n)+        n = getNonNegative n'+        s = show n

@@ -1,4 +1,3 @@--- -*- Mode: Haskell; -*- -- -- QuickCheck tests for Megaparsec's textual source positions. --@@ -47,18 +46,18 @@  tests :: Test tests = testGroup "Textual source positions"-        [ testProperty "components"                         prop_components-        , testProperty "exception on invalid position"      prop_exception-        , testProperty "show file name in source positions" prop_showFileName-        , testProperty "show line in source positions"      prop_showLine-        , testProperty "show column in source positions"    prop_showColumn-        , testProperty "initial position"                   prop_initialPos-        , testProperty "increment source line"              prop_incSourceLine-        , testProperty "increment source column"            prop_incSourceColumn-        , testProperty "set source name"                    prop_setSourceName-        , testProperty "set source line"                    prop_setSourceLine-        , testProperty "set source column"                  prop_setSourceColumn-        , testProperty "position updating"                  prop_updating ]+  [ testProperty "components"                         prop_components+  , testProperty "exception on invalid position"      prop_exception+  , testProperty "show file name in source positions" prop_showFileName+  , testProperty "show line in source positions"      prop_showLine+  , testProperty "show column in source positions"    prop_showColumn+  , testProperty "initial position"                   prop_initialPos+  , testProperty "increment source line"              prop_incSourceLine+  , testProperty "increment source column"            prop_incSourceColumn+  , testProperty "set source name"                    prop_setSourceName+  , testProperty "set source line"                    prop_setSourceLine+  , testProperty "set source column"                  prop_setSourceColumn+  , testProperty "position updating"                  prop_updating ]  instance Arbitrary SourcePos where   arbitrary = newPos <$> fileName <*> choose (1, 1000) <*> choose (1, 100)

@@ -1,4 +1,3 @@--- -*- Mode: Haskell; -*- -- -- QuickCheck tests for Megaparsec's primitive parser combinators. --@@ -27,6 +26,7 @@ -- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -- POSSIBILITY OF SUCH DAMAGE. +{-# LANGUAGE Rank2Types       #-} {-# OPTIONS -fno-warn-orphans #-}  module Prim (tests) where@@ -35,24 +35,26 @@ import Data.Char (isLetter, toUpper) import Data.Foldable (asum) import Data.List (isPrefixOf)-import Data.Maybe (maybeToList, fromMaybe)+import Data.Maybe (maybeToList)  import Control.Monad.Cont import Control.Monad.Except import Control.Monad.Identity import Control.Monad.Reader-import Control.Monad.Trans.Identity import qualified Control.Monad.State.Lazy    as L import qualified Control.Monad.State.Strict  as S import qualified Control.Monad.Writer.Lazy   as L import qualified Control.Monad.Writer.Strict as S  import Test.Framework+import Test.Framework.Providers.HUnit (testCase) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck hiding (label)+import Test.HUnit (Assertion)  import Text.Megaparsec.Char-import Text.Megaparsec.Error (Message (..), ParseError, newErrorMessages)+import Text.Megaparsec.Combinator+import Text.Megaparsec.Error import Text.Megaparsec.Pos import Text.Megaparsec.Prim import Text.Megaparsec.String@@ -63,59 +65,78 @@  tests :: Test tests = testGroup "Primitive parser combinators"-        [ testProperty "ParsecT functor"                     prop_functor-        , testProperty "ParsecT applicative (<*>)"           prop_applicative_0-        , testProperty "ParsecT applicative (*>)"            prop_applicative_1-        , testProperty "ParsecT applicative (<*)"            prop_applicative_2-        , testProperty "ParsecT alternative empty and (<|>)" prop_alternative_0-        , testProperty "ParsecT alternative (<|>)"           prop_alternative_1-        , testProperty "ParsecT alternative (<|>) pos"       prop_alternative_2-        , testProperty "ParsecT alternative (<|>) hints"     prop_alternative_3-        , testProperty "ParsecT alternative many"            prop_alternative_4-        , testProperty "ParsecT alternative some"            prop_alternative_5-        , testProperty "ParsecT alternative optional"        prop_alternative_6-        , testProperty "ParsecT monad return"                prop_monad_0-        , testProperty "ParsecT monad (>>)"                  prop_monad_1-        , testProperty "ParsecT monad (>>=)"                 prop_monad_2-        , testProperty "ParsecT monad fail"                  prop_monad_3-        , testProperty "ParsecT monad laws: left identity"   prop_monad_left_id-        , testProperty "ParsecT monad laws: right identity"  prop_monad_right_id-        , testProperty "ParsecT monad laws: associativity"   prop_monad_assoc-        , testProperty "ParsecT monad reader ask"   prop_monad_reader_ask-        , testProperty "ParsecT monad reader local" prop_monad_reader_local-        , testProperty "ParsecT monad state get"    prop_monad_state_get-        , testProperty "ParsecT monad state put"    prop_monad_state_put-        , testProperty "ParsecT monad cont"         prop_monad_cont-        , testProperty "ParsecT monad error: throw" prop_monad_error_throw-        , testProperty "ParsecT monad error: catch" prop_monad_error_catch-        , testProperty "combinator unexpected"      prop_unexpected-        , testProperty "combinator failure"                  prop_failure-        , testProperty "combinator label"                    prop_label-        , testProperty "combinator hidden hints"             prop_hidden_0-        , testProperty "combinator hidden error"             prop_hidden_1-        , testProperty "combinator try"                      prop_try-        , testProperty "combinator lookAhead"                prop_lookAhead_0-        , testProperty "combinator lookAhead hints"          prop_lookAhead_1-        , testProperty "combinator lookAhead messages"       prop_lookAhead_2-        , testProperty "combinator notFollowedBy"       prop_notFollowedBy_0-        , testProperty "combinator notFollowedBy twice" prop_notFollowedBy_1-        , testProperty "combinator notFollowedBy eof"   prop_notFollowedBy_2-        , testProperty "combinator token"                    prop_token-        , testProperty "combinator tokens"                   prop_tokens-        , testProperty "parser state position"               prop_state_pos-        , testProperty "parser state input"                  prop_state_input-        , testProperty "parser state tab width"              prop_state_tab-        , testProperty "parser state general"                prop_state-        , testProperty "custom state parsing"                prop_runParser'-        , testProperty "custom state parsing (transformer)"  prop_runParserT'-        , testProperty "IdentityT try"            prop_IdentityT_try-        , testProperty "IdentityT notFollowedBy"  prop_IdentityT_notFollowedBy-        , testProperty "ReaderT try"              prop_ReaderT_try-        , testProperty "ReaderT notFollowedBy"    prop_ReaderT_notFollowedBy-        , testProperty "StateT alternative (<|>)" prop_StateT_alternative-        , testProperty "StateT lookAhead"         prop_StateT_lookAhead-        , testProperty "StateT notFollowedBy"     prop_StateT_notFollowedBy-        , testProperty "WriterT"                  prop_WriterT ]+  [ testProperty "ParsecT functor"                     prop_functor+  , testProperty "ParsecT applicative (<*>)"           prop_applicative_0+  , testProperty "ParsecT applicative (*>)"            prop_applicative_1+  , testProperty "ParsecT applicative (<*)"            prop_applicative_2+  , testProperty "ParsecT alternative empty and (<|>)" prop_alternative_0+  , testProperty "ParsecT alternative (<|>)"           prop_alternative_1+  , testProperty "ParsecT alternative (<|>) pos"       prop_alternative_2+  , testProperty "ParsecT alternative (<|>) hints"     prop_alternative_3+  , testProperty "ParsecT alternative many"            prop_alternative_4+  , testProperty "ParsecT alternative some"            prop_alternative_5+  , testProperty "ParsecT alternative optional"        prop_alternative_6+  , testProperty "ParsecT monad return"                prop_monad_0+  , testProperty "ParsecT monad (>>)"                  prop_monad_1+  , testProperty "ParsecT monad (>>=)"                 prop_monad_2+  , testProperty "ParsecT monad fail"                  prop_monad_3+  , testProperty "ParsecT monad laws: left identity"   prop_monad_left_id+  , testProperty "ParsecT monad laws: right identity"  prop_monad_right_id+  , testProperty "ParsecT monad laws: associativity"   prop_monad_assoc+  , testProperty "ParsecT monad reader ask"   prop_monad_reader_ask+  , testProperty "ParsecT monad reader local" prop_monad_reader_local+  , testProperty "ParsecT monad state get"    prop_monad_state_get+  , testProperty "ParsecT monad state put"    prop_monad_state_put+  , testProperty "ParsecT monad cont"         prop_monad_cont+  , testProperty "ParsecT monad error: throw" prop_monad_error_throw+  , testProperty "ParsecT monad error: catch" prop_monad_error_catch+  , testProperty "combinator unexpected"      prop_unexpected+  , testProperty "combinator failure"                  prop_failure+  , testProperty "combinator label"                    prop_label+  , testProperty "combinator hidden hints"             prop_hidden_0+  , testProperty "combinator hidden error"             prop_hidden_1+  , testProperty "combinator try"                      prop_try+  , testProperty "combinator lookAhead"                prop_lookAhead_0+  , testProperty "combinator lookAhead hints"          prop_lookAhead_1+  , testProperty "combinator lookAhead messages"       prop_lookAhead_2+  , testCase     "combinator lookAhead cerr"           case_lookAhead_3+  , testProperty "combinator notFollowedBy"       prop_notFollowedBy_0+  , testProperty "combinator notFollowedBy twice" prop_notFollowedBy_1+  , testProperty "combinator notFollowedBy eof"   prop_notFollowedBy_2+  , testCase     "combinator notFollowedBy cerr"  case_notFollowedBy_3a+  , testCase     "combinator notFollowedBy cerr"  case_notFollowedBy_3b+  , testCase     "combinator notFollowedBy eerr"  case_notFollowedBy_4a+  , testCase     "combinator notFollowedBy eerr"  case_notFollowedBy_4b+  , testProperty "combinator withRecovery"             prop_withRecovery_0+  , testCase     "combinator withRecovery eok"         case_withRecovery_1+  , testCase     "combinator withRecovery meerr-rcerr" case_withRecovery_2+  , testCase     "combinator withRecovery meerr-reok"  case_withRecovery_3a+  , testCase     "combinator withRecovery meerr-reok"  case_withRecovery_3b+  , testCase     "combinator withRecovery mcerr-rcok"  case_withRecovery_4a+  , testCase     "combinator withRecovery mcerr-rcok"  case_withRecovery_4b+  , testCase     "combinator withRecovery mcerr-rcerr" case_withRecovery_5+  , testCase     "combinator withRecovery mcerr-reok"  case_withRecovery_6a+  , testCase     "combinator withRecovery mcerr-reok"  case_withRecovery_6b+  , testCase     "combinator withRecovery mcerr-reerr" case_withRecovery_7+  , testCase     "combinator eof return value"    case_eof+  , testProperty "combinator token"                    prop_token+  , testProperty "combinator tokens"                   prop_tokens+  , testProperty "parser state position"               prop_state_pos+  , testProperty "parser state input"                  prop_state_input+  , testProperty "parser state tab width"              prop_state_tab+  , testProperty "parser state general"                prop_state+  , testProperty "custom state parsing"                prop_runParser'+  , testProperty "custom state parsing (transformer)"  prop_runParserT'+  , testProperty "state on failure (mplus)"         prop_stOnFail_0+  , testProperty "state on failure (tab)"           prop_stOnFail_1+  , testProperty "state on failure (eof)"           prop_stOnFail_2+  , testProperty "state on failure (notFollowedBy)" prop_stOnFail_3+  , testProperty "ReaderT try"              prop_ReaderT_try+  , testProperty "ReaderT notFollowedBy"    prop_ReaderT_notFollowedBy+  , testProperty "StateT alternative (<|>)" prop_StateT_alternative+  , testProperty "StateT lookAhead"         prop_StateT_lookAhead+  , testProperty "StateT notFollowedBy"     prop_StateT_notFollowedBy+  , testProperty "WriterT"                  prop_WriterT ]  instance Arbitrary (State String) where   arbitrary = State <$> arbitrary <*> arbitrary <*> choose (1, 20)@@ -149,7 +170,7 @@   | s0 `isPrefixOf` s1 =       checkParser p (posErr s0l s1 [uneCh (s1 !! s0l), exEof]) s1   | otherwise = checkParser p (Right s0) s0 .&&. checkParser p (Right s1) s1-    where p   = try (string s0) <|> string s1+    where p   = string s0 <|> string s1           s0l = length s0  prop_alternative_2 :: Char -> Char -> Char -> Bool -> Property@@ -163,8 +184,8 @@  prop_alternative_3 :: Property prop_alternative_3 = checkParser p r s-  where p  = asum [empty, try (string ">>>"), empty, return "foo"] <?> "bar"-        p' = bsum [empty, try (string ">>>"), empty, return "foo"] <?> "bar"+  where p  = asum [empty, string ">>>", empty, return "foo"] <?> "bar"+        p' = bsum [empty, string ">>>", empty, return "foo"] <?> "bar"         bsum = foldl (<|>) empty         r = simpleParse p' s         s = ">>"@@ -200,7 +221,7 @@         r | c = posErr ab s $ [uneCh 'c', exEof] ++                 [exCh 'a' | not a && not b] ++ [exCh 'b' | not b]           | otherwise = Right s-        s = abcRow' a b c+        s = abcRow a b c         ab = fromEnum a + fromEnum b  -- Monad instance@@ -280,35 +301,24 @@ -- Primitive combinators  prop_unexpected :: String -> Property-prop_unexpected m = checkParser p r s-  where p = unexpected m :: Parser ()-        r | null m    = posErr 0 s []-          | otherwise = posErr 0 s [uneSpec m]+prop_unexpected m = checkParser' p r s+  where p :: MonadParsec s m Char => m String+        p = unexpected m+        r = posErr 0 s $ if null m then [] else [uneSpec m]         s = ""  prop_failure :: [Message] -> Property-prop_failure msgs = conjoin [ checkParser p r s-                            , checkParser (runIdentityT p_IdentityT) r s-                            , checkParser (runReaderT p_ReaderT ()) r s-                            , checkParser (L.evalStateT p_lStateT ()) r s-                            , checkParser (S.evalStateT p_sStateT ()) r s-                            , checkParser (L.runWriterT p_lWriterT) r s-                            , checkParser (S.runWriterT p_sWriterT) r s ]-  where p = failure msgs :: Parser ()-        p_IdentityT = failure msgs :: IdentityT Parser ()-        p_ReaderT   = failure msgs :: ReaderT () Parser ()-        p_lStateT   = failure msgs :: L.StateT () Parser ()-        p_sStateT   = failure msgs :: S.StateT () Parser ()-        p_lWriterT  = failure msgs :: L.WriterT [Integer] Parser ()-        p_sWriterT  = failure msgs :: S.WriterT [Integer] Parser ()+prop_failure msgs = checkParser' p r s+  where p :: MonadParsec s m Char => m String+        p = failure msgs         r | null msgs = posErr 0 s []           | otherwise = Left $ newErrorMessages msgs (initialPos "")         s = ""  prop_label :: NonNegative Int -> NonNegative Int            -> NonNegative Int -> String -> Property-prop_label a' b' c' l = checkParser p r s-  where [a,b,c] = getNonNegative <$> [a',b',c']+prop_label a' b' c' l = checkParser' p r s+  where p :: MonadParsec s m Char => m String         p = (++) <$> many (char 'a') <*> (many (char 'b') <?> l)         r | null s = Right s           | c > 0 = posErr (a + b) s $ [uneCh 'c', exEof]@@ -318,40 +328,43 @@                         else exSpec $ "rest of " ++ l]           | otherwise = Right s         s = abcRow a b c+        [a,b,c] = getNonNegative <$> [a',b',c']  prop_hidden_0 :: NonNegative Int -> NonNegative Int               -> NonNegative Int -> Property-prop_hidden_0 a' b' c' = checkParser p r s-  where [a,b,c] = getNonNegative <$> [a',b',c']+prop_hidden_0 a' b' c' = checkParser' p r s+  where p :: MonadParsec s m Char => m String         p = (++) <$> many (char 'a') <*> hidden (many (char 'b'))         r | null s = Right s           | c > 0  = posErr (a + b) s $ [uneCh 'c', exEof]                      ++ [exCh 'a' | b == 0]           | otherwise = Right s         s = abcRow a b c+        [a,b,c] = getNonNegative <$> [a',b',c'] -prop_hidden_1 :: String -> NonEmptyList Char -> String -> Property-prop_hidden_1 a c' s = checkParser p r s-  where c = getNonEmpty c'-        p = fromMaybe a <$> optional (hidden $ string c)-        r | null s = Right a-          | c == s = Right s-          | head c /= head s = posErr 0 s [uneCh (head s), exEof]-          | otherwise = simpleParse (string c) s+prop_hidden_1 :: NonEmptyList Char -> String -> Property+prop_hidden_1 c' s = checkParser' p r s+  where p :: MonadParsec s m Char => m (Maybe String)+        p = optional (hidden $ string c)+        r | null s           = Right Nothing+          | c == s           = Right (Just s)+          | c `isPrefixOf` s = posErr cn s [uneCh (s !! cn), exEof]+          | otherwise        = posErr 0 s [uneCh (head s), exEof]+        c = getNonEmpty c'+        cn = length c -prop_try :: String -> String -> String -> Property-prop_try pre s1' s2' = checkParser p r s-  where s1 = pre ++ s1'-        s2 = pre ++ s2'-        p = try (string s1) <|> string s2-        r | s == s1 || s == s2 = Right s-          | otherwise = posErr 0 s $ (if null s then uneEof else uneStr pre)-                        : [uneStr pre, exStr s1, exStr s2]-        s = pre+prop_try :: Char -> Char -> Char -> Property+prop_try pre ch1 ch2 = checkParser' p r s+  where p :: MonadParsec s m Char => m String+        p = try (sequence [char pre, char ch1])+          <|> sequence [char pre, char ch2]+        r = posErr 1 s [uneEof, exCh ch1, exCh ch2]+        s = [pre]  prop_lookAhead_0 :: Bool -> Bool -> Bool -> Property-prop_lookAhead_0 a b c = checkParser p r s-  where p = do+prop_lookAhead_0 a b c = checkParser' p r s+  where p :: MonadParsec s m Char => m Char+        p = do           l <- lookAhead (oneOf "ab" <?> "label")           guard (l == h)           char 'a'@@ -361,62 +374,202 @@           | h == 'b' = posErr 0 s [uneCh 'b', exCh 'a']           | h == 'c' = posErr 0 s [uneCh 'c', exSpec "label"]           | otherwise  = posErr 1 s [uneCh (s !! 1), exEof]-        s = abcRow' a b c+        s = abcRow a b c  prop_lookAhead_1 :: String -> Property-prop_lookAhead_1 s = checkParser p r s-  where p = lookAhead (some letterChar) >> fail "failed" :: Parser ()+prop_lookAhead_1 s = checkParser' p r s+  where p :: MonadParsec s m Char => m ()+        p = lookAhead (some letterChar) >> fail "failed"         h = head s         r | null s     = posErr 0 s [uneEof, exSpec "letter"]           | isLetter h = posErr 0 s [msg "failed"]           | otherwise  = posErr 0 s [uneCh h, exSpec "letter"]  prop_lookAhead_2 :: Bool -> Bool -> Bool -> Property-prop_lookAhead_2 a b c = checkParser p r s-  where p = lookAhead (some (char 'a')) >> char 'b'+prop_lookAhead_2 a b c = checkParser' p r s+  where p :: MonadParsec s m Char => m Char+        p = lookAhead (some (char 'a')) >> char 'b'         r | null s    = posErr 0 s [uneEof, exCh 'a']           | a         = posErr 0 s [uneCh 'a', exCh 'b']           | otherwise = posErr 0 s [uneCh (head s), exCh 'a']-        s = abcRow' a b c+        s = abcRow a b c +case_lookAhead_3 :: Assertion+case_lookAhead_3 = checkCase p r s+  where p :: MonadParsec s m Char => m String+        p = lookAhead (char 'a' *> fail emsg)+        r = posErr 1 s [msg emsg]+        emsg = "ops!"+        s = "abc"+ prop_notFollowedBy_0 :: NonNegative Int -> NonNegative Int                      -> NonNegative Int -> Property-prop_notFollowedBy_0 a' b' c' = checkParser p r s-  where [a,b,c] = getNonNegative <$> [a',b',c']+prop_notFollowedBy_0 a' b' c' = checkParser' p r s+  where p :: MonadParsec s m Char => m String         p = many (char 'a') <* notFollowedBy (char 'b') <* many (char 'c')-        r | b > 0 = posErr a s [uneCh 'b', exCh 'a']+        r | b > 0     = posErr a s [uneCh 'b', exCh 'a']           | otherwise = Right (replicate a 'a')         s = abcRow a b c+        [a,b,c] = getNonNegative <$> [a',b',c']  prop_notFollowedBy_1 :: NonNegative Int -> NonNegative Int                      -> NonNegative Int -> Property-prop_notFollowedBy_1 a' b' c' = checkParser p r s-  where [a,b,c] = getNonNegative <$> [a',b',c']-        p = many (char 'a') <* f (char 'c') <* many (char 'c')-        f = notFollowedBy . notFollowedBy -- = 'lookAhead' in this case+prop_notFollowedBy_1 a' b' c' = checkParser' p r s+  where p :: MonadParsec s m Char => m String+        p = many (char 'a')+          <* (notFollowedBy . notFollowedBy) (char 'c')+          <* many (char 'c')         r | b == 0 && c > 0 = Right (replicate a 'a')           | b > 0           = posErr a s [uneCh 'b', exCh 'a']           | otherwise       = posErr a s [uneEof, exCh 'a']         s = abcRow a b c+        [a,b,c] = getNonNegative <$> [a',b',c']  prop_notFollowedBy_2 :: NonNegative Int -> NonNegative Int                      -> NonNegative Int -> Property-prop_notFollowedBy_2 a' b' c' = checkParser p r s-  where [a,b,c] = getNonNegative <$> [a',b',c']+prop_notFollowedBy_2 a' b' c' = checkParser' p r s+  where p :: MonadParsec s m Char => m String         p = many (char 'a') <* notFollowedBy eof <* many anyChar         r | b > 0 || c > 0 = Right (replicate a 'a')           | otherwise      = posErr a s [uneEof, exCh 'a']         s = abcRow a b c+        [a,b,c] = getNonNegative <$> [a',b',c'] --- We omit tests for 'eof' here because it's used virtually everywhere, it's--- already thoroughly tested.+case_notFollowedBy_3a :: Assertion+case_notFollowedBy_3a = checkCase p r s+  where p :: MonadParsec s m Char => m ()+        p = notFollowedBy (char 'a' *> char 'c')+        r = Right ()+        s = "ab" +case_notFollowedBy_3b :: Assertion+case_notFollowedBy_3b = checkCase p r s+  where p :: MonadParsec s m Char => m ()+        p = notFollowedBy (char 'a' *> char 'd') <* char 'c'+        r = posErr 0 s [uneCh 'a', exCh 'c']+        s = "ab"++case_notFollowedBy_4a :: Assertion+case_notFollowedBy_4a = checkCase p r s+  where p :: MonadParsec s m Char => m ()+        p = notFollowedBy mzero+        r = Right ()+        s = "ab"++case_notFollowedBy_4b :: Assertion+case_notFollowedBy_4b = checkCase p r s+  where p :: MonadParsec s m Char => m ()+        p = notFollowedBy mzero <* char 'c'+        r = posErr 0 s [uneCh 'a', exCh 'c']+        s = "ab"++prop_withRecovery_0 :: NonNegative Int -> NonNegative Int+                    -> NonNegative Int -> Property+prop_withRecovery_0 a' b' c' = checkParser' p r s+  where+    p :: MonadParsec s m Char => m (Either ParseError String)+    p = let g = count' 1 3 . char in v <$>+      withRecovery (\e -> Left e <$ g 'b') (Right <$> g 'a') <*> g 'c'+    v (Right x) y = Right (x ++ y)+    v (Left  m) _ = Left m+    r | a == 0 && b == 0 && c == 0 = posErr 0 s [uneEof, exCh 'a']+      | a == 0 && b == 0 && c >  3 = posErr 0 s [uneCh 'c', exCh 'a']+      | a == 0 && b == 0           = posErr 0 s [uneCh 'c', exCh 'a']+      | a == 0 && b >  3           = posErr 3 s [uneCh 'b', exCh 'a', exCh 'c']+      | a == 0 &&           c == 0 = posErr b s [uneEof, exCh 'a', exCh 'c']+      | a == 0 &&           c >  3 = posErr (b + 3) s [uneCh 'c', exEof]+      | a == 0                     = Right (posErr 0 s [uneCh 'b', exCh 'a'])+      | a >  3                     = posErr 3 s [uneCh 'a', exCh 'c']+      |           b == 0 && c == 0 = posErr a s $ [uneEof, exCh 'c'] ++ ma+      |           b == 0 && c >  3 = posErr (a + 3) s [uneCh 'c', exEof]+      |           b == 0           = Right (Right s)+      | otherwise                  = posErr a s $ [uneCh 'b', exCh 'c'] ++ ma+    ma = [exCh 'a' | a < 3]+    s = abcRow a b c+    [a,b,c] = getNonNegative <$> [a',b',c']++case_withRecovery_1 :: Assertion+case_withRecovery_1 = checkCase p r s+  where p :: MonadParsec s m Char => m String+        p = withRecovery (const $ return "bar") (return "foo")+        r = Right "foo"+        s = "abc"++case_withRecovery_2 :: Assertion+case_withRecovery_2 = checkCase p r s+  where p :: MonadParsec s m Char => m String+        p = withRecovery (\_ -> char 'a' *> mzero) (string "cba")+        r = posErr 0 s [uneCh 'a', exStr "cba"]+        s = "abc"++case_withRecovery_3a :: Assertion+case_withRecovery_3a = checkCase p r s+  where p :: MonadParsec s m Char => m String+        p = withRecovery (const $ return "abd") (string "cba")+        r = Right "abd"+        s = "abc"++case_withRecovery_3b :: Assertion+case_withRecovery_3b = checkCase p r s+  where p :: MonadParsec s m Char => m String+        p = withRecovery (const $ return "abd") (string "cba") <* char 'd'+        r = posErr 0 s [uneCh 'a', exStr "cba", exCh 'd']+        s = "abc"++case_withRecovery_4a :: Assertion+case_withRecovery_4a = checkCase p r s+  where p :: MonadParsec s m Char => m String+        p = withRecovery (const $ string "bc") (char 'a' *> mzero)+        r = Right "bc"+        s = "abc"++case_withRecovery_4b :: Assertion+case_withRecovery_4b = checkCase p r s+  where p :: MonadParsec s m Char => m String+        p = withRecovery (const $ string "bc")+          (char 'a' *> char 'd' *> pure "foo") <* char 'f'+        r = posErr 3 s [uneEof, exCh 'f']+        s = "abc"++case_withRecovery_5 :: Assertion+case_withRecovery_5 = checkCase p r s+  where p :: MonadParsec s m Char => m String+        p = withRecovery (\_ -> char 'b' *> fail emsg) (char 'a' *> fail emsg)+        r = posErr 1 s [msg emsg]+        emsg = "ops!"+        s = "abc"++case_withRecovery_6a :: Assertion+case_withRecovery_6a = checkCase p r s+  where p :: MonadParsec s m Char => m String+        p = withRecovery (const $ return "abd") (char 'a' *> mzero)+        r = Right "abd"+        s = "abc"++case_withRecovery_6b :: Assertion+case_withRecovery_6b = checkCase p r s+  where p :: MonadParsec s m Char => m Char+        p = withRecovery (const $ return 'g') (char 'a' *> char 'd') <* char 'f'+        r = posErr 1 s [uneCh 'b', exCh 'd', exCh 'f']+        s = "abc"++case_withRecovery_7 :: Assertion+case_withRecovery_7 = checkCase p r s+  where p :: MonadParsec s m Char => m Char+        p = withRecovery (const mzero) (char 'a' *> char 'd')+        r = posErr 1 s [uneCh 'b', exCh 'd']+        s = "abc"++case_eof :: Assertion+case_eof = checkCase eof (Right ()) ""+ prop_token :: String -> Property-prop_token s = checkParser p r s-  where p = token updatePosChar testChar+prop_token s = checkParser' p r s+  where p :: MonadParsec s m Char => m Char+        p = token updatePosChar testChar         testChar x = if isLetter x-                     then Right x-                     else Left . pure . Unexpected . showToken $ x+          then Right x+          else Left . pure . Unexpected . showToken $ x         h = head s         r | null s = posErr 0 s [uneEof]           | isLetter h && length s == 1 = Right (head s)@@ -449,14 +602,17 @@   where p = setTabWidth w >> getTabWidth  prop_state :: State String -> State String -> Property-prop_state s1 s2 = runParser p "" "" === Right (f s2 s1)-  where f (State s1' pos w) (State s2' _ _) = State (max s1' s2' ) pos w+prop_state s1 s2 = checkParser' p r s+  where p :: MonadParsec String m Char => m (State String)         p = do           st <- getParserState-          guard (st == State "" (initialPos "") defaultTabWidth)+          guard (st == State s (initialPos "") defaultTabWidth)           setParserState s1           updateParserState (f s2)-          getParserState+          liftM2 const getParserState (setInput "")+        f (State s1' pos w) (State s2' _ _) = State (max s1' s2' ) pos w+        r = Right (f s2 s1)+        s = ""  -- Running a parser @@ -480,40 +636,56 @@        in (st, Left $ newErrorMessages (exStr s : [uneStuff]) pos)   where l = length $ takeWhile id $ zipWith (==) s i --- IdentityT instance of MonadParsec+-- Additional tests to check returned state on failure -prop_IdentityT_try :: String -> String -> String -> Property-prop_IdentityT_try pre s1' s2' = checkParser (runIdentityT p) r s-  where s1 = pre ++ s1'-        s2 = pre ++ s2'-        p = try (string s1) <|> string s2-        r | s == s1 || s == s2 = Right s-          | otherwise = posErr 0 s $ (if null s then uneEof else uneStr pre)-                        : [uneStr pre, exStr s1, exStr s2]-        s = pre+prop_stOnFail_0 :: Positive Int -> Positive Int -> Property+prop_stOnFail_0 na' nb' = runParser' p (stateFromInput s) === (i, r)+  where i = let (Left x) = r in State "" (errorPos x) defaultTabWidth+        na = getPositive na'+        nb = getPositive nb'+        p = try (many (char 'a') <* many (char 'b') <* char 'c')+          <|> (many (char 'a') <* char 'c')+        r = posErr (na + nb) s [exCh 'b', exCh 'c', uneEof]+        s = replicate na 'a' ++ replicate nb 'b' -prop_IdentityT_notFollowedBy :: NonNegative Int -> NonNegative Int-                             -> NonNegative Int -> Property-prop_IdentityT_notFollowedBy a' b' c' = checkParser (runIdentityT p) r s-  where [a,b,c] = getNonNegative <$> [a',b',c']-        p = many (char 'a') <* notFollowedBy eof <* many anyChar-        r | b > 0 || c > 0 = Right (replicate a 'a')-          | otherwise      = posErr a s [uneEof, exCh 'a']-        s = abcRow a b c+prop_stOnFail_1 :: Positive Int -> Positive Int -> Property+prop_stOnFail_1 na' t' = runParser' p (stateFromInput s) === (i, r)+  where i = let (Left x) = r in State "" (errorPos x) t+        na = getPositive na'+        t = getPositive t'+        p = many (char 'a') <* setTabWidth t <* fail myMsg+        r = posErr na s [msg myMsg]+        s = replicate na 'a'+        myMsg = "failing now!" +prop_stOnFail_2 :: String -> Char -> Property+prop_stOnFail_2 s' ch = runParser' p (stateFromInput s) === (i, r)+  where i = let (Left x) = r in State [ch] (errorPos x) defaultTabWidth+        r = posErr (length s') s [uneCh ch, exEof]+        p = string s' <* eof+        s = s' ++ [ch]++prop_stOnFail_3 :: String -> Property+prop_stOnFail_3 s = runParser' p (stateFromInput s) === (i, r)+  where i = let (Left x) = r in State s (errorPos x) defaultTabWidth+        r = posErr 0 s [if null s then uneEof else uneCh (head s)]+        p = notFollowedBy (string s)++stateFromInput :: Stream s t => s -> State s+stateFromInput s = State s (initialPos "") defaultTabWidth+ -- ReaderT instance of MonadParsec -prop_ReaderT_try :: String -> String -> String -> Property-prop_ReaderT_try pre s1' s2' = checkParser (runReaderT p (s1', s2')) r s-  where s1 = pre ++ s1'-        s2 = pre ++ s2'-        getS1 = asks ((pre ++) . fst)-        getS2 = asks ((pre ++) . snd)-        p = try (string =<< getS1) <|> (string =<< getS2)-        r | s == s1 || s == s2 = Right s-          | otherwise = posErr 0 s $ (if null s then uneEof else uneStr pre)-                        : [uneStr pre, exStr s1, exStr s2]-        s = pre+prop_ReaderT_try :: Char -> Char -> Char -> Property+prop_ReaderT_try pre ch1 ch2 = checkParser (runReaderT p (s1, s2)) r s+  where s1 = pre : [ch1]+        s2 = pre : [ch2]+        getS1 = asks fst+        getS2 = asks snd+        p = try (g =<< getS1) <|> (g =<< getS2)+        g = sequence . fmap char+        r = posErr 1 s [uneEof, exCh ch1, exCh ch2]+        s = [pre]  prop_ReaderT_notFollowedBy :: NonNegative Int -> NonNegative Int                            -> NonNegative Int -> Property

@@ -1,4 +1,3 @@--- -*- Mode: Haskell; -*- -- -- QuickCheck tests for Megaparsec, utility functions for parser testing. --@@ -27,15 +26,18 @@ -- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -- POSSIBILITY OF SUCH DAMAGE. +{-# LANGUAGE Rank2Types #-}+ module Util   ( checkParser+  , checkParser'+  , checkCase   , simpleParse   , checkChar   , checkString   , (/=\)   , (!=!)   , abcRow-  , abcRow'   , posErr   , uneCh   , uneStr@@ -49,9 +51,16 @@   , showToken ) where +import Control.Monad.Reader+import Control.Monad.Trans.Identity import Data.Maybe (maybeToList)+import qualified Control.Monad.State.Lazy    as L+import qualified Control.Monad.State.Strict  as S+import qualified Control.Monad.Writer.Lazy   as L+import qualified Control.Monad.Writer.Strict as S  import Test.QuickCheck+import Test.HUnit (Assertion, (@?=))  import Text.Megaparsec.Error import Text.Megaparsec.Pos@@ -68,9 +77,51 @@ -- it should match, otherwise the property doesn't hold and the test fails.  checkParser :: (Eq a, Show a)-            => Parser a -> Either ParseError a -> String -> Property+  => Parser a          -- ^ Parser to test+  -> Either ParseError a -- ^ Expected result of parsing+  -> String            -- ^ Input for the parser+  -> Property          -- ^ Resulting property checkParser p r s = simpleParse p s === r +-- | A variant of 'checkParser' that runs given parser code with all+-- standard instances of 'MonadParsec'. Useful when testing primitive+-- combinators.++checkParser' :: (Eq a, Show a)+  => (forall m. MonadParsec String m Char => m a) -- ^ Parser to test+  -> Either ParseError a -- ^ Expected result of parsing+  -> String            -- ^ Input for the parser+  -> Property          -- ^ Resulting property+checkParser' p r s = conjoin+  [ checkParser p                   r s+  , checkParser (runIdentityT p)    r s+  , checkParser (runReaderT   p ()) r s+  , checkParser (L.evalStateT p ()) r s+  , checkParser (S.evalStateT p ()) r s+  , checkParser (evalWriterTL p)    r s+  , checkParser (evalWriterTS p)    r s ]++-- | Similar to 'checkParser', but produces HUnit's 'Assertion's instead.++checkCase :: (Eq a, Show a)+  => (forall m. MonadParsec String m Char => m a) -- ^ Parser to test+  -> Either ParseError a -- ^ Expected result of parsing+  -> String            -- ^ Input for the parser+  -> Assertion         -- ^ Resulting assertion+checkCase p r s = do+  parse p                   "" s @?= r+  parse (runIdentityT p)    "" s @?= r+  parse (runReaderT   p ()) "" s @?= r+  parse (L.evalStateT p ()) "" s @?= r+  parse (S.evalStateT p ()) "" s @?= r+  parse (evalWriterTL p)    "" s @?= r+  parse (evalWriterTS p)    "" s @?= r++evalWriterTL :: Monad m => L.WriterT [Int] m a -> m a+evalWriterTL = liftM fst . L.runWriterT+evalWriterTS :: Monad m => S.WriterT [Int] m a -> m a+evalWriterTS = liftM fst . S.runWriterT+ -- | @simpleParse p s@ runs parser @p@ on input @s@ and returns corresponding -- result of type @Either ParseError a@, where @a@ is type of parsed -- value. This parser tries to parser end of file too and name of input file@@ -133,15 +184,9 @@ -- @a@ times, character “b” repeated @b@ times, and finally character “c” -- repeated @c@ times. -abcRow :: Int -> Int -> Int -> String-abcRow a b c = replicate a 'a' ++ replicate b 'b' ++ replicate c 'c'---- | @abcRow' a b c@ generates string that includes character “a” if @a@ is--- 'True', then optionally character “b” if @b@ is 'True', then character--- “c” if @c@ is 'True'.--abcRow' :: Bool -> Bool -> Bool -> String-abcRow' a b c = abcRow (fromEnum a) (fromEnum b) (fromEnum c)+abcRow :: Enum a => a -> a -> a -> String+abcRow a b c = f a 'a' ++ f b 'b' ++ f c 'c'+  where f x = replicate (fromEnum x)  -- | @posErr pos s ms@ is an easy way to model result of parser that -- fails. @pos@ is how many tokens (characters) has been consumed before