megaparsec 6.4.1 → 6.5.0

raw patch · 18 files changed

+1458/−1280 lines, 18 filesdep ~QuickCheckdep ~containersdep ~criterionPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: QuickCheck, containers, criterion, parser-combinators

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• README.md +0/−1
• Text/Megaparsec.hs +242/−1259
• Text/Megaparsec/Char/Lexer.hs +3/−3
• Text/Megaparsec/Class.hs +488/−0
• Text/Megaparsec/Error/Builder.hs +3/−1
• Text/Megaparsec/Internal.hs +622/−0
• Text/Megaparsec/Pos.hs +5/−1
• Text/Megaparsec/State.hs +45/−0
• bench/speed/Main.hs +5/−0
• megaparsec.cabal +18/−7
• tests/Control/Applicative/CombinatorsSpec.hs +3/−1
• tests/Control/Monad/CombinatorsSpec.hs +3/−1
• tests/Main.hs +7/−0
• tests/Spec.hs +1/−1
• tests/Test/Hspec/Megaparsec.hs +0/−3
• tests/Text/Megaparsec/ErrorSpec.hs +3/−1
• tests/Text/Megaparsec/PermSpec.hs +5/−1

@@ -1,3 +1,8 @@+## Megaparsec 6.5.0++* Added `Text.Megaparsec.Internal`, which exposes some internal data+  structures and data constructor of `ParsecT`.+ ## Megaparsec 6.4.1  * `scientific` now correctly backtracks after attempting to parse fractional

@@ -5,7 +5,6 @@ [![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)  * [Features](#features)     * [Core features](#core-features)

@@ -54,1265 +54,248 @@ -- modules should be imported explicitly along with the modules mentioned -- above. -{-# LANGUAGE BangPatterns               #-}-{-# LANGUAGE CPP                        #-}-{-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE FlexibleContexts           #-}-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE FunctionalDependencies     #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase                 #-}-{-# LANGUAGE MultiParamTypeClasses      #-}-{-# LANGUAGE RankNTypes                 #-}-{-# LANGUAGE RecordWildCards            #-}-{-# LANGUAGE ScopedTypeVariables        #-}-{-# LANGUAGE TupleSections              #-}-{-# LANGUAGE TypeFamilies               #-}-{-# LANGUAGE UndecidableInstances       #-}--module Text.Megaparsec-  ( -- * Re-exports-    -- $reexports-    module Text.Megaparsec.Pos-  , module Text.Megaparsec.Error-  , module Text.Megaparsec.Stream-  , module Control.Monad.Combinators-    -- * Data types-  , State (..)-  , Parsec-  , ParsecT-    -- * Running parser-  , parse-  , parseMaybe-  , parseTest-  , parseTest'-  , runParser-  , runParser'-  , runParserT-  , runParserT'-    -- * Primitive combinators-  , MonadParsec (..)-    -- * Derivatives of primitive combinators-  , (<?>)-  , unexpected-  , customFailure-  , match-  , region-  , takeRest-  , atEnd-    -- * Parser state combinators-  , getInput-  , setInput-  , getPosition-  , getNextTokenPosition-  , setPosition-  , pushPosition-  , popPosition-  , getTokensProcessed-  , setTokensProcessed-  , getTabWidth-  , setTabWidth-  , setParserState-    -- * Debugging-  , dbg )-where--import Control.DeepSeq-import Control.Monad-import Control.Monad.Combinators-import Control.Monad.Cont.Class-import Control.Monad.Error.Class-import Control.Monad.Identity-import Control.Monad.Reader.Class-import Control.Monad.State.Class hiding (state)-import Control.Monad.Trans-import Data.Data (Data)-import Data.List.NonEmpty (NonEmpty (..))-import Data.Maybe (fromJust)-import Data.Proxy-import Data.Semigroup hiding (option)-import Data.Set (Set)-import Data.String (IsString (..))-import Data.Typeable (Typeable)-import Debug.Trace-import GHC.Generics-import Text.Megaparsec.Error-import Text.Megaparsec.Pos-import Text.Megaparsec.Stream-import qualified Control.Applicative               as A-import qualified Control.Monad.Fail                as Fail-import qualified Control.Monad.RWS.Lazy            as L-import qualified Control.Monad.RWS.Strict          as S-import qualified Control.Monad.Trans.Reader        as L-import qualified Control.Monad.Trans.State.Lazy    as L-import qualified Control.Monad.Trans.State.Strict  as S-import qualified Control.Monad.Trans.Writer.Lazy   as L-import qualified Control.Monad.Trans.Writer.Strict as S-import qualified Data.List.NonEmpty                as NE-import qualified Data.Set                          as E--#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-#endif--#if !MIN_VERSION_mtl(2,2,2)-import Control.Monad.Trans.Identity-#endif---- $reexports------ Also note that you can import "Control.Monad.Combinators.NonEmpty" if you--- wish that combinators like 'some' return 'NonEmpty' lists. The module--- lives in the @parser-combinators@ package (you need at least version--- /0.4.0/).------ This module is intended to be imported qualified:------ > import qualified Control.Monad.Combinators.NonEmpty as NE--------------------------------------------------------------------------------- Data types---- | This is the Megaparsec's state parametrized over stream type @s@.--data State s = State-  { stateInput :: s-    -- ^ The rest of input to process-  , statePos :: NonEmpty SourcePos-    -- ^ Current position (column + line number) with support for include files-  , stateTokensProcessed :: {-# UNPACK #-} !Int-    -- ^ Number of processed tokens so far-    ---    -- @since 5.2.0-  , stateTabWidth :: Pos-    -- ^ Tab width to use-  } deriving (Show, Eq, Data, Typeable, Generic)--instance NFData s => NFData (State s)---- | All information available after parsing. This includes consumption of--- input, success (with returned value) or failure (with parse error), and--- parser state at the end of parsing.------ See also: 'Consumption', 'Result'.--data Reply e s a = Reply (State s) Consumption (Result (Token s) e a)---- | This data structure represents an aspect of result of parser's work.------ See also: 'Result', 'Reply'.--data Consumption-  = Consumed -- ^ Some part of input stream was consumed-  | Virgin   -- ^ No input was consumed---- | This data structure represents an aspect of result of parser's work.------ See also: 'Consumption', 'Reply'.--data Result t e a-  = OK a                   -- ^ Parser succeeded-  | Error (ParseError t e) -- ^ Parser failed---- | 'Hints' represent a collection of 'ErrorItem's to be included into--- 'ParserError' (when it's a 'TrivialError') as “expected” message items--- when a parser fails without consuming input right after successful parser--- that produced the hints.------ For example, without hints you could get:------ >>> parseTest (many (char 'r') <* eof) "ra"--- 1:2:--- unexpected 'a'--- expecting end of input------ We're getting better error messages with help of hints:------ >>> parseTest (many (char 'r') <* eof) "ra"--- 1:2:--- unexpected 'a'--- expecting 'r' or end of input--newtype Hints t = Hints [Set (ErrorItem t)]-  deriving (Semigroup, Monoid)---- | Convert 'ParseError' record into 'Hints'.--toHints :: NonEmpty SourcePos -> ParseError t e -> Hints t-toHints streamPos = \case-  TrivialError errPos _ ps ->-    -- NOTE This is important to check here that the error indeed has-    -- happened at the same position as current position of stream because-    -- there might have been backtracking with 'try' and in that case we-    -- must not convert such a parse error to hints.-    if streamPos == errPos-      then Hints (if E.null ps then [] else [ps])-      else mempty-  FancyError _ _ -> mempty-{-# INLINE toHints #-}---- | @withHints hs c@ makes “error” continuation @c@ use given hints @hs@.------ Note that if resulting continuation gets 'ParseError' that has custom--- data in it, hints are ignored.--withHints :: Ord (Token s)-  => Hints (Token s)   -- ^ Hints to use-  -> (ParseError (Token s) e -> State s -> m b) -- ^ Continuation to influence-  -> ParseError (Token s) e -- ^ First argument of resulting continuation-  -> State s           -- ^ Second argument of resulting continuation-  -> m b-withHints (Hints ps') c e =-  case e of-    TrivialError pos us ps -> c (TrivialError pos us (E.unions (ps : ps')))-    _ -> c e-{-# INLINE withHints #-}---- | @accHints hs c@ results in “OK” continuation that will add given hints--- @hs@ to third argument of original continuation @c@.--accHints-  :: Hints t           -- ^ 'Hints' to add-  -> (a -> State s -> Hints t -> m b) -- ^ An “OK” continuation to alter-  -> a                 -- ^ First argument of resulting continuation-  -> State s           -- ^ Second argument of resulting continuation-  -> Hints t           -- ^ Third argument of resulting continuation-  -> m b-accHints hs1 c x s hs2 = c x s (hs1 <> hs2)-{-# INLINE accHints #-}---- | Replace the most recent group of hints (if any) with the given--- 'ErrorItem' (or delete it if 'Nothing' is given). This is used in 'label'--- primitive.--refreshLastHint :: Hints t -> Maybe (ErrorItem t) -> Hints t-refreshLastHint (Hints [])     _        = Hints []-refreshLastHint (Hints (_:xs)) Nothing  = Hints xs-refreshLastHint (Hints (_:xs)) (Just m) = Hints (E.singleton m : xs)-{-# INLINE refreshLastHint #-}---- | 'Parsec' is a non-transformer variant of the more general 'ParsecT'--- monad transformer.--type Parsec e s = ParsecT e s Identity---- | @'ParsecT' e s m a@ is a parser with custom data component of error--- @e@, stream type @s@, underlying monad @m@ and return type @a@.--newtype ParsecT e s m a = ParsecT-  { unParser-      :: forall b. State s-      -> (a -> State s   -> Hints (Token s) -> m b) -- consumed-OK-      -> (ParseError (Token s) e -> State s -> m b) -- consumed-error-      -> (a -> State s   -> Hints (Token s) -> m b) -- empty-OK-      -> (ParseError (Token s) e -> State s -> m b) -- empty-error-      -> m b }---- | @since 5.3.0--instance (Stream s, Semigroup a) => Semigroup (ParsecT e s m a) where-  (<>) = A.liftA2 (<>)-  {-# INLINE (<>) #-}-#if MIN_VERSION_base(4,8,0)-  sconcat = fmap sconcat . sequence-#else-  sconcat = fmap (sconcat . NE.fromList) . sequence . NE.toList-#endif-  {-# INLINE sconcat #-}---- | @since 5.3.0--instance (Stream s, Monoid a) => Monoid (ParsecT e s m a) where-  mempty = pure mempty-  {-# INLINE mempty #-}-  mappend = A.liftA2 mappend-  {-# INLINE mappend #-}-  mconcat = fmap mconcat . sequence-  {-# INLINE mconcat #-}---- | @since 6.3.0--instance (a ~ Tokens s, IsString a, Eq a, Stream s, Ord e)-    => IsString (ParsecT e s m a) where-  fromString s = tokens (==) (fromString s)--instance Functor (ParsecT e s m) where-  fmap = pMap--pMap :: (a -> b) -> ParsecT e s m a -> ParsecT e s m b-pMap f p = ParsecT $ \s cok cerr eok eerr ->-  unParser p s (cok . f) cerr (eok . f) eerr-{-# INLINE pMap #-}---- | 'pure' returns a parser that __succeeds__ without consuming input.--instance Stream s => A.Applicative (ParsecT e s m) where-  pure     = pPure-  (<*>)    = pAp-  p1 *> p2 = p1 `pBind` const p2-  p1 <* p2 = do { x1 <- p1 ; void p2 ; return x1 }--pAp :: Stream s-  => ParsecT e s m (a -> b)-  -> ParsecT e s m a-  -> ParsecT e s m b-pAp m k = ParsecT $ \s cok cerr eok eerr ->-  let mcok x s' hs = unParser k s' (cok . x) cerr-        (accHints hs (cok . x)) (withHints hs cerr)-      meok x s' hs = unParser k s' (cok . x) cerr-        (accHints hs (eok . x)) (withHints hs eerr)-  in unParser m s mcok cerr meok eerr-{-# INLINE pAp #-}---- | 'A.empty' is a parser that __fails__ without consuming input.--instance (Ord e, Stream s) => A.Alternative (ParsecT e s m) where-  empty  = mzero-  (<|>)  = mplus---- | 'return' returns a parser that __succeeds__ without consuming input.--instance Stream s => Monad (ParsecT e s m) where-  return = pure-  (>>=)  = pBind-  fail   = Fail.fail--pPure :: a -> ParsecT e s m a-pPure x = ParsecT $ \s _ _ eok _ -> eok x s mempty-{-# INLINE pPure #-}--pBind :: Stream s-  => ParsecT e s m a-  -> (a -> ParsecT e s m b)-  -> ParsecT e s m b-pBind m k = ParsecT $ \s cok cerr eok eerr ->-  let mcok x s' hs = unParser (k x) s' cok cerr-        (accHints hs cok) (withHints hs cerr)-      meok x s' hs = unParser (k x) s' cok cerr-        (accHints hs eok) (withHints hs eerr)-  in unParser m s mcok cerr meok eerr-{-# INLINE pBind #-}--instance Stream s => Fail.MonadFail (ParsecT e s m) where-  fail = pFail--pFail :: String -> ParsecT e s m a-pFail msg = ParsecT $ \s@(State _ pos _ _) _ _ _ eerr ->-  let d = E.singleton (ErrorFail msg)-  in eerr (FancyError pos d) s-{-# INLINE pFail #-}--mkPT :: Monad m => (State s -> m (Reply e s a)) -> ParsecT e s m a-mkPT k = ParsecT $ \s cok cerr eok eerr -> do-  (Reply s' consumption result) <- k s-  case consumption of-    Consumed ->-      case result of-        OK    x -> cok x s' mempty-        Error e -> cerr e s'-    Virgin ->-      case result of-        OK    x -> eok x s' mempty-        Error e -> eerr e s'--instance (Stream s, MonadIO m) => MonadIO (ParsecT e s m) where-  liftIO = lift . liftIO--instance (Stream s, MonadReader r m) => MonadReader r (ParsecT e s m) where-  ask       = lift ask-  local f p = mkPT $ \s -> local f (runParsecT p s)--instance (Stream s, MonadState st m) => MonadState st (ParsecT e s m) where-  get = lift get-  put = lift . put--instance (Stream s, MonadCont m) => MonadCont (ParsecT e s m) where-  callCC f = mkPT $ \s ->-    callCC $ \c ->-      runParsecT (f (\a -> mkPT $ \s' -> c (pack s' a))) s-    where pack s a = Reply s Virgin (OK a)--instance (Stream s, MonadError e' m) => MonadError e' (ParsecT e s m) where-  throwError = lift . throwError-  p `catchError` h = mkPT $ \s ->-    runParsecT p s `catchError` \e ->-      runParsecT (h e) s---- | 'mzero' is a parser that __fails__ without consuming input.--instance (Ord e, Stream s) => MonadPlus (ParsecT e s m) where-  mzero = pZero-  mplus = pPlus--pZero :: ParsecT e s m a-pZero = ParsecT $ \s@(State _ pos _ _) _ _ _ eerr ->-  eerr (TrivialError pos Nothing E.empty) s-{-# INLINE pZero #-}--pPlus :: (Ord e, Stream s)-  => ParsecT e s m a-  -> ParsecT e s m a-  -> ParsecT e s m a-pPlus m n = ParsecT $ \s cok cerr eok eerr ->-  let meerr err ms =-        let ncerr err' s' = cerr (err' <> err) (longestMatch ms s')-            neok x s' hs  = eok x s' (toHints (statePos s') 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 #-}---- | @since 6.0.0--instance (Stream s, MonadFix m) => MonadFix (ParsecT e s m) where-  mfix f = mkPT $ \s -> mfix $ \(~(Reply _ _ result)) -> do-    let-      a = case result of-        OK a' -> a'-        Error _ -> error "mfix ParsecT"-    runParsecT (f a) s---- | From two states, return the one with the greater number of processed--- tokens. If the numbers of processed tokens are equal, prefer the second--- state.--longestMatch :: State s -> State s -> State s-longestMatch s1@(State _ _ tp1 _) s2@(State _ _ tp2 _) =-  case tp1 `compare` tp2 of-    LT -> s2-    EQ -> s2-    GT -> s1-{-# INLINE longestMatch #-}--instance MonadTrans (ParsecT e s) where-  lift amb = ParsecT $ \s _ _ eok _ ->-    amb >>= \a -> eok a s mempty--------------------------------------------------------------------------------- Running a parser---- | @'parse' p file input@ runs parser @p@ over 'Identity' (see 'runParserT'--- 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'). 'parseErrorPretty' can be used to turn--- 'ParseError' into the string representation of the error message. See--- "Text.Megaparsec.Error" if you need to do more advanced error analysis.------ > main = case (parse numbers "" "11,2,43") of--- >          Left err -> putStr (parseErrorPretty err)--- >          Right xs -> print (sum xs)--- >--- > numbers = integer `sepBy` char ','--parse-  :: Parsec e s a -- ^ Parser to run-  -> String       -- ^ Name of source file-  -> s            -- ^ Input for parser-  -> Either (ParseError (Token s) e) a-parse = runParser---- | @'parseMaybe' p input@ runs the parser @p@ on @input@ and returns the--- result inside 'Just' on success and 'Nothing' on failure. This function--- also parses 'eof', so if the parser doesn't consume all of its input, it--- will fail.------ The function is supposed to be useful for lightweight parsing, where--- error messages (and thus file name) are not important and entire input--- should be parsed. For example, it can be used when parsing of a single--- number according to a specification of its format is desired.--parseMaybe :: (Ord e, Stream s) => Parsec e s a -> s -> Maybe a-parseMaybe p s =-  case parse (p <* eof) "" s of-    Left  _ -> Nothing-    Right x -> Just x---- | The expression @'parseTest' p input@ applies the parser @p@ against--- input @input@ and prints the result to stdout. Useful for testing.--parseTest :: ( ShowErrorComponent e-             , Ord (Token s)-             , ShowToken (Token s)-             , Show a )-  => Parsec e s a -- ^ Parser to run-  -> s            -- ^ Input for parser-  -> IO ()-parseTest p input =-  case parse p "" input of-    Left  e -> putStr (parseErrorPretty e)-    Right x -> print x---- | A version of 'parseTest' that also prints offending line in parse--- errors.------ @since 6.0.0--parseTest' :: ( ShowErrorComponent e-              , ShowToken (Token s)-              , LineToken (Token s)-              , Show a-              , Stream s )-  => Parsec e s a -- ^ Parser to run-  -> s            -- ^ Input for parser-  -> IO ()-parseTest' p input =-  case parse p "" input of-    Left  e -> putStr (parseErrorPretty' input e)-    Right x -> print x---- | @'runParser' p file input@ runs parser @p@ on the input stream of--- tokens @input@, obtained from source @file@. The @file@ is only used in--- error messages and may be the empty string. Returns either a 'ParseError'--- ('Left') or a value of type @a@ ('Right').------ > parseFromFile p file = runParser p file <$> readFile file--runParser-  :: Parsec e s a -- ^ Parser to run-  -> String     -- ^ Name of source file-  -> s          -- ^ Input for parser-  -> Either (ParseError (Token s) e) a-runParser p name s = snd $ runParser' p (initialState name s)---- | The function is similar to 'runParser' with the difference that it--- accepts and returns parser state. This allows to specify arbitrary--- textual position at the beginning of parsing, for example. This is the--- most general way to run a parser over the 'Identity' monad.------ @since 4.2.0--runParser'-  :: Parsec e s a -- ^ Parser to run-  -> State s    -- ^ Initial state-  -> (State s, Either (ParseError (Token s) e) a)-runParser' p = runIdentity . runParserT' p---- | @'runParserT' p file input@ runs parser @p@ on the input list of tokens--- @input@, obtained from source @file@. The @file@ is only used in error--- messages and may be the empty string. Returns a computation in the--- underlying monad @m@ that returns either a 'ParseError' ('Left') or a--- value of type @a@ ('Right').--runParserT :: Monad m-  => ParsecT e s m a -- ^ Parser to run-  -> String        -- ^ Name of source file-  -> s             -- ^ Input for parser-  -> m (Either (ParseError (Token s) e) a)-runParserT p name s = snd `liftM` runParserT' p (initialState name s)---- | This function is similar to 'runParserT', but like 'runParser'' it--- accepts and returns parser state. This is thus the most general way to--- run a parser.------ @since 4.2.0--runParserT' :: Monad m-  => ParsecT e s m a -- ^ Parser to run-  -> State s       -- ^ Initial state-  -> m (State s, Either (ParseError (Token s) e) a)-runParserT' p s = do-  (Reply s' _ result) <- runParsecT p s-  case result of-    OK    x -> return (s', Right x)-    Error e -> return (s', Left  e)---- | Low-level unpacking of the 'ParsecT' type. 'runParserT' and 'runParser'--- are built upon this.--runParsecT :: Monad m-  => ParsecT e s m a -- ^ Parser to run-  -> State s       -- ^ Initial state-  -> m (Reply e s a)-runParsecT p s = unParser p s cok cerr eok eerr-  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)---- | Given name of source file and input construct initial state for parser.--initialState :: String -> s -> State s-initialState name s = State-  { stateInput           = s-  , statePos             = initialPos name :| []-  , stateTokensProcessed = 0-  , stateTabWidth        = defaultTabWidth }--------------------------------------------------------------------------------- Primitive combinators---- | Type class describing monads that implement the full set of primitive--- parsers.------ __Note carefully__ that the following primitives are “fast” and should be--- taken advantage of as much as possible if your aim is a fast parser:--- 'tokens', 'takeWhileP', 'takeWhile1P', and 'takeP'.--class (Stream s, A.Alternative m, MonadPlus m)-    => MonadParsec e s m | m -> e s where--  -- | The most general way to stop parsing and report a trivial-  -- 'ParseError'.-  ---  -- @since 6.0.0--  failure-    :: Maybe (ErrorItem (Token s)) -- ^ Unexpected item (if any)-    -> Set (ErrorItem (Token s)) -- ^ Expected items-    -> m a--  -- | The most general way to stop parsing and report a fancy 'ParseError'.-  -- To report a single custom parse error, see 'customFailure'.-  ---  -- @since 6.0.0--  fancyFailure-    :: Set (ErrorFancy e) -- ^ Fancy error components-    -> m a--  -- | The parser @'label' name p@ behaves as parser @p@, but whenever the-  -- parser @p@ fails /without consuming any input/, it replaces names of-  -- “expected” tokens with the name @name@.--  label :: String -> m a -> m a--  -- | @'hidden' p@ behaves just like parser @p@, but it doesn't show any-  -- “expected” tokens in error message when @p@ fails.-  ---  -- Please use 'hidden' instead of the old @'label' ""@ idiom.--  hidden :: m a -> m a-  hidden = label ""--  -- | The parser @'try' p@ behaves like parser @p@, except that it-  -- backtracks the parser state when @p@ fails (either consuming input or-  -- not).-  ---  -- This combinator is used whenever arbitrary look ahead is needed. Since-  -- it pretends that it hasn't consumed any input when @p@ fails, the-  -- ('A.<|>') combinator will try its second alternative even if the first-  -- parser failed while consuming input.-  ---  -- For example, here is a parser that is supposed to parse the word “let”-  -- or the word “lexical”:-  ---  -- >>> parseTest (string "let" <|> string "lexical") "lexical"-  -- 1:1:-  -- unexpected "lex"-  -- expecting "let"-  ---  -- What happens here? The first parser consumes “le” and fails (because it-  -- doesn't see a “t”). The second parser, however, isn't tried, since the-  -- first parser has already consumed some input! 'try' fixes this behavior-  -- and allows backtracking to work:-  ---  -- >>> parseTest (try (string "let") <|> string "lexical") "lexical"-  -- "lexical"-  ---  -- 'try' also improves error messages in case of overlapping alternatives,-  -- because Megaparsec's hint system can be used:-  ---  -- >>> parseTest (try (string "let") <|> string "lexical") "le"-  -- 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. You still need to use 'try' when your-  -- alternatives are complex, composite parsers.--  try :: m a -> m a--  -- | If @p@ in @'lookAhead' p@ succeeds (either consuming input or not)-  -- the whole parser behaves like @p@ succeeded without consuming anything-  -- (parser state is not updated as well). If @p@ fails, 'lookAhead' has no-  -- effect, i.e. it will fail consuming input if @p@ fails consuming input.-  -- Combine with 'try' if this is undesirable.--  lookAhead :: m a -> m a--  -- | @'notFollowedBy' p@ only succeeds when the parser @p@ fails. This-  -- parser /never consumes/ any input and /never modifies/ parser state. It-  -- can be used to implement the “longest match” rule.--  notFollowedBy :: m a -> m ()--  -- | @'withRecovery' r p@ allows continue parsing even if parser @p@-  -- fails. In this case @r@ is called with the actual 'ParseError' as its-  -- argument. Typical usage is to return a value signifying failure to-  -- parse this particular object and to consume some part of the input up-  -- to the point where the next object starts.-  ---  -- 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 (Token s) e -> m a) -- ^ How to recover from failure-    -> m a             -- ^ Original parser-    -> m a             -- ^ Parser that can recover from failures--  -- | @'observing' p@ allows to “observe” failure of the @p@ parser, should-  -- it happen, without actually ending parsing, but instead getting the-  -- 'ParseError' in 'Left'. On success parsed value is returned in 'Right'-  -- as usual. Note that this primitive just allows you to observe parse-  -- errors as they happen, it does not backtrack or change how the @p@-  -- parser works in any way.-  ---  -- @since 5.1.0--  observing-    :: m a             -- ^ The parser to run-    -> m (Either (ParseError (Token s) e) a)--  -- | This parser only succeeds at the end of the input.--  eof :: m ()--  -- | The parser @'token' test mrep@ accepts a token @t@ with result @x@-  -- when the function @test t@ returns @'Right' x@. @mrep@ may provide-  -- representation of the token to report in error messages when input-  -- stream in empty.-  ---  -- This is the most primitive combinator for accepting tokens. For-  -- example, the 'Text.Megaparsec.Char.satisfy' parser is implemented as:-  ---  -- > satisfy f = token testChar Nothing-  -- >   where-  -- >     testChar x =-  -- >       if f x-  -- >         then Right x-  -- >         else Left (pure (Tokens (x:|[])), Set.empty)--  token-    :: (Token s -> Either ( Maybe (ErrorItem (Token s))-                          , Set (ErrorItem (Token s)) ) a)-       -- ^ Matching function for the token to parse, it allows to construct-       -- arbitrary error message on failure as well; things in the tuple-       -- are: unexpected item (if any) and expected items-    -> Maybe (Token s) -- ^ Token to report when input stream is empty-    -> m a--  -- | The parser @'tokens' test@ parses a chunk of input and returns it.-  -- Supplied predicate @test@ is used to check equality of given and parsed-  -- chunks after a candidate chunk of correct length is fetched from the-  -- stream.-  ---  -- This can be used for example to write 'Text.Megaparsec.Char.string':-  ---  -- > string = tokens (==)-  ---  -- 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 feature /does not/ affect-  -- performance in any way.--  tokens-    :: (Tokens s -> Tokens s -> Bool)-       -- ^ Predicate to check equality of chunks-    -> Tokens s-       -- ^ Chunk of input to match against-    -> m (Tokens s)--  -- | Parse /zero/ or more tokens for which the supplied predicate holds.-  -- Try to use this as much as possible because for many streams the-  -- combinator is much faster than parsers built with 'many' and-  -- 'Text.Megaparsec.Char.satisfy'.-  ---  -- The following equations should clarify the behavior:-  ---  -- > takeWhileP (Just "foo") f = many (satisfy f <?> "foo")-  -- > takeWhileP Nothing      f = many (satisfy f)-  ---  -- The combinator never fails, although it may parse an empty chunk.-  ---  -- @since 6.0.0--  takeWhileP-    :: Maybe String    -- ^ Name for a single token in the row-    -> (Token s -> Bool) -- ^ Predicate to use to test tokens-    -> m (Tokens s)    -- ^ A chunk of matching tokens--  -- | Similar to 'takeWhileP', but fails if it can't parse at least one-  -- token. Note that the combinator either succeeds or fails without-  -- consuming any input, so 'try' is not necessary with it.-  ---  -- @since 6.0.0--  takeWhile1P-    :: Maybe String    -- ^ Name for a single token in the row-    -> (Token s -> Bool) -- ^ Predicate to use to test tokens-    -> m (Tokens s)    -- ^ A chunk of matching tokens--  -- | Extract the specified number of tokens from the input stream and-  -- return them packed as a chunk of stream. If there is not enough tokens-  -- in the stream, a parse error will be signaled. It's guaranteed that if-  -- the parser succeeds, the requested number of tokens will be returned.-  ---  -- The parser is roughly equivalent to:-  ---  -- > takeP (Just "foo") n = count n (anyChar <?> "foo")-  -- > takeP Nothing      n = count n anyChar-  ---  -- Note that if the combinator fails due to insufficient number of tokens-  -- in the input stream, it backtracks automatically. No 'try' is necessary-  -- with 'takeP'.-  ---  -- @since 6.0.0--  takeP-    :: Maybe String    -- ^ Name for a single token in the row-    -> Int             -- ^ How many tokens to extract-    -> m (Tokens s)    -- ^ A chunk of matching tokens--  -- | Return the full parser state as a 'State' record.--  getParserState :: m (State s)--  -- | @'updateParserState' f@ applies the function @f@ to the parser state.--  updateParserState :: (State s -> State s) -> m ()--instance (Ord e, Stream s) => MonadParsec e s (ParsecT e s m) where-  failure           = pFailure-  fancyFailure      = pFancyFailure-  label             = pLabel-  try               = pTry-  lookAhead         = pLookAhead-  notFollowedBy     = pNotFollowedBy-  withRecovery      = pWithRecovery-  observing         = pObserving-  eof               = pEof-  token             = pToken-  tokens            = pTokens-  takeWhileP        = pTakeWhileP-  takeWhile1P       = pTakeWhile1P-  takeP             = pTakeP-  getParserState    = pGetParserState-  updateParserState = pUpdateParserState--pFailure-  :: Maybe (ErrorItem (Token s))-  -> Set (ErrorItem (Token s))-  -> ParsecT e s m a-pFailure us ps = ParsecT $ \s@(State _ pos _ _) _ _ _ eerr ->-  eerr (TrivialError pos us ps) s-{-# INLINE pFailure #-}--pFancyFailure-  :: Set (ErrorFancy e)-  -> ParsecT e s m a-pFancyFailure xs = ParsecT $ \s@(State _ pos _ _) _ _ _ eerr ->-  eerr (FancyError pos xs) s-{-# INLINE pFancyFailure #-}--pLabel :: String -> ParsecT e s m a -> ParsecT e s m a-pLabel l p = ParsecT $ \s cok cerr eok eerr ->-  let el = Label <$> NE.nonEmpty l-      cl = Label . (NE.fromList "the rest of " <>) <$> NE.nonEmpty l-      cok' x s' hs = cok x s' (refreshLastHint hs cl)-      eok' x s' hs = eok x s' (refreshLastHint hs el)-      eerr'    err = eerr $-        case err of-          (TrivialError pos us _) ->-            TrivialError pos us (maybe E.empty E.singleton el)-          _ -> err-  in unParser p s cok' cerr eok' eerr'-{-# INLINE pLabel #-}--pTry :: ParsecT e s m a -> ParsecT e s m a-pTry p = ParsecT $ \s cok _ eok eerr ->-  let eerr' err _ = eerr err s-  in unParser p s cok eerr' eok eerr'-{-# INLINE pTry #-}--pLookAhead :: ParsecT e s m a -> ParsecT e s m a-pLookAhead p = ParsecT $ \s _ cerr eok eerr ->-  let eok' a _ _ = eok a s mempty-  in unParser p s eok' cerr eok' eerr-{-# INLINE pLookAhead #-}--pNotFollowedBy :: Stream s => ParsecT e s m a -> ParsecT e s m ()-pNotFollowedBy p = ParsecT $ \s@(State input pos _ _) _ _ eok eerr ->-  let what = maybe EndOfInput (Tokens . nes . fst) (take1_ input)-      unexpect u = TrivialError pos (pure u) E.empty-      cok' _ _ _ = eerr (unexpect what) s-      cerr'  _ _ = eok () s mempty-      eok' _ _ _ = eerr (unexpect what) s-      eerr'  _ _ = eok () s mempty-  in unParser p s cok' cerr' eok' eerr'-{-# INLINE pNotFollowedBy #-}--pWithRecovery-  :: (ParseError (Token s) e -> ParsecT e s m a)-  -> ParsecT e s m a-  -> ParsecT e 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 (statePos s') 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 (statePos s') err)-            rcerr   _ _ = eerr err ms-            reok x s' _ = eok x s' (toHints (statePos s') err)-            reerr   _ _ = eerr err ms-        in unParser (r err) ms rcok rcerr reok reerr-  in unParser p s cok mcerr eok meerr-{-# INLINE pWithRecovery #-}--pObserving-  :: ParsecT e s m a-  -> ParsecT e s m (Either (ParseError (Token s) e) a)-pObserving p = ParsecT $ \s cok _ eok _ ->-  let cerr' err s' = cok (Left err) s' mempty-      eerr' err s' = eok (Left err) s' (toHints (statePos s') err)-  in unParser p s (cok . Right) cerr' (eok . Right) eerr'-{-# INLINE pObserving #-}--pEof :: forall e s m. Stream s => ParsecT e s m ()-pEof = ParsecT $ \s@(State input (pos:|z) tp w) _ _ eok eerr ->-  case take1_ input of-    Nothing    -> eok () s mempty-    Just (x,_) ->-      let !apos = positionAt1 (Proxy :: Proxy s) pos x-          us    = (pure . Tokens . nes) x-          ps    = E.singleton EndOfInput-      in eerr (TrivialError (apos:|z) us ps)-          (State input (apos:|z) tp w)-{-# INLINE pEof #-}--pToken :: forall e s m a. Stream s-  => (Token s -> Either ( Maybe (ErrorItem (Token s))-                        , Set (ErrorItem (Token s)) ) a)-  -> Maybe (Token s)-  -> ParsecT e s m a-pToken test mtoken = ParsecT $ \s@(State input (pos:|z) tp w) cok _ _ eerr ->-  case take1_ input of-    Nothing ->-      let us = pure EndOfInput-          ps = maybe E.empty (E.singleton . Tokens . nes) mtoken-      in eerr (TrivialError (pos:|z) us ps) s-    Just (c,cs) ->-      case test c of-        Left (us, ps) ->-          let !apos = positionAt1 (Proxy :: Proxy s) pos c-          in eerr (TrivialError (apos:|z) us ps)-                  (State input (apos:|z) tp w)-        Right x ->-          let !npos = advance1 (Proxy :: Proxy s) w pos c-              newstate = State cs (npos:|z) (tp + 1) w-          in cok x newstate mempty-{-# INLINE pToken #-}--pTokens :: forall e s m. Stream s-  => (Tokens s -> Tokens s -> Bool)-  -> Tokens s-  -> ParsecT e s m (Tokens s)-pTokens f tts = ParsecT $ \s@(State input (pos:|z) tp w) cok _ eok eerr ->-  let pxy = Proxy :: Proxy s-      unexpect pos' u =-        let us = pure u-            ps = (E.singleton . Tokens . NE.fromList . chunkToTokens pxy) tts-        in TrivialError pos' us ps-      len = chunkLength pxy tts-  in case takeN_ len input of-    Nothing ->-      eerr (unexpect (pos:|z) EndOfInput) s-    Just (tts', input') ->-      if f tts tts'-        then let !npos = advanceN pxy w pos tts'-                 st    = State input' (npos:|z) (tp + len) w-             in if chunkEmpty pxy tts-                  then eok tts' st mempty-                  else cok tts' st mempty-        else let !apos = positionAtN pxy pos tts'-                 ps = (Tokens . NE.fromList . chunkToTokens pxy) tts'-             in eerr (unexpect (apos:|z) ps) (State input (apos:|z) tp w)-{-# INLINE pTokens #-}--pTakeWhileP :: forall e s m. Stream s-  => Maybe String-  -> (Token s -> Bool)-  -> ParsecT e s m (Tokens s)-pTakeWhileP ml f = ParsecT $ \(State input (pos:|z) tp w) cok _ eok _ ->-  let pxy = Proxy :: Proxy s-      (ts, input') = takeWhile_ f input-      !npos = advanceN pxy w pos ts-      len = chunkLength pxy ts-      hs =-        case ml >>= NE.nonEmpty of-          Nothing -> mempty-          Just l -> (Hints . pure . E.singleton . Label) l-  in if chunkEmpty pxy ts-       then eok ts (State input' (npos:|z) (tp + len) w) hs-       else cok ts (State input' (npos:|z) (tp + len) w) hs-{-# INLINE pTakeWhileP #-}--pTakeWhile1P :: forall e s m. Stream s-  => Maybe String-  -> (Token s -> Bool)-  -> ParsecT e s m (Tokens s)-pTakeWhile1P ml f = ParsecT $ \(State input (pos:|z) tp w) cok _ _ eerr ->-  let pxy = Proxy :: Proxy s-      (ts, input') = takeWhile_ f input-      len = chunkLength pxy ts-      el = Label <$> (ml >>= NE.nonEmpty)-      hs =-        case el of-          Nothing -> mempty-          Just l -> (Hints . pure . E.singleton) l-  in if chunkEmpty pxy ts-       then let !apos = positionAtN pxy pos ts-                us    = pure $-                  case take1_ input of-                    Nothing -> EndOfInput-                    Just (t,_) -> Tokens (nes t)-                ps    = maybe E.empty E.singleton el-            in eerr (TrivialError (apos:|z) us ps)-                    (State input (apos:|z) tp w)-       else let !npos = advanceN pxy w pos ts-            in cok ts (State input' (npos:|z) (tp + len) w) hs-{-# INLINE pTakeWhile1P #-}--pTakeP :: forall e s m. Stream s-  => Maybe String-  -> Int-  -> ParsecT e s m (Tokens s)-pTakeP ml n = ParsecT $ \s@(State input (pos:|z) tp w) cok _ _ eerr ->-  let pxy = Proxy :: Proxy s-      el = Label <$> (ml >>= NE.nonEmpty)-      ps = maybe E.empty E.singleton el-  in case takeN_ n input of-       Nothing ->-         eerr (TrivialError (pos:|z) (pure EndOfInput) ps) s-       Just (ts, input') ->-         let len   = chunkLength pxy ts-             !apos = positionAtN pxy pos ts-             !npos = advanceN pxy w pos ts-         in if len /= n-           then eerr (TrivialError (npos:|z) (pure EndOfInput) ps)-                     (State input (apos:|z) tp w)-           else cok ts (State input' (npos:|z) (tp + len) w) mempty-{-# INLINE pTakeP #-}--pGetParserState :: ParsecT e s m (State s)-pGetParserState = ParsecT $ \s _ _ eok _ -> eok s s mempty-{-# INLINE pGetParserState #-}--pUpdateParserState :: (State s -> State s) -> ParsecT e s m ()-pUpdateParserState f = ParsecT $ \s _ _ eok _ -> eok () (f s) mempty-{-# INLINE pUpdateParserState #-}--nes :: a -> NonEmpty a-nes x = x :| []-{-# INLINE nes #-}--instance MonadParsec e s m => MonadParsec e s (L.StateT st m) where-  failure us ps              = lift (failure us ps)-  fancyFailure xs            = lift (fancyFailure xs)-  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)-  withRecovery r (L.StateT m) = L.StateT $ \s ->-    withRecovery (\e -> L.runStateT (r e) s) (m s)-  observing     (L.StateT m) = L.StateT $ \s ->-    fixs s <$> observing (m s)-  eof                        = lift eof-  token test mt              = lift (token test mt)-  tokens e ts                = lift (tokens e ts)-  takeWhileP l f             = lift (takeWhileP l f)-  takeWhile1P l f            = lift (takeWhile1P l f)-  takeP l n                  = lift (takeP l n)-  getParserState             = lift getParserState-  updateParserState f        = lift (updateParserState f)--instance MonadParsec e s m => MonadParsec e s (S.StateT st m) where-  failure us ps              = lift (failure us ps)-  fancyFailure xs            = lift (fancyFailure xs)-  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)-  withRecovery r (S.StateT m) = S.StateT $ \s ->-    withRecovery (\e -> S.runStateT (r e) s) (m s)-  observing     (S.StateT m) = S.StateT $ \s ->-    fixs s <$> observing (m s)-  eof                        = lift eof-  token test mt              = lift (token test mt)-  tokens e ts                = lift (tokens e ts)-  takeWhileP l f             = lift (takeWhileP l f)-  takeWhile1P l f            = lift (takeWhile1P l f)-  takeP l n                  = lift (takeP l n)-  getParserState             = lift getParserState-  updateParserState f        = lift (updateParserState f)--instance MonadParsec e s m => MonadParsec e s (L.ReaderT r m) where-  failure us ps               = lift (failure us ps)-  fancyFailure xs             = lift (fancyFailure xs)-  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-  withRecovery r (L.ReaderT m) = L.ReaderT $ \s ->-    withRecovery (\e -> L.runReaderT (r e) s) (m s)-  observing     (L.ReaderT m) = L.ReaderT $ observing . m-  eof                         = lift eof-  token test mt               = lift (token test mt)-  tokens e ts                 = lift (tokens e ts)-  takeWhileP l f              = lift (takeWhileP l f)-  takeWhile1P l f             = lift (takeWhile1P l f)-  takeP l n                   = lift (takeP l n)-  getParserState              = lift getParserState-  updateParserState f         = lift (updateParserState f)--instance (Monoid w, MonadParsec e s m) => MonadParsec e s (L.WriterT w m) where-  failure us ps               = lift (failure us ps)-  fancyFailure xs             = lift (fancyFailure xs)-  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)-  withRecovery r (L.WriterT m) = L.WriterT $-    withRecovery (L.runWriterT . r) m-  observing     (L.WriterT m) = L.WriterT $-    fixs mempty <$> observing m-  eof                         = lift eof-  token test mt               = lift (token test mt)-  tokens e ts                 = lift (tokens e ts)-  takeWhileP l f              = lift (takeWhileP l f)-  takeWhile1P l f             = lift (takeWhile1P l f)-  takeP l n                   = lift (takeP l n)-  getParserState              = lift getParserState-  updateParserState f         = lift (updateParserState f)--instance (Monoid w, MonadParsec e s m) => MonadParsec e s (S.WriterT w m) where-  failure us ps               = lift (failure us ps)-  fancyFailure xs             = lift (fancyFailure xs)-  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)-  withRecovery r (S.WriterT m) = S.WriterT $-    withRecovery (S.runWriterT . r) m-  observing     (S.WriterT m) = S.WriterT $-    fixs mempty <$> observing m-  eof                         = lift eof-  token test mt               = lift (token test mt)-  tokens e ts                 = lift (tokens e ts)-  takeWhileP l f              = lift (takeWhileP l f)-  takeWhile1P l f             = lift (takeWhile1P l f)-  takeP l n                   = lift (takeP l n)-  getParserState              = lift getParserState-  updateParserState f         = lift (updateParserState f)---- | @since 5.2.0--instance (Monoid w, MonadParsec e s m) => MonadParsec e s (L.RWST r w st m) where-  failure us ps               = lift (failure us ps)-  fancyFailure xs             = lift (fancyFailure xs)-  label n          (L.RWST m) = L.RWST $ \r s -> label n (m r s)-  try              (L.RWST m) = L.RWST $ \r s -> try (m r s)-  lookAhead        (L.RWST m) = L.RWST $ \r s -> do-    (x,_,_) <- lookAhead (m r s)-    return (x,s,mempty)-  notFollowedBy    (L.RWST m) = L.RWST $ \r s -> do-    notFollowedBy (void $ m r s)-    return ((),s,mempty)-  withRecovery   n (L.RWST m) = L.RWST $ \r s ->-    withRecovery (\e -> L.runRWST (n e) r s) (m r s)-  observing        (L.RWST m) = L.RWST $ \r s ->-    fixs' s <$> observing (m r s)-  eof                         = lift eof-  token test mt               = lift (token test mt)-  tokens e ts                 = lift (tokens e ts)-  takeWhileP l f              = lift (takeWhileP l f)-  takeWhile1P l f             = lift (takeWhile1P l f)-  takeP l n                   = lift (takeP l n)-  getParserState              = lift getParserState-  updateParserState f         = lift (updateParserState f)---- | @since 5.2.0--instance (Monoid w, MonadParsec e s m) => MonadParsec e s (S.RWST r w st m) where-  failure us ps               = lift (failure us ps)-  fancyFailure xs             = lift (fancyFailure xs)-  label n          (S.RWST m) = S.RWST $ \r s -> label n (m r s)-  try              (S.RWST m) = S.RWST $ \r s -> try (m r s)-  lookAhead        (S.RWST m) = S.RWST $ \r s -> do-    (x,_,_) <- lookAhead (m r s)-    return (x,s,mempty)-  notFollowedBy    (S.RWST m) = S.RWST $ \r s -> do-    notFollowedBy (void $ m r s)-    return ((),s,mempty)-  withRecovery   n (S.RWST m) = S.RWST $ \r s ->-    withRecovery (\e -> S.runRWST (n e) r s) (m r s)-  observing        (S.RWST m) = S.RWST $ \r s ->-    fixs' s <$> observing (m r s)-  eof                         = lift eof-  token test mt               = lift (token test mt)-  tokens e ts                 = lift (tokens e ts)-  takeWhileP l f              = lift (takeWhileP l f)-  takeWhile1P l f             = lift (takeWhile1P l f)-  takeP l n                   = lift (takeP l n)-  getParserState              = lift getParserState-  updateParserState f         = lift (updateParserState f)--instance MonadParsec e s m => MonadParsec e s (IdentityT m) where-  failure us ps               = lift (failure us ps)-  fancyFailure xs             = lift (fancyFailure xs)-  label n       (IdentityT m) = IdentityT $ label n m-  try                         = IdentityT . try . runIdentityT-  lookAhead     (IdentityT m) = IdentityT $ lookAhead m-  notFollowedBy (IdentityT m) = IdentityT $ notFollowedBy m-  withRecovery r (IdentityT m) = IdentityT $-    withRecovery (runIdentityT . r) m-  observing     (IdentityT m) = IdentityT $ observing m-  eof                         = lift eof-  token test mt               = lift (token test mt)-  tokens e ts                 = lift $ tokens e ts-  takeWhileP l f              = lift (takeWhileP l f)-  takeWhile1P l f             = lift (takeWhile1P l f)-  takeP l n                   = lift (takeP l n)-  getParserState              = lift getParserState-  updateParserState f         = lift $ updateParserState f--fixs :: s -> Either a (b, s) -> (Either a b, s)-fixs s (Left a)       = (Left a, s)-fixs _ (Right (b, s)) = (Right b, s)-{-# INLINE fixs #-}--fixs' :: Monoid w => s -> Either a (b, s, w) -> (Either a b, s, w)-fixs' s (Left a)        = (Left a, s, mempty)-fixs' _ (Right (b,s,w)) = (Right b, s, w)-{-# INLINE fixs' #-}+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE LambdaCase                 #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE RankNTypes                 #-}+{-# LANGUAGE RecordWildCards            #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TupleSections              #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE UndecidableInstances       #-}++module Text.Megaparsec+  ( -- * Re-exports+    -- $reexports+    module Text.Megaparsec.Pos+  , module Text.Megaparsec.Error+  , module Text.Megaparsec.Stream+  , module Control.Monad.Combinators+    -- * Data types+  , State (..)+  , Parsec+  , ParsecT+    -- * Running parser+  , parse+  , parseMaybe+  , parseTest+  , parseTest'+  , runParser+  , runParser'+  , runParserT+  , runParserT'+    -- * Primitive combinators+  , MonadParsec (..)+    -- * Derivatives of primitive combinators+  , (<?>)+  , unexpected+  , customFailure+  , match+  , region+  , takeRest+  , atEnd+    -- * Parser state combinators+  , getInput+  , setInput+  , getPosition+  , getNextTokenPosition+  , setPosition+  , pushPosition+  , popPosition+  , getTokensProcessed+  , setTokensProcessed+  , getTabWidth+  , setTabWidth+  , setParserState+    -- * Debugging+  , dbg )+where++import Control.Monad+import Control.Monad.Combinators+import Control.Monad.Identity+import Data.List.NonEmpty (NonEmpty (..))+import Data.Maybe (fromJust)+import Data.Proxy+import Debug.Trace+import Text.Megaparsec.Class+import Text.Megaparsec.Error+import Text.Megaparsec.Internal+import Text.Megaparsec.Pos+import Text.Megaparsec.State+import Text.Megaparsec.Stream+import qualified Data.List.NonEmpty as NE+import qualified Data.Set           as E++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative hiding (many, some)+#endif++-- $reexports+--+-- Note that we re-export monadic combinators from+-- "Control.Monad.Combinators" because these are more efficient than+-- 'Applicative'-based ones. Thus 'many' and 'some' may clash with the+-- functions from "Control.Applicative". You need to hide the functions like+-- this:+--+-- > import Control.Applicative hiding (many, some)+--+-- Also note that you can import "Control.Monad.Combinators.NonEmpty" if you+-- wish that combinators like 'some' return 'NonEmpty' lists. The module+-- lives in the @parser-combinators@ package (you need at least version+-- /0.4.0/).+--+-- This module is intended to be imported qualified:+--+-- > import qualified Control.Monad.Combinators.NonEmpty as NE++----------------------------------------------------------------------------+-- Data types++-- | 'Parsec' is a non-transformer variant of the more general 'ParsecT'+-- monad transformer.++type Parsec e s = ParsecT e s Identity++----------------------------------------------------------------------------+-- Running a parser++-- | @'parse' p file input@ runs parser @p@ over 'Identity' (see 'runParserT'+-- 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'). 'parseErrorPretty' can be used to turn+-- 'ParseError' into the string representation of the error message. See+-- "Text.Megaparsec.Error" if you need to do more advanced error analysis.+--+-- > main = case (parse numbers "" "11,2,43") of+-- >          Left err -> putStr (parseErrorPretty err)+-- >          Right xs -> print (sum xs)+-- >+-- > numbers = integer `sepBy` char ','++parse+  :: Parsec e s a -- ^ Parser to run+  -> String       -- ^ Name of source file+  -> s            -- ^ Input for parser+  -> Either (ParseError (Token s) e) a+parse = runParser++-- | @'parseMaybe' p input@ runs the parser @p@ on @input@ and returns the+-- result inside 'Just' on success and 'Nothing' on failure. This function+-- also parses 'eof', so if the parser doesn't consume all of its input, it+-- will fail.+--+-- The function is supposed to be useful for lightweight parsing, where+-- error messages (and thus file name) are not important and entire input+-- should be parsed. For example, it can be used when parsing of a single+-- number according to a specification of its format is desired.++parseMaybe :: (Ord e, Stream s) => Parsec e s a -> s -> Maybe a+parseMaybe p s =+  case parse (p <* eof) "" s of+    Left  _ -> Nothing+    Right x -> Just x++-- | The expression @'parseTest' p input@ applies the parser @p@ against+-- input @input@ and prints the result to stdout. Useful for testing.++parseTest :: ( ShowErrorComponent e+             , Ord (Token s)+             , ShowToken (Token s)+             , Show a )+  => Parsec e s a -- ^ Parser to run+  -> s            -- ^ Input for parser+  -> IO ()+parseTest p input =+  case parse p "" input of+    Left  e -> putStr (parseErrorPretty e)+    Right x -> print x++-- | A version of 'parseTest' that also prints offending line in parse+-- errors.+--+-- @since 6.0.0++parseTest' :: ( ShowErrorComponent e+              , ShowToken (Token s)+              , LineToken (Token s)+              , Show a+              , Stream s )+  => Parsec e s a -- ^ Parser to run+  -> s            -- ^ Input for parser+  -> IO ()+parseTest' p input =+  case parse p "" input of+    Left  e -> putStr (parseErrorPretty' input e)+    Right x -> print x++-- | @'runParser' p file input@ runs parser @p@ on the input stream of+-- tokens @input@, obtained from source @file@. The @file@ is only used in+-- error messages and may be the empty string. Returns either a 'ParseError'+-- ('Left') or a value of type @a@ ('Right').+--+-- > parseFromFile p file = runParser p file <$> readFile file++runParser+  :: Parsec e s a -- ^ Parser to run+  -> String     -- ^ Name of source file+  -> s          -- ^ Input for parser+  -> Either (ParseError (Token s) e) a+runParser p name s = snd $ runParser' p (initialState name s)++-- | The function is similar to 'runParser' with the difference that it+-- accepts and returns parser state. This allows to specify arbitrary+-- textual position at the beginning of parsing, for example. This is the+-- most general way to run a parser over the 'Identity' monad.+--+-- @since 4.2.0++runParser'+  :: Parsec e s a -- ^ Parser to run+  -> State s    -- ^ Initial state+  -> (State s, Either (ParseError (Token s) e) a)+runParser' p = runIdentity . runParserT' p++-- | @'runParserT' p file input@ runs parser @p@ on the input list of tokens+-- @input@, obtained from source @file@. The @file@ is only used in error+-- messages and may be the empty string. Returns a computation in the+-- underlying monad @m@ that returns either a 'ParseError' ('Left') or a+-- value of type @a@ ('Right').++runParserT :: Monad m+  => ParsecT e s m a -- ^ Parser to run+  -> String        -- ^ Name of source file+  -> s             -- ^ Input for parser+  -> m (Either (ParseError (Token s) e) a)+runParserT p name s = snd `liftM` runParserT' p (initialState name s)++-- | This function is similar to 'runParserT', but like 'runParser'' it+-- accepts and returns parser state. This is thus the most general way to+-- run a parser.+--+-- @since 4.2.0++runParserT' :: Monad m+  => ParsecT e s m a -- ^ Parser to run+  -> State s       -- ^ Initial state+  -> m (State s, Either (ParseError (Token s) e) a)+runParserT' p s = do+  (Reply s' _ result) <- runParsecT p s+  case result of+    OK    x -> return (s', Right x)+    Error e -> return (s', Left  e)++-- | Given name of source file and input construct initial state for parser.++initialState :: String -> s -> State s+initialState name s = State+  { stateInput           = s+  , statePos             = initialPos name :| []+  , stateTokensProcessed = 0+  , stateTabWidth        = defaultTabWidth }  ---------------------------------------------------------------------------- -- Derivatives of primitive combinators

@@ -397,10 +397,10 @@ charLiteral = label "literal character" $ do   -- 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+  r <- lookAhead (count' 1 8 C.anyChar)   case listToMaybe (Char.readLitChar r) of-    Just (c, r') -> count (length r - length r') C.anyChar >> return c-    Nothing      -> unexpected (Tokens (x:|[]))+    Just (c, r') -> c <$ skipCount (length r - length r') C.anyChar+    Nothing      -> unexpected (Tokens (head r:|[])) {-# INLINEABLE charLiteral #-}  ----------------------------------------------------------------------------

@@ -0,0 +1,488 @@+-- |+-- Module      :  Text.Megaparsec.Class+-- Copyright   :  © 2015–2018 Megaparsec contributors+--                © 2007 Paolo Martini+--                © 1999–2001 Daan Leijen+-- License     :  FreeBSD+--+-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+-- Definition of 'MonadParsec'—type class describing monads that implement+-- the full set of primitive parsers.+--+-- @since 6.5.0++{-# LANGUAGE CPP                    #-}+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE TupleSections          #-}+{-# LANGUAGE UndecidableInstances   #-}++module Text.Megaparsec.Class+  ( MonadParsec (..) )+where++import Control.Applicative+import Control.Monad+import Control.Monad.Identity+import Control.Monad.Trans+import Data.Set (Set)+import Text.Megaparsec.Error+import Text.Megaparsec.State+import Text.Megaparsec.Stream+import qualified Control.Monad.RWS.Lazy            as L+import qualified Control.Monad.RWS.Strict          as S+import qualified Control.Monad.Trans.Reader        as L+import qualified Control.Monad.Trans.State.Lazy    as L+import qualified Control.Monad.Trans.State.Strict  as S+import qualified Control.Monad.Trans.Writer.Lazy   as L+import qualified Control.Monad.Trans.Writer.Strict as S++#if !MIN_VERSION_mtl(2,2,2)+import Control.Monad.Trans.Identity+#endif++#if !MIN_VERSION_base(4,8,0)+import Data.Monoid+#endif++-- | Type class describing monads that implement the full set of primitive+-- parsers.+--+-- __Note carefully__ that the following primitives are “fast” and should be+-- taken advantage of as much as possible if your aim is a fast parser:+-- 'tokens', 'takeWhileP', 'takeWhile1P', and 'takeP'.++class (Stream s, Alternative m, MonadPlus m)+    => MonadParsec e s m | m -> e s where++  -- | The most general way to stop parsing and report a trivial+  -- 'ParseError'.+  --+  -- @since 6.0.0++  failure+    :: Maybe (ErrorItem (Token s)) -- ^ Unexpected item (if any)+    -> Set (ErrorItem (Token s)) -- ^ Expected items+    -> m a++  -- | The most general way to stop parsing and report a fancy 'ParseError'.+  -- To report a single custom parse error, see 'customFailure'.+  --+  -- @since 6.0.0++  fancyFailure+    :: Set (ErrorFancy e) -- ^ Fancy error components+    -> m a++  -- | The parser @'label' name p@ behaves as parser @p@, but whenever the+  -- parser @p@ fails /without consuming any input/, it replaces names of+  -- “expected” tokens with the name @name@.++  label :: String -> m a -> m a++  -- | @'hidden' p@ behaves just like parser @p@, but it doesn't show any+  -- “expected” tokens in error message when @p@ fails.+  --+  -- Please use 'hidden' instead of the old @'label' ""@ idiom.++  hidden :: m a -> m a+  hidden = label ""++  -- | The parser @'try' p@ behaves like parser @p@, except that it+  -- backtracks the parser state when @p@ fails (either consuming input or+  -- not).+  --+  -- This combinator is used whenever arbitrary look ahead is needed. Since+  -- it pretends that it hasn't consumed any input when @p@ fails, the+  -- ('A.<|>') combinator will try its second alternative even if the first+  -- parser failed while consuming input.+  --+  -- For example, here is a parser that is supposed to parse the word “let”+  -- or the word “lexical”:+  --+  -- >>> parseTest (string "let" <|> string "lexical") "lexical"+  -- 1:1:+  -- unexpected "lex"+  -- expecting "let"+  --+  -- What happens here? The first parser consumes “le” and fails (because it+  -- doesn't see a “t”). The second parser, however, isn't tried, since the+  -- first parser has already consumed some input! 'try' fixes this behavior+  -- and allows backtracking to work:+  --+  -- >>> parseTest (try (string "let") <|> string "lexical") "lexical"+  -- "lexical"+  --+  -- 'try' also improves error messages in case of overlapping alternatives,+  -- because Megaparsec's hint system can be used:+  --+  -- >>> parseTest (try (string "let") <|> string "lexical") "le"+  -- 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. You still need to use 'try' when your+  -- alternatives are complex, composite parsers.++  try :: m a -> m a++  -- | If @p@ in @'lookAhead' p@ succeeds (either consuming input or not)+  -- the whole parser behaves like @p@ succeeded without consuming anything+  -- (parser state is not updated as well). If @p@ fails, 'lookAhead' has no+  -- effect, i.e. it will fail consuming input if @p@ fails consuming input.+  -- Combine with 'try' if this is undesirable.++  lookAhead :: m a -> m a++  -- | @'notFollowedBy' p@ only succeeds when the parser @p@ fails. This+  -- parser /never consumes/ any input and /never modifies/ parser state. It+  -- can be used to implement the “longest match” rule.++  notFollowedBy :: m a -> m ()++  -- | @'withRecovery' r p@ allows continue parsing even if parser @p@+  -- fails. In this case @r@ is called with the actual 'ParseError' as its+  -- argument. Typical usage is to return a value signifying failure to+  -- parse this particular object and to consume some part of the input up+  -- to the point where the next object starts.+  --+  -- 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 (Token s) e -> m a) -- ^ How to recover from failure+    -> m a             -- ^ Original parser+    -> m a             -- ^ Parser that can recover from failures++  -- | @'observing' p@ allows to “observe” failure of the @p@ parser, should+  -- it happen, without actually ending parsing, but instead getting the+  -- 'ParseError' in 'Left'. On success parsed value is returned in 'Right'+  -- as usual. Note that this primitive just allows you to observe parse+  -- errors as they happen, it does not backtrack or change how the @p@+  -- parser works in any way.+  --+  -- @since 5.1.0++  observing+    :: m a             -- ^ The parser to run+    -> m (Either (ParseError (Token s) e) a)++  -- | This parser only succeeds at the end of the input.++  eof :: m ()++  -- | The parser @'token' test mrep@ accepts a token @t@ with result @x@+  -- when the function @test t@ returns @'Right' x@. @mrep@ may provide+  -- representation of the token to report in error messages when input+  -- stream in empty.+  --+  -- This is the most primitive combinator for accepting tokens. For+  -- example, the 'Text.Megaparsec.Char.satisfy' parser is implemented as:+  --+  -- > satisfy f = token testChar Nothing+  -- >   where+  -- >     testChar x =+  -- >       if f x+  -- >         then Right x+  -- >         else Left (pure (Tokens (x:|[])), Set.empty)++  token+    :: (Token s -> Either ( Maybe (ErrorItem (Token s))+                          , Set (ErrorItem (Token s)) ) a)+       -- ^ Matching function for the token to parse, it allows to construct+       -- arbitrary error message on failure as well; things in the tuple+       -- are: unexpected item (if any) and expected items+    -> Maybe (Token s) -- ^ Token to report when input stream is empty+    -> m a++  -- | The parser @'tokens' test@ parses a chunk of input and returns it.+  -- Supplied predicate @test@ is used to check equality of given and parsed+  -- chunks after a candidate chunk of correct length is fetched from the+  -- stream.+  --+  -- This can be used for example to write 'Text.Megaparsec.Char.string':+  --+  -- > string = tokens (==)+  --+  -- 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 feature /does not/ affect+  -- performance in any way.++  tokens+    :: (Tokens s -> Tokens s -> Bool)+       -- ^ Predicate to check equality of chunks+    -> Tokens s+       -- ^ Chunk of input to match against+    -> m (Tokens s)++  -- | Parse /zero/ or more tokens for which the supplied predicate holds.+  -- Try to use this as much as possible because for many streams the+  -- combinator is much faster than parsers built with 'many' and+  -- 'Text.Megaparsec.Char.satisfy'.+  --+  -- The following equations should clarify the behavior:+  --+  -- > takeWhileP (Just "foo") f = many (satisfy f <?> "foo")+  -- > takeWhileP Nothing      f = many (satisfy f)+  --+  -- The combinator never fails, although it may parse an empty chunk.+  --+  -- @since 6.0.0++  takeWhileP+    :: Maybe String    -- ^ Name for a single token in the row+    -> (Token s -> Bool) -- ^ Predicate to use to test tokens+    -> m (Tokens s)    -- ^ A chunk of matching tokens++  -- | Similar to 'takeWhileP', but fails if it can't parse at least one+  -- token. Note that the combinator either succeeds or fails without+  -- consuming any input, so 'try' is not necessary with it.+  --+  -- @since 6.0.0++  takeWhile1P+    :: Maybe String    -- ^ Name for a single token in the row+    -> (Token s -> Bool) -- ^ Predicate to use to test tokens+    -> m (Tokens s)    -- ^ A chunk of matching tokens++  -- | Extract the specified number of tokens from the input stream and+  -- return them packed as a chunk of stream. If there is not enough tokens+  -- in the stream, a parse error will be signaled. It's guaranteed that if+  -- the parser succeeds, the requested number of tokens will be returned.+  --+  -- The parser is roughly equivalent to:+  --+  -- > takeP (Just "foo") n = count n (anyChar <?> "foo")+  -- > takeP Nothing      n = count n anyChar+  --+  -- Note that if the combinator fails due to insufficient number of tokens+  -- in the input stream, it backtracks automatically. No 'try' is necessary+  -- with 'takeP'.+  --+  -- @since 6.0.0++  takeP+    :: Maybe String    -- ^ Name for a single token in the row+    -> Int             -- ^ How many tokens to extract+    -> m (Tokens s)    -- ^ A chunk of matching tokens++  -- | Return the full parser state as a 'State' record.++  getParserState :: m (State s)++  -- | @'updateParserState' f@ applies the function @f@ to the parser state.++  updateParserState :: (State s -> State s) -> m ()++----------------------------------------------------------------------------+-- Lifting through MTL++instance MonadParsec e s m => MonadParsec e s (L.StateT st m) where+  failure us ps              = lift (failure us ps)+  fancyFailure xs            = lift (fancyFailure xs)+  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)+  withRecovery r (L.StateT m) = L.StateT $ \s ->+    withRecovery (\e -> L.runStateT (r e) s) (m s)+  observing     (L.StateT m) = L.StateT $ \s ->+    fixs s <$> observing (m s)+  eof                        = lift eof+  token test mt              = lift (token test mt)+  tokens e ts                = lift (tokens e ts)+  takeWhileP l f             = lift (takeWhileP l f)+  takeWhile1P l f            = lift (takeWhile1P l f)+  takeP l n                  = lift (takeP l n)+  getParserState             = lift getParserState+  updateParserState f        = lift (updateParserState f)++instance MonadParsec e s m => MonadParsec e s (S.StateT st m) where+  failure us ps              = lift (failure us ps)+  fancyFailure xs            = lift (fancyFailure xs)+  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)+  withRecovery r (S.StateT m) = S.StateT $ \s ->+    withRecovery (\e -> S.runStateT (r e) s) (m s)+  observing     (S.StateT m) = S.StateT $ \s ->+    fixs s <$> observing (m s)+  eof                        = lift eof+  token test mt              = lift (token test mt)+  tokens e ts                = lift (tokens e ts)+  takeWhileP l f             = lift (takeWhileP l f)+  takeWhile1P l f            = lift (takeWhile1P l f)+  takeP l n                  = lift (takeP l n)+  getParserState             = lift getParserState+  updateParserState f        = lift (updateParserState f)++instance MonadParsec e s m => MonadParsec e s (L.ReaderT r m) where+  failure us ps               = lift (failure us ps)+  fancyFailure xs             = lift (fancyFailure xs)+  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+  withRecovery r (L.ReaderT m) = L.ReaderT $ \s ->+    withRecovery (\e -> L.runReaderT (r e) s) (m s)+  observing     (L.ReaderT m) = L.ReaderT $ observing . m+  eof                         = lift eof+  token test mt               = lift (token test mt)+  tokens e ts                 = lift (tokens e ts)+  takeWhileP l f              = lift (takeWhileP l f)+  takeWhile1P l f             = lift (takeWhile1P l f)+  takeP l n                   = lift (takeP l n)+  getParserState              = lift getParserState+  updateParserState f         = lift (updateParserState f)++instance (Monoid w, MonadParsec e s m) => MonadParsec e s (L.WriterT w m) where+  failure us ps               = lift (failure us ps)+  fancyFailure xs             = lift (fancyFailure xs)+  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)+  withRecovery r (L.WriterT m) = L.WriterT $+    withRecovery (L.runWriterT . r) m+  observing     (L.WriterT m) = L.WriterT $+    fixs mempty <$> observing m+  eof                         = lift eof+  token test mt               = lift (token test mt)+  tokens e ts                 = lift (tokens e ts)+  takeWhileP l f              = lift (takeWhileP l f)+  takeWhile1P l f             = lift (takeWhile1P l f)+  takeP l n                   = lift (takeP l n)+  getParserState              = lift getParserState+  updateParserState f         = lift (updateParserState f)++instance (Monoid w, MonadParsec e s m) => MonadParsec e s (S.WriterT w m) where+  failure us ps               = lift (failure us ps)+  fancyFailure xs             = lift (fancyFailure xs)+  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)+  withRecovery r (S.WriterT m) = S.WriterT $+    withRecovery (S.runWriterT . r) m+  observing     (S.WriterT m) = S.WriterT $+    fixs mempty <$> observing m+  eof                         = lift eof+  token test mt               = lift (token test mt)+  tokens e ts                 = lift (tokens e ts)+  takeWhileP l f              = lift (takeWhileP l f)+  takeWhile1P l f             = lift (takeWhile1P l f)+  takeP l n                   = lift (takeP l n)+  getParserState              = lift getParserState+  updateParserState f         = lift (updateParserState f)++-- | @since 5.2.0++instance (Monoid w, MonadParsec e s m) => MonadParsec e s (L.RWST r w st m) where+  failure us ps               = lift (failure us ps)+  fancyFailure xs             = lift (fancyFailure xs)+  label n          (L.RWST m) = L.RWST $ \r s -> label n (m r s)+  try              (L.RWST m) = L.RWST $ \r s -> try (m r s)+  lookAhead        (L.RWST m) = L.RWST $ \r s -> do+    (x,_,_) <- lookAhead (m r s)+    return (x,s,mempty)+  notFollowedBy    (L.RWST m) = L.RWST $ \r s -> do+    notFollowedBy (void $ m r s)+    return ((),s,mempty)+  withRecovery   n (L.RWST m) = L.RWST $ \r s ->+    withRecovery (\e -> L.runRWST (n e) r s) (m r s)+  observing        (L.RWST m) = L.RWST $ \r s ->+    fixs' s <$> observing (m r s)+  eof                         = lift eof+  token test mt               = lift (token test mt)+  tokens e ts                 = lift (tokens e ts)+  takeWhileP l f              = lift (takeWhileP l f)+  takeWhile1P l f             = lift (takeWhile1P l f)+  takeP l n                   = lift (takeP l n)+  getParserState              = lift getParserState+  updateParserState f         = lift (updateParserState f)++-- | @since 5.2.0++instance (Monoid w, MonadParsec e s m) => MonadParsec e s (S.RWST r w st m) where+  failure us ps               = lift (failure us ps)+  fancyFailure xs             = lift (fancyFailure xs)+  label n          (S.RWST m) = S.RWST $ \r s -> label n (m r s)+  try              (S.RWST m) = S.RWST $ \r s -> try (m r s)+  lookAhead        (S.RWST m) = S.RWST $ \r s -> do+    (x,_,_) <- lookAhead (m r s)+    return (x,s,mempty)+  notFollowedBy    (S.RWST m) = S.RWST $ \r s -> do+    notFollowedBy (void $ m r s)+    return ((),s,mempty)+  withRecovery   n (S.RWST m) = S.RWST $ \r s ->+    withRecovery (\e -> S.runRWST (n e) r s) (m r s)+  observing        (S.RWST m) = S.RWST $ \r s ->+    fixs' s <$> observing (m r s)+  eof                         = lift eof+  token test mt               = lift (token test mt)+  tokens e ts                 = lift (tokens e ts)+  takeWhileP l f              = lift (takeWhileP l f)+  takeWhile1P l f             = lift (takeWhile1P l f)+  takeP l n                   = lift (takeP l n)+  getParserState              = lift getParserState+  updateParserState f         = lift (updateParserState f)++instance MonadParsec e s m => MonadParsec e s (IdentityT m) where+  failure us ps               = lift (failure us ps)+  fancyFailure xs             = lift (fancyFailure xs)+  label n       (IdentityT m) = IdentityT $ label n m+  try                         = IdentityT . try . runIdentityT+  lookAhead     (IdentityT m) = IdentityT $ lookAhead m+  notFollowedBy (IdentityT m) = IdentityT $ notFollowedBy m+  withRecovery r (IdentityT m) = IdentityT $+    withRecovery (runIdentityT . r) m+  observing     (IdentityT m) = IdentityT $ observing m+  eof                         = lift eof+  token test mt               = lift (token test mt)+  tokens e ts                 = lift $ tokens e ts+  takeWhileP l f              = lift (takeWhileP l f)+  takeWhile1P l f             = lift (takeWhile1P l f)+  takeP l n                   = lift (takeP l n)+  getParserState              = lift getParserState+  updateParserState f         = lift $ updateParserState f++fixs :: s -> Either a (b, s) -> (Either a b, s)+fixs s (Left a)       = (Left a, s)+fixs _ (Right (b, s)) = (Right b, s)+{-# INLINE fixs #-}++fixs' :: Monoid w => s -> Either a (b, s, w) -> (Either a b, s, w)+fixs' s (Left a)        = (Left a, s, mempty)+fixs' _ (Right (b,s,w)) = (Right b, s, w)+{-# INLINE fixs' #-}

@@ -43,7 +43,6 @@ import Data.Data (Data) import Data.List.NonEmpty (NonEmpty (..)) import Data.Proxy-import Data.Semigroup import Data.Set (Set) import Data.Typeable (Typeable) import GHC.Generics@@ -55,6 +54,9 @@  #if !MIN_VERSION_base(4,8,0) import Control.Applicative+#endif+#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup #endif  ----------------------------------------------------------------------------

@@ -0,0 +1,622 @@+-- |+-- Module      :  Text.Megaparsec.Internal+-- Copyright   :  © 2015–2018 Megaparsec contributors+--                © 2007 Paolo Martini+--                © 1999–2001 Daan Leijen+-- License     :  FreeBSD+--+-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+-- Internal definitions. Versioning rules do not apply here. Please do not+-- rely on these unless you really know what you're doing.+--+-- @since 6.5.0++{-# LANGUAGE BangPatterns               #-}+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase                 #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE RankNTypes                 #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE UndecidableInstances       #-}++#if MIN_VERSION_base(4,9,0) && !MIN_VERSION_base(4,11,0)+{-# OPTIONS -Wno-noncanonical-monoid-instances #-}+#endif++module Text.Megaparsec.Internal+  ( -- * Data types+    Hints (..)+  , Reply (..)+  , Consumption (..)+  , Result (..)+  , ParsecT (..)+    -- * Helper functions+  , toHints+  , withHints+  , accHints+  , refreshLastHint+  , runParsecT )+where++import Control.Applicative+import Control.Monad+import Control.Monad.Cont.Class+import Control.Monad.Error.Class+import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Reader.Class+import Control.Monad.State.Class hiding (state)+import Control.Monad.Trans+import Data.List.NonEmpty (NonEmpty (..))+import Data.Proxy+import Data.Semigroup hiding (option)+import Data.Set (Set)+import Data.String (IsString (..))+import Text.Megaparsec.Class+import Text.Megaparsec.Error+import Text.Megaparsec.Pos+import Text.Megaparsec.State+import Text.Megaparsec.Stream+import qualified Control.Monad.Fail  as Fail+import qualified Data.List.NonEmpty  as NE+import qualified Data.Set            as E++----------------------------------------------------------------------------+-- Data types++-- | 'Hints' represent a collection of 'ErrorItem's to be included into+-- 'ParserError' (when it's a 'TrivialError') as “expected” message items+-- when a parser fails without consuming input right after successful parser+-- that produced the hints.+--+-- For example, without hints you could get:+--+-- >>> parseTest (many (char 'r') <* eof) "ra"+-- 1:2:+-- unexpected 'a'+-- expecting end of input+--+-- We're getting better error messages with help of hints:+--+-- >>> parseTest (many (char 'r') <* eof) "ra"+-- 1:2:+-- unexpected 'a'+-- expecting 'r' or end of input++newtype Hints t = Hints [Set (ErrorItem t)]+  deriving (Semigroup, Monoid)++-- | All information available after parsing. This includes consumption of+-- input, success (with returned value) or failure (with parse error), and+-- parser state at the end of parsing.+--+-- See also: 'Consumption', 'Result'.++data Reply e s a = Reply (State s) Consumption (Result (Token s) e a)++-- | This data structure represents an aspect of result of parser's work.+--+-- See also: 'Result', 'Reply'.++data Consumption+  = Consumed -- ^ Some part of input stream was consumed+  | Virgin   -- ^ No input was consumed++-- | This data structure represents an aspect of result of parser's work.+--+-- See also: 'Consumption', 'Reply'.++data Result t e a+  = OK a                   -- ^ Parser succeeded+  | Error (ParseError t e) -- ^ Parser failed++-- | @'ParsecT' e s m a@ is a parser with custom data component of error+-- @e@, stream type @s@, underlying monad @m@ and return type @a@.++newtype ParsecT e s m a = ParsecT+  { unParser+      :: forall b. State s+      -> (a -> State s   -> Hints (Token s) -> m b) -- consumed-OK+      -> (ParseError (Token s) e -> State s -> m b) -- consumed-error+      -> (a -> State s   -> Hints (Token s) -> m b) -- empty-OK+      -> (ParseError (Token s) e -> State s -> m b) -- empty-error+      -> m b }++-- | @since 5.3.0++instance (Stream s, Semigroup a) => Semigroup (ParsecT e s m a) where+  (<>) = liftA2 (<>)+  {-# INLINE (<>) #-}+#if MIN_VERSION_base(4,8,0)+  sconcat = fmap sconcat . sequence+#else+  sconcat = fmap (sconcat . NE.fromList) . sequence . NE.toList+#endif+  {-# INLINE sconcat #-}++-- | @since 5.3.0++instance (Stream s, Monoid a) => Monoid (ParsecT e s m a) where+  mempty = pure mempty+  {-# INLINE mempty #-}+#if MIN_VERSION_base(4,11,0)+  mappend = (<>)+#else+  mappend = liftA2 mappend+#endif+  {-# INLINE mappend #-}+  mconcat = fmap mconcat . sequence+  {-# INLINE mconcat #-}++-- | @since 6.3.0++instance (a ~ Tokens s, IsString a, Eq a, Stream s, Ord e)+    => IsString (ParsecT e s m a) where+  fromString s = tokens (==) (fromString s)++instance Functor (ParsecT e s m) where+  fmap = pMap++pMap :: (a -> b) -> ParsecT e s m a -> ParsecT e s m b+pMap f p = ParsecT $ \s cok cerr eok eerr ->+  unParser p s (cok . f) cerr (eok . f) eerr+{-# INLINE pMap #-}++-- | 'pure' returns a parser that __succeeds__ without consuming input.++instance Stream s => Applicative (ParsecT e s m) where+  pure     = pPure+  (<*>)    = pAp+  p1 *> p2 = p1 `pBind` const p2+  p1 <* p2 = do { x1 <- p1 ; void p2 ; return x1 }++pPure :: a -> ParsecT e s m a+pPure x = ParsecT $ \s _ _ eok _ -> eok x s mempty+{-# INLINE pPure #-}++pAp :: Stream s+  => ParsecT e s m (a -> b)+  -> ParsecT e s m a+  -> ParsecT e s m b+pAp m k = ParsecT $ \s cok cerr eok eerr ->+  let mcok x s' hs = unParser k s' (cok . x) cerr+        (accHints hs (cok . x)) (withHints hs cerr)+      meok x s' hs = unParser k s' (cok . x) cerr+        (accHints hs (eok . x)) (withHints hs eerr)+  in unParser m s mcok cerr meok eerr+{-# INLINE pAp #-}++-- | 'empty' is a parser that __fails__ without consuming input.++instance (Ord e, Stream s) => Alternative (ParsecT e s m) where+  empty  = mzero+  (<|>)  = mplus++-- | 'return' returns a parser that __succeeds__ without consuming input.++instance Stream s => Monad (ParsecT e s m) where+  return = pure+  (>>=)  = pBind+  fail   = Fail.fail++pBind :: Stream s+  => ParsecT e s m a+  -> (a -> ParsecT e s m b)+  -> ParsecT e s m b+pBind m k = ParsecT $ \s cok cerr eok eerr ->+  let mcok x s' hs = unParser (k x) s' cok cerr+        (accHints hs cok) (withHints hs cerr)+      meok x s' hs = unParser (k x) s' cok cerr+        (accHints hs eok) (withHints hs eerr)+  in unParser m s mcok cerr meok eerr+{-# INLINE pBind #-}++instance Stream s => Fail.MonadFail (ParsecT e s m) where+  fail = pFail++pFail :: String -> ParsecT e s m a+pFail msg = ParsecT $ \s@(State _ pos _ _) _ _ _ eerr ->+  let d = E.singleton (ErrorFail msg)+  in eerr (FancyError pos d) s+{-# INLINE pFail #-}++instance (Stream s, MonadIO m) => MonadIO (ParsecT e s m) where+  liftIO = lift . liftIO++instance (Stream s, MonadReader r m) => MonadReader r (ParsecT e s m) where+  ask       = lift ask+  local f p = mkPT $ \s -> local f (runParsecT p s)++instance (Stream s, MonadState st m) => MonadState st (ParsecT e s m) where+  get = lift get+  put = lift . put++instance (Stream s, MonadCont m) => MonadCont (ParsecT e s m) where+  callCC f = mkPT $ \s ->+    callCC $ \c ->+      runParsecT (f (\a -> mkPT $ \s' -> c (pack s' a))) s+    where pack s a = Reply s Virgin (OK a)++instance (Stream s, MonadError e' m) => MonadError e' (ParsecT e s m) where+  throwError = lift . throwError+  p `catchError` h = mkPT $ \s ->+    runParsecT p s `catchError` \e ->+      runParsecT (h e) s++mkPT :: Monad m => (State s -> m (Reply e s a)) -> ParsecT e s m a+mkPT k = ParsecT $ \s cok cerr eok eerr -> do+  (Reply s' consumption result) <- k s+  case consumption of+    Consumed ->+      case result of+        OK    x -> cok x s' mempty+        Error e -> cerr e s'+    Virgin ->+      case result of+        OK    x -> eok x s' mempty+        Error e -> eerr e s'++-- | 'mzero' is a parser that __fails__ without consuming input.++instance (Ord e, Stream s) => MonadPlus (ParsecT e s m) where+  mzero = pZero+  mplus = pPlus++pZero :: ParsecT e s m a+pZero = ParsecT $ \s@(State _ pos _ _) _ _ _ eerr ->+  eerr (TrivialError pos Nothing E.empty) s+{-# INLINE pZero #-}++pPlus :: (Ord e, Stream s)+  => ParsecT e s m a+  -> ParsecT e s m a+  -> ParsecT e s m a+pPlus m n = ParsecT $ \s cok cerr eok eerr ->+  let meerr err ms =+        let ncerr err' s' = cerr (err' <> err) (longestMatch ms s')+            neok x s' hs  = eok x s' (toHints (statePos s') 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 #-}++-- | @since 6.0.0++instance (Stream s, MonadFix m) => MonadFix (ParsecT e s m) where+  mfix f = mkPT $ \s -> mfix $ \(~(Reply _ _ result)) -> do+    let+      a = case result of+        OK a' -> a'+        Error _ -> error "mfix ParsecT"+    runParsecT (f a) s++-- | From two states, return the one with the greater number of processed+-- tokens. If the numbers of processed tokens are equal, prefer the second+-- state.++longestMatch :: State s -> State s -> State s+longestMatch s1@(State _ _ tp1 _) s2@(State _ _ tp2 _) =+  case tp1 `compare` tp2 of+    LT -> s2+    EQ -> s2+    GT -> s1+{-# INLINE longestMatch #-}++instance MonadTrans (ParsecT e s) where+  lift amb = ParsecT $ \s _ _ eok _ ->+    amb >>= \a -> eok a s mempty++instance (Ord e, Stream s) => MonadParsec e s (ParsecT e s m) where+  failure           = pFailure+  fancyFailure      = pFancyFailure+  label             = pLabel+  try               = pTry+  lookAhead         = pLookAhead+  notFollowedBy     = pNotFollowedBy+  withRecovery      = pWithRecovery+  observing         = pObserving+  eof               = pEof+  token             = pToken+  tokens            = pTokens+  takeWhileP        = pTakeWhileP+  takeWhile1P       = pTakeWhile1P+  takeP             = pTakeP+  getParserState    = pGetParserState+  updateParserState = pUpdateParserState++pFailure+  :: Maybe (ErrorItem (Token s))+  -> Set (ErrorItem (Token s))+  -> ParsecT e s m a+pFailure us ps = ParsecT $ \s@(State _ pos _ _) _ _ _ eerr ->+  eerr (TrivialError pos us ps) s+{-# INLINE pFailure #-}++pFancyFailure+  :: Set (ErrorFancy e)+  -> ParsecT e s m a+pFancyFailure xs = ParsecT $ \s@(State _ pos _ _) _ _ _ eerr ->+  eerr (FancyError pos xs) s+{-# INLINE pFancyFailure #-}++pLabel :: String -> ParsecT e s m a -> ParsecT e s m a+pLabel l p = ParsecT $ \s cok cerr eok eerr ->+  let el = Label <$> NE.nonEmpty l+      cl = Label . (NE.fromList "the rest of " <>) <$> NE.nonEmpty l+      cok' x s' hs = cok x s' (refreshLastHint hs cl)+      eok' x s' hs = eok x s' (refreshLastHint hs el)+      eerr'    err = eerr $+        case err of+          (TrivialError pos us _) ->+            TrivialError pos us (maybe E.empty E.singleton el)+          _ -> err+  in unParser p s cok' cerr eok' eerr'+{-# INLINE pLabel #-}++pTry :: ParsecT e s m a -> ParsecT e s m a+pTry p = ParsecT $ \s cok _ eok eerr ->+  let eerr' err _ = eerr err s+  in unParser p s cok eerr' eok eerr'+{-# INLINE pTry #-}++pLookAhead :: ParsecT e s m a -> ParsecT e s m a+pLookAhead p = ParsecT $ \s _ cerr eok eerr ->+  let eok' a _ _ = eok a s mempty+  in unParser p s eok' cerr eok' eerr+{-# INLINE pLookAhead #-}++pNotFollowedBy :: Stream s => ParsecT e s m a -> ParsecT e s m ()+pNotFollowedBy p = ParsecT $ \s@(State input pos _ _) _ _ eok eerr ->+  let what = maybe EndOfInput (Tokens . nes . fst) (take1_ input)+      unexpect u = TrivialError pos (pure u) E.empty+      cok' _ _ _ = eerr (unexpect what) s+      cerr'  _ _ = eok () s mempty+      eok' _ _ _ = eerr (unexpect what) s+      eerr'  _ _ = eok () s mempty+  in unParser p s cok' cerr' eok' eerr'+{-# INLINE pNotFollowedBy #-}++pWithRecovery+  :: (ParseError (Token s) e -> ParsecT e s m a)+  -> ParsecT e s m a+  -> ParsecT e 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 (statePos s') 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 (statePos s') err)+            rcerr   _ _ = eerr err ms+            reok x s' _ = eok x s' (toHints (statePos s') err)+            reerr   _ _ = eerr err ms+        in unParser (r err) ms rcok rcerr reok reerr+  in unParser p s cok mcerr eok meerr+{-# INLINE pWithRecovery #-}++pObserving+  :: ParsecT e s m a+  -> ParsecT e s m (Either (ParseError (Token s) e) a)+pObserving p = ParsecT $ \s cok _ eok _ ->+  let cerr' err s' = cok (Left err) s' mempty+      eerr' err s' = eok (Left err) s' (toHints (statePos s') err)+  in unParser p s (cok . Right) cerr' (eok . Right) eerr'+{-# INLINE pObserving #-}++pEof :: forall e s m. Stream s => ParsecT e s m ()+pEof = ParsecT $ \s@(State input (pos:|z) tp w) _ _ eok eerr ->+  case take1_ input of+    Nothing    -> eok () s mempty+    Just (x,_) ->+      let !apos = positionAt1 (Proxy :: Proxy s) pos x+          us    = (pure . Tokens . nes) x+          ps    = E.singleton EndOfInput+      in eerr (TrivialError (apos:|z) us ps)+          (State input (apos:|z) tp w)+{-# INLINE pEof #-}++pToken :: forall e s m a. Stream s+  => (Token s -> Either ( Maybe (ErrorItem (Token s))+                        , Set (ErrorItem (Token s)) ) a)+  -> Maybe (Token s)+  -> ParsecT e s m a+pToken test mtoken = ParsecT $ \s@(State input (pos:|z) tp w) cok _ _ eerr ->+  case take1_ input of+    Nothing ->+      let us = pure EndOfInput+          ps = maybe E.empty (E.singleton . Tokens . nes) mtoken+      in eerr (TrivialError (pos:|z) us ps) s+    Just (c,cs) ->+      case test c of+        Left (us, ps) ->+          let !apos = positionAt1 (Proxy :: Proxy s) pos c+          in eerr (TrivialError (apos:|z) us ps)+                  (State input (apos:|z) tp w)+        Right x ->+          let !npos = advance1 (Proxy :: Proxy s) w pos c+              newstate = State cs (npos:|z) (tp + 1) w+          in cok x newstate mempty+{-# INLINE pToken #-}++pTokens :: forall e s m. Stream s+  => (Tokens s -> Tokens s -> Bool)+  -> Tokens s+  -> ParsecT e s m (Tokens s)+pTokens f tts = ParsecT $ \s@(State input (pos:|z) tp w) cok _ eok eerr ->+  let pxy = Proxy :: Proxy s+      unexpect pos' u =+        let us = pure u+            ps = (E.singleton . Tokens . NE.fromList . chunkToTokens pxy) tts+        in TrivialError pos' us ps+      len = chunkLength pxy tts+  in case takeN_ len input of+    Nothing ->+      eerr (unexpect (pos:|z) EndOfInput) s+    Just (tts', input') ->+      if f tts tts'+        then let !npos = advanceN pxy w pos tts'+                 st    = State input' (npos:|z) (tp + len) w+             in if chunkEmpty pxy tts+                  then eok tts' st mempty+                  else cok tts' st mempty+        else let !apos = positionAtN pxy pos tts'+                 ps = (Tokens . NE.fromList . chunkToTokens pxy) tts'+             in eerr (unexpect (apos:|z) ps) (State input (apos:|z) tp w)+{-# INLINE pTokens #-}++pTakeWhileP :: forall e s m. Stream s+  => Maybe String+  -> (Token s -> Bool)+  -> ParsecT e s m (Tokens s)+pTakeWhileP ml f = ParsecT $ \(State input (pos:|z) tp w) cok _ eok _ ->+  let pxy = Proxy :: Proxy s+      (ts, input') = takeWhile_ f input+      !npos = advanceN pxy w pos ts+      len = chunkLength pxy ts+      hs =+        case ml >>= NE.nonEmpty of+          Nothing -> mempty+          Just l -> (Hints . pure . E.singleton . Label) l+  in if chunkEmpty pxy ts+       then eok ts (State input' (npos:|z) (tp + len) w) hs+       else cok ts (State input' (npos:|z) (tp + len) w) hs+{-# INLINE pTakeWhileP #-}++pTakeWhile1P :: forall e s m. Stream s+  => Maybe String+  -> (Token s -> Bool)+  -> ParsecT e s m (Tokens s)+pTakeWhile1P ml f = ParsecT $ \(State input (pos:|z) tp w) cok _ _ eerr ->+  let pxy = Proxy :: Proxy s+      (ts, input') = takeWhile_ f input+      len = chunkLength pxy ts+      el = Label <$> (ml >>= NE.nonEmpty)+      hs =+        case el of+          Nothing -> mempty+          Just l -> (Hints . pure . E.singleton) l+  in if chunkEmpty pxy ts+       then let !apos = positionAtN pxy pos ts+                us    = pure $+                  case take1_ input of+                    Nothing -> EndOfInput+                    Just (t,_) -> Tokens (nes t)+                ps    = maybe E.empty E.singleton el+            in eerr (TrivialError (apos:|z) us ps)+                    (State input (apos:|z) tp w)+       else let !npos = advanceN pxy w pos ts+            in cok ts (State input' (npos:|z) (tp + len) w) hs+{-# INLINE pTakeWhile1P #-}++pTakeP :: forall e s m. Stream s+  => Maybe String+  -> Int+  -> ParsecT e s m (Tokens s)+pTakeP ml n = ParsecT $ \s@(State input (pos:|z) tp w) cok _ _ eerr ->+  let pxy = Proxy :: Proxy s+      el = Label <$> (ml >>= NE.nonEmpty)+      ps = maybe E.empty E.singleton el+  in case takeN_ n input of+       Nothing ->+         eerr (TrivialError (pos:|z) (pure EndOfInput) ps) s+       Just (ts, input') ->+         let len   = chunkLength pxy ts+             !apos = positionAtN pxy pos ts+             !npos = advanceN pxy w pos ts+         in if len /= n+           then eerr (TrivialError (npos:|z) (pure EndOfInput) ps)+                     (State input (apos:|z) tp w)+           else cok ts (State input' (npos:|z) (tp + len) w) mempty+{-# INLINE pTakeP #-}++pGetParserState :: ParsecT e s m (State s)+pGetParserState = ParsecT $ \s _ _ eok _ -> eok s s mempty+{-# INLINE pGetParserState #-}++pUpdateParserState :: (State s -> State s) -> ParsecT e s m ()+pUpdateParserState f = ParsecT $ \s _ _ eok _ -> eok () (f s) mempty+{-# INLINE pUpdateParserState #-}++nes :: a -> NonEmpty a+nes x = x :| []+{-# INLINE nes #-}++----------------------------------------------------------------------------+-- Helper functions++-- | Convert 'ParseError' record into 'Hints'.++toHints :: NonEmpty SourcePos -> ParseError t e -> Hints t+toHints streamPos = \case+  TrivialError errPos _ ps ->+    -- NOTE This is important to check here that the error indeed has+    -- happened at the same position as current position of stream because+    -- there might have been backtracking with 'try' and in that case we+    -- must not convert such a parse error to hints.+    if streamPos == errPos+      then Hints (if E.null ps then [] else [ps])+      else mempty+  FancyError _ _ -> mempty+{-# INLINE toHints #-}++-- | @withHints hs c@ makes “error” continuation @c@ use given hints @hs@.+--+-- Note that if resulting continuation gets 'ParseError' that has custom+-- data in it, hints are ignored.++withHints :: Ord (Token s)+  => Hints (Token s)   -- ^ Hints to use+  -> (ParseError (Token s) e -> State s -> m b) -- ^ Continuation to influence+  -> ParseError (Token s) e -- ^ First argument of resulting continuation+  -> State s           -- ^ Second argument of resulting continuation+  -> m b+withHints (Hints ps') c e =+  case e of+    TrivialError pos us ps -> c (TrivialError pos us (E.unions (ps : ps')))+    _ -> c e+{-# INLINE withHints #-}++-- | @accHints hs c@ results in “OK” continuation that will add given hints+-- @hs@ to third argument of original continuation @c@.++accHints+  :: Hints t           -- ^ 'Hints' to add+  -> (a -> State s -> Hints t -> m b) -- ^ An “OK” continuation to alter+  -> a                 -- ^ First argument of resulting continuation+  -> State s           -- ^ Second argument of resulting continuation+  -> Hints t           -- ^ Third argument of resulting continuation+  -> m b+accHints hs1 c x s hs2 = c x s (hs1 <> hs2)+{-# INLINE accHints #-}++-- | Replace the most recent group of hints (if any) with the given+-- 'ErrorItem' (or delete it if 'Nothing' is given). This is used in 'label'+-- primitive.++refreshLastHint :: Hints t -> Maybe (ErrorItem t) -> Hints t+refreshLastHint (Hints [])     _        = Hints []+refreshLastHint (Hints (_:xs)) Nothing  = Hints xs+refreshLastHint (Hints (_:xs)) (Just m) = Hints (E.singleton m : xs)+{-# INLINE refreshLastHint #-}++-- | Low-level unpacking of the 'ParsecT' type.++runParsecT :: Monad m+  => ParsecT e s m a -- ^ Parser to run+  -> State s       -- ^ Initial state+  -> m (Reply e s a)+runParsecT p s = unParser p s cok cerr eok eerr+  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)

@@ -14,6 +14,7 @@ -- You probably do not want to import this module directly because -- "Text.Megaparsec" re-exports it anyway. +{-# LANGUAGE CPP                        #-} {-# LANGUAGE DeriveDataTypeable         #-} {-# LANGUAGE DeriveGeneric              #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}@@ -35,9 +36,12 @@ import Control.DeepSeq import Control.Exception import Data.Data (Data)-import Data.Semigroup import Data.Typeable (Typeable) import GHC.Generics++#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup+#endif  ---------------------------------------------------------------------------- -- Abstract position

@@ -0,0 +1,45 @@+-- |+-- Module      :  Text.Megaparsec.State+-- Copyright   :  © 2015–2018 Megaparsec contributors+--                © 2007 Paolo Martini+--                © 1999–2001 Daan Leijen+-- License     :  FreeBSD+--+-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+-- Definition of Megaparsec's 'State'.+--+-- @since 6.5.0++{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}++module Text.Megaparsec.State+  ( State (..) )+where++import Control.DeepSeq (NFData)+import Data.Data (Data)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Typeable (Typeable)+import GHC.Generics+import Text.Megaparsec.Pos++-- | This is the Megaparsec's state parametrized over stream type @s@.++data State s = State+  { stateInput :: s+    -- ^ The rest of input to process+  , statePos :: NonEmpty SourcePos+    -- ^ Current position (column + line number) with support for include files+  , stateTokensProcessed :: {-# UNPACK #-} !Int+    -- ^ Number of processed tokens so far+    --+    -- @since 5.2.0+  , stateTabWidth :: Pos+    -- ^ Tab width to use+  } deriving (Show, Eq, Data, Typeable, Generic)++instance NFData s => NFData (State s)

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP               #-} {-# LANGUAGE OverloadedStrings #-}  module Main (main) where@@ -11,6 +12,10 @@ import Text.Megaparsec.Char import qualified Data.Text                  as T import qualified Text.Megaparsec.Char.Lexer as L++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative hiding (many, some)+#endif  -- | The type of parser that consumes 'String's. 

@@ -1,7 +1,7 @@ name:                 megaparsec-version:              6.4.1-cabal-version:        >= 1.18-tested-with:          GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2+version:              6.5.0+cabal-version:        1.18+tested-with:          GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.1 license:              BSD2 license-file:         LICENSE.md author:               Megaparsec contributors,@@ -57,24 +57,34 @@                     , Text.Megaparsec.Error                     , Text.Megaparsec.Error.Builder                     , Text.Megaparsec.Expr+                    , Text.Megaparsec.Internal                     , Text.Megaparsec.Perm                     , Text.Megaparsec.Pos                     , Text.Megaparsec.Stream+  other-modules:      Text.Megaparsec.Class+                    , Text.Megaparsec.State   if flag(dev)     ghc-options:      -O0 -Wall -Werror   else     ghc-options:      -O2 -Wall+  if flag(dev) && impl(ghc >= 8.0)+    ghc-options:      -Wcompat+                      -Wincomplete-record-updates+                      -Wincomplete-uni-patterns+                      -Wnoncanonical-monad-instances+                      -Wnoncanonical-monadfail-instances   default-language:   Haskell2010  test-suite tests-  main-is:            Spec.hs+  main-is:            Main.hs   hs-source-dirs:     tests   type:               exitcode-stdio-1.0   if flag(dev)     ghc-options:      -O0 -Wall -Werror   else     ghc-options:      -O2 -Wall-  other-modules:      Control.Applicative.CombinatorsSpec+  other-modules:      Spec+                    , Control.Applicative.CombinatorsSpec                     , Control.Monad.CombinatorsSpec                     , Test.Hspec.Megaparsec                     , Test.Hspec.Megaparsec.AdHoc@@ -88,7 +98,7 @@                     , Text.Megaparsec.PosSpec                     , Text.Megaparsec.StreamSpec                     , Text.MegaparsecSpec-  build-depends:      QuickCheck   >= 2.7   && < 2.11+  build-depends:      QuickCheck   >= 2.7   && < 2.12                     , base         >= 4.7   && < 5.0                     , bytestring   >= 0.2   && < 0.11                     , containers   >= 0.5   && < 0.6@@ -99,6 +109,7 @@                     , scientific   >= 0.3.1 && < 0.4                     , text         >= 0.2   && < 1.3                     , transformers >= 0.4   && < 0.6+  build-tools:        hspec-discover >= 2.0 && < 3.0   if !impl(ghc >= 8.0)     build-depends:    semigroups   == 0.18.*   if !impl(ghc >= 7.10)@@ -110,7 +121,7 @@   hs-source-dirs:     bench/speed   type:               exitcode-stdio-1.0   build-depends:      base         >= 4.7  && < 5.0-                    , criterion    >= 0.6.2.1 && < 1.4+                    , criterion    >= 0.6.2.1 && < 1.5                     , deepseq      >= 1.3  && < 1.5                     , megaparsec                     , text         >= 0.2  && < 1.3

@@ -6,7 +6,6 @@ import Data.Char (isLetter, isDigit) import Data.List (intersperse) import Data.Maybe (fromMaybe, maybeToList, isNothing, fromJust)-import Data.Monoid import Test.Hspec import Test.Hspec.Megaparsec import Test.Hspec.Megaparsec.AdHoc@@ -16,6 +15,9 @@  #if !MIN_VERSION_base(4,8,0) import Control.Applicative hiding (many, some)+#endif+#if !MIN_VERSION_base(4,11,0)+import Data.Monoid #endif  spec :: Spec

@@ -5,7 +5,6 @@  import Data.List (intersperse) import Data.Maybe (maybeToList, isNothing, fromJust)-import Data.Monoid import Test.Hspec import Test.Hspec.Megaparsec import Test.Hspec.Megaparsec.AdHoc@@ -15,6 +14,9 @@  #if !MIN_VERSION_base(4,8,0) import Control.Applicative hiding (many, some)+#endif+#if !MIN_VERSION_base(4,11,0)+import Data.Monoid #endif  spec :: Spec

@@ -0,0 +1,7 @@+module Main (main) where++import Test.Hspec.Runner+import Spec (spec)++main :: IO ()+main = hspecWith defaultConfig { configQuickCheckMaxSuccess = Just 1000 } spec

@@ -1,1 +1,1 @@-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}

@@ -9,7 +9,6 @@ -- -- Utility functions for testing Megaparsec parsers with Hspec. -{-# LANGUAGE CPP                 #-} {-# LANGUAGE FlexibleContexts    #-} {-# LANGUAGE RankNTypes          #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -166,9 +165,7 @@ initialState s = State   { stateInput           = s   , statePos             = initialPos "" :| []-#if MIN_VERSION_megaparsec(5,2,0)   , stateTokensProcessed = 0-#endif   , stateTabWidth        = defaultTabWidth }  ----------------------------------------------------------------------------

@@ -7,7 +7,6 @@ import Data.Char (isControl, isSpace) import Data.List (isInfixOf, isSuffixOf) import Data.List.NonEmpty (NonEmpty (..))-import Data.Monoid import Data.Void import Data.Word (Word8) import Test.Hspec@@ -26,6 +25,9 @@ import Prelude hiding (all) #else import Control.Exception (Exception (..))+#endif+#if !MIN_VERSION_base(4,11,0)+import Data.Monoid #endif  type PE = ParseError Char Void

@@ -1,10 +1,10 @@+{-# LANGUAGE CPP        #-} {-# LANGUAGE MultiWayIf #-}  module Text.Megaparsec.PermSpec (spec) where  import Control.Applicative import Data.List (nub, elemIndices)-import Data.Monoid import Test.Hspec import Test.Hspec.Megaparsec import Test.Hspec.Megaparsec.AdHoc@@ -12,6 +12,10 @@ import Text.Megaparsec.Char import Text.Megaparsec.Char.Lexer (decimal) import Text.Megaparsec.Perm++#if !MIN_VERSION_base(4,11,0)+import Data.Monoid+#endif  data CharRows = CharRows   { getChars :: (Char, Char, Char)