{-# LANGUAGE Rank2Types #-}

-- | 'ParserT' is the core monad transformer for parsing.
module SimpleParser.Parser
  ( ParserT (..)
  , Parser
  , runParser
  , pureParser
  , bindParser
  , failParser
  , liftParser
  , hoistParser
  , catchJustParser
  , throwParser
  , catchParser
  , emptyParser
  , orParser
  , greedyStarParser
  , greedyStarParser_
  , greedyPlusParser
  , greedyPlusParser_
  , defaultParser
  , optionalParser
  , reflectParser
  , silenceParser
  , lookAheadParser
  , markParser
  , markWithStateParser
  , markWithOptStateParser
  , unmarkParser
  , commitParser
  , onEmptyParser
  ) where

import Control.Applicative (Alternative (..), liftA2)
import Control.Monad (MonadPlus (..), ap, (>=>))
import Control.Monad.Except (MonadError (..))
import Control.Monad.Identity (Identity (..))
import Control.Monad.Morph (MFunctor (..))
import Control.Monad.State (MonadState (..))
import Control.Monad.Trans (MonadTrans (..))
import Data.Bifunctor (first)
import Data.Sequence (Seq (..))
import Data.Sequence.NonEmpty ((><|))
import qualified Data.Sequence.NonEmpty as NESeq
import Data.Text (Text)
import qualified Data.Text as T
import SimpleParser.Chunked (Chunked (..))
import SimpleParser.Result (CompoundError (..), Mark (..), ParseError (..), ParseResult (..), ParseSuccess (..),
                            markParseError, parseErrorResume, unmarkParseError)
import SimpleParser.Stack (emptyStack)

-- | A 'ParserT' is a state/error/list transformer useful for parsing.
-- All MTL instances are for this transformer only. If, for example, your effect
-- has its own 'MonadState' instance, you'll have to use 'lift get' instead of 'get'.
newtype ParserT l s e m a = ParserT { ParserT l s e m a -> s -> m (Maybe (ParseResult l s e a))
runParserT :: s -> m (Maybe (ParseResult l s e a)) }
  deriving (a -> ParserT l s e m b -> ParserT l s e m a
(a -> b) -> ParserT l s e m a -> ParserT l s e m b
(forall a b. (a -> b) -> ParserT l s e m a -> ParserT l s e m b)
-> (forall a b. a -> ParserT l s e m b -> ParserT l s e m a)
-> Functor (ParserT l s e m)
forall a b. a -> ParserT l s e m b -> ParserT l s e m a
forall a b. (a -> b) -> ParserT l s e m a -> ParserT l s e m b
forall l s e (m :: * -> *) a b.
Functor m =>
a -> ParserT l s e m b -> ParserT l s e m a
forall l s e (m :: * -> *) a b.
Functor m =>
(a -> b) -> ParserT l s e m a -> ParserT l s e m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ParserT l s e m b -> ParserT l s e m a
$c<$ :: forall l s e (m :: * -> *) a b.
Functor m =>
a -> ParserT l s e m b -> ParserT l s e m a
fmap :: (a -> b) -> ParserT l s e m a -> ParserT l s e m b
$cfmap :: forall l s e (m :: * -> *) a b.
Functor m =>
(a -> b) -> ParserT l s e m a -> ParserT l s e m b
Functor)

-- | Use 'Parser' if you have no need for other monadic effects.
type Parser l s e a = ParserT l s e Identity a

-- | Runs a non-effectful parser from an inital state and collects all results.
runParser :: Parser l s e a -> s -> Maybe (ParseResult l s e a)
runParser :: Parser l s e a -> s -> Maybe (ParseResult l s e a)
runParser Parser l s e a
parser s
s = Identity (Maybe (ParseResult l s e a))
-> Maybe (ParseResult l s e a)
forall a. Identity a -> a
runIdentity (Parser l s e a -> s -> Identity (Maybe (ParseResult l s e a))
forall l s e (m :: * -> *) a.
ParserT l s e m a -> s -> m (Maybe (ParseResult l s e a))
runParserT Parser l s e a
parser s
s)

-- | Applicative pure
pureParser :: Monad m => a -> ParserT l s e m a
pureParser :: a -> ParserT l s e m a
pureParser a
a = (s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
forall l s e (m :: * -> *) a.
(s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
ParserT (\s
s -> Maybe (ParseResult l s e a) -> m (Maybe (ParseResult l s e a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseResult l s e a -> Maybe (ParseResult l s e a)
forall a. a -> Maybe a
Just (ParseSuccess s a -> ParseResult l s e a
forall l s e a. ParseSuccess s a -> ParseResult l s e a
ParseResultSuccess (s -> a -> ParseSuccess s a
forall s a. s -> a -> ParseSuccess s a
ParseSuccess s
s a
a))))

instance Monad m => Applicative (ParserT l s e m) where
  pure :: a -> ParserT l s e m a
pure = a -> ParserT l s e m a
forall (m :: * -> *) a l s e. Monad m => a -> ParserT l s e m a
pureParser
  <*> :: ParserT l s e m (a -> b) -> ParserT l s e m a -> ParserT l s e m b
(<*>) = ParserT l s e m (a -> b) -> ParserT l s e m a -> ParserT l s e m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

-- | Monadic bind
bindParser :: Monad m => ParserT l s e m a -> (a -> ParserT l s e m b) -> ParserT l s e m b
bindParser :: ParserT l s e m a -> (a -> ParserT l s e m b) -> ParserT l s e m b
bindParser ParserT l s e m a
parser a -> ParserT l s e m b
f = (s -> m (Maybe (ParseResult l s e b))) -> ParserT l s e m b
forall l s e (m :: * -> *) a.
(s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
ParserT (ParserT l s e m a -> s -> m (Maybe (ParseResult l s e a))
forall l s e (m :: * -> *) a.
ParserT l s e m a -> s -> m (Maybe (ParseResult l s e a))
runParserT ParserT l s e m a
parser (s -> m (Maybe (ParseResult l s e a)))
-> (Maybe (ParseResult l s e a) -> m (Maybe (ParseResult l s e b)))
-> s
-> m (Maybe (ParseResult l s e b))
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Maybe (ParseResult l s e a) -> m (Maybe (ParseResult l s e b))
go) where
  go :: Maybe (ParseResult l s e a) -> m (Maybe (ParseResult l s e b))
go Maybe (ParseResult l s e a)
mres =
    case Maybe (ParseResult l s e a)
mres of
      Maybe (ParseResult l s e a)
Nothing -> Maybe (ParseResult l s e b) -> m (Maybe (ParseResult l s e b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ParseResult l s e b)
forall a. Maybe a
Nothing
      Just ParseResult l s e a
res ->
          case ParseResult l s e a
res of
            ParseResultError NESeq (ParseError l s e)
errs -> Maybe (ParseResult l s e b) -> m (Maybe (ParseResult l s e b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseResult l s e b -> Maybe (ParseResult l s e b)
forall a. a -> Maybe a
Just (NESeq (ParseError l s e) -> ParseResult l s e b
forall l s e a. NESeq (ParseError l s e) -> ParseResult l s e a
ParseResultError NESeq (ParseError l s e)
errs))
            ParseResultSuccess (ParseSuccess s
t a
a) -> ParserT l s e m b -> s -> m (Maybe (ParseResult l s e b))
forall l s e (m :: * -> *) a.
ParserT l s e m a -> s -> m (Maybe (ParseResult l s e a))
runParserT (a -> ParserT l s e m b
f a
a) s
t

instance Monad m => Monad (ParserT l s e m) where
  return :: a -> ParserT l s e m a
return = a -> ParserT l s e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  >>= :: ParserT l s e m a -> (a -> ParserT l s e m b) -> ParserT l s e m b
(>>=) = ParserT l s e m a -> (a -> ParserT l s e m b) -> ParserT l s e m b
forall (m :: * -> *) l s e a b.
Monad m =>
ParserT l s e m a -> (a -> ParserT l s e m b) -> ParserT l s e m b
bindParser

-- | The empty parser
emptyParser :: Monad m => ParserT l s e m a
emptyParser :: ParserT l s e m a
emptyParser = (s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
forall l s e (m :: * -> *) a.
(s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
ParserT (m (Maybe (ParseResult l s e a))
-> s -> m (Maybe (ParseResult l s e a))
forall a b. a -> b -> a
const (Maybe (ParseResult l s e a) -> m (Maybe (ParseResult l s e a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ParseResult l s e a)
forall a. Maybe a
Nothing))

-- | Yields from the first parser of the two that returns a successfull result.
-- Otherwise will merge and yield all errors.
orParser :: Monad m => ParserT l s e m a -> ParserT l s e m a -> ParserT l s e m a
orParser :: ParserT l s e m a -> ParserT l s e m a -> ParserT l s e m a
orParser ParserT l s e m a
one ParserT l s e m a
two = (s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
forall l s e (m :: * -> *) a.
(s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
ParserT (\s
s -> ParserT l s e m a -> s -> m (Maybe (ParseResult l s e a))
forall l s e (m :: * -> *) a.
ParserT l s e m a -> s -> m (Maybe (ParseResult l s e a))
runParserT ParserT l s e m a
one s
s m (Maybe (ParseResult l s e a))
-> (Maybe (ParseResult l s e a) -> m (Maybe (ParseResult l s e a)))
-> m (Maybe (ParseResult l s e a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> Maybe (ParseResult l s e a) -> m (Maybe (ParseResult l s e a))
go1 s
s) where
  go1 :: s -> Maybe (ParseResult l s e a) -> m (Maybe (ParseResult l s e a))
go1 s
s Maybe (ParseResult l s e a)
mres1 =
    case Maybe (ParseResult l s e a)
mres1 of
      Maybe (ParseResult l s e a)
Nothing -> ParserT l s e m a -> s -> m (Maybe (ParseResult l s e a))
forall l s e (m :: * -> *) a.
ParserT l s e m a -> s -> m (Maybe (ParseResult l s e a))
runParserT ParserT l s e m a
two s
s m (Maybe (ParseResult l s e a))
-> (Maybe (ParseResult l s e a) -> m (Maybe (ParseResult l s e a)))
-> m (Maybe (ParseResult l s e a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Seq (ParseError l s e)
-> Maybe (ParseResult l s e a) -> m (Maybe (ParseResult l s e a))
forall (f :: * -> *) l s e a.
Applicative f =>
Seq (ParseError l s e)
-> Maybe (ParseResult l s e a) -> f (Maybe (ParseResult l s e a))
go2 Seq (ParseError l s e)
forall (f :: * -> *) a. Alternative f => f a
empty
      Just ParseResult l s e a
res1 ->
        case ParseResult l s e a
res1 of
          ParseResultSuccess ParseSuccess s a
_ -> Maybe (ParseResult l s e a) -> m (Maybe (ParseResult l s e a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ParseResult l s e a)
mres1
          ParseResultError NESeq (ParseError l s e)
es1 -> ParserT l s e m a -> s -> m (Maybe (ParseResult l s e a))
forall l s e (m :: * -> *) a.
ParserT l s e m a -> s -> m (Maybe (ParseResult l s e a))
runParserT ParserT l s e m a
two s
s m (Maybe (ParseResult l s e a))
-> (Maybe (ParseResult l s e a) -> m (Maybe (ParseResult l s e a)))
-> m (Maybe (ParseResult l s e a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Seq (ParseError l s e)
-> Maybe (ParseResult l s e a) -> m (Maybe (ParseResult l s e a))
forall (f :: * -> *) l s e a.
Applicative f =>
Seq (ParseError l s e)
-> Maybe (ParseResult l s e a) -> f (Maybe (ParseResult l s e a))
go2 (NESeq (ParseError l s e) -> Seq (ParseError l s e)
forall a. NESeq a -> Seq a
NESeq.toSeq NESeq (ParseError l s e)
es1)

  go2 :: Seq (ParseError l s e)
-> Maybe (ParseResult l s e a) -> f (Maybe (ParseResult l s e a))
go2 Seq (ParseError l s e)
es1 Maybe (ParseResult l s e a)
mres2 =
    case Maybe (ParseResult l s e a)
mres2 of
      Maybe (ParseResult l s e a)
Nothing -> Maybe (ParseResult l s e a) -> f (Maybe (ParseResult l s e a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((NESeq (ParseError l s e) -> ParseResult l s e a)
-> Maybe (NESeq (ParseError l s e)) -> Maybe (ParseResult l s e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NESeq (ParseError l s e) -> ParseResult l s e a
forall l s e a. NESeq (ParseError l s e) -> ParseResult l s e a
ParseResultError (Seq (ParseError l s e) -> Maybe (NESeq (ParseError l s e))
forall a. Seq a -> Maybe (NESeq a)
NESeq.nonEmptySeq Seq (ParseError l s e)
es1))
      Just ParseResult l s e a
res2 ->
        case ParseResult l s e a
res2 of
          ParseResultSuccess ParseSuccess s a
_ -> Maybe (ParseResult l s e a) -> f (Maybe (ParseResult l s e a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ParseResult l s e a)
mres2
          ParseResultError NESeq (ParseError l s e)
es2 -> Maybe (ParseResult l s e a) -> f (Maybe (ParseResult l s e a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseResult l s e a -> Maybe (ParseResult l s e a)
forall a. a -> Maybe a
Just (NESeq (ParseError l s e) -> ParseResult l s e a
forall l s e a. NESeq (ParseError l s e) -> ParseResult l s e a
ParseResultError (Seq (ParseError l s e)
es1 Seq (ParseError l s e)
-> NESeq (ParseError l s e) -> NESeq (ParseError l s e)
forall a. Seq a -> NESeq a -> NESeq a
><| NESeq (ParseError l s e)
es2)))

-- | Yields the LONGEST string of 0 or more successes of the given parser.
-- Failures will be silenced.
greedyStarParser :: (Chunked seq elem, Monad m) => ParserT l s e m elem -> ParserT l s e m seq
greedyStarParser :: ParserT l s e m elem -> ParserT l s e m seq
greedyStarParser ParserT l s e m elem
parser = [elem] -> ParserT l s e m seq
go [] where
  opt :: ParserT l s e m (Maybe elem)
opt = ParserT l s e m elem -> ParserT l s e m (Maybe elem)
forall (m :: * -> *) l s e a.
Monad m =>
ParserT l s e m a -> ParserT l s e m (Maybe a)
optionalParser ParserT l s e m elem
parser
  go :: [elem] -> ParserT l s e m seq
go ![elem]
acc = do
    Maybe elem
res <- ParserT l s e m (Maybe elem)
opt
    case Maybe elem
res of
      Maybe elem
Nothing -> seq -> ParserT l s e m seq
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([elem] -> seq
forall chunk token. Chunked chunk token => [token] -> chunk
revTokensToChunk [elem]
acc)
      Just elem
a -> [elem] -> ParserT l s e m seq
go (elem -> [elem] -> [elem]
forall chunk token. Chunked chunk token => token -> chunk -> chunk
consChunk elem
a [elem]
acc)

-- | Same as 'greedyStarParser' but discards the result.
greedyStarParser_ :: Monad m => ParserT l s e m a -> ParserT l s e m ()
greedyStarParser_ :: ParserT l s e m a -> ParserT l s e m ()
greedyStarParser_ ParserT l s e m a
parser = ParserT l s e m ()
go where
  opt :: ParserT l s e m (Maybe a)
opt = ParserT l s e m a -> ParserT l s e m (Maybe a)
forall (m :: * -> *) l s e a.
Monad m =>
ParserT l s e m a -> ParserT l s e m (Maybe a)
optionalParser ParserT l s e m a
parser
  go :: ParserT l s e m ()
go = do
    Maybe a
res <- ParserT l s e m (Maybe a)
opt
    case Maybe a
res of
      Maybe a
Nothing -> () -> ParserT l s e m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just a
_ -> ParserT l s e m ()
go

-- | Yields the LONGEST string of 1 or more successes of the given parser.
-- Failures in the tail will be silenced, but those in the head will be returned.
greedyPlusParser :: (Chunked seq elem, Monad m) => ParserT l s e m elem -> ParserT l s e m seq
greedyPlusParser :: ParserT l s e m elem -> ParserT l s e m seq
greedyPlusParser ParserT l s e m elem
parser = (elem -> seq -> seq)
-> ParserT l s e m elem
-> ParserT l s e m seq
-> ParserT l s e m seq
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 elem -> seq -> seq
forall chunk token. Chunked chunk token => token -> chunk -> chunk
consChunk ParserT l s e m elem
parser (ParserT l s e m elem -> ParserT l s e m seq
forall seq elem (m :: * -> *) l s e.
(Chunked seq elem, Monad m) =>
ParserT l s e m elem -> ParserT l s e m seq
greedyStarParser ParserT l s e m elem
parser)

-- | Same as 'greedyPlusParser' but discards the result.
greedyPlusParser_ :: Monad m => ParserT l s e m a -> ParserT l s e m ()
greedyPlusParser_ :: ParserT l s e m a -> ParserT l s e m ()
greedyPlusParser_ ParserT l s e m a
parser = ParserT l s e m a
parser ParserT l s e m a -> ParserT l s e m () -> ParserT l s e m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT l s e m a -> ParserT l s e m ()
forall (m :: * -> *) l s e a.
Monad m =>
ParserT l s e m a -> ParserT l s e m ()
greedyStarParser_ ParserT l s e m a
parser

instance Monad m => Alternative (ParserT l s e m) where
  empty :: ParserT l s e m a
empty = ParserT l s e m a
forall (m :: * -> *) l s e a. Monad m => ParserT l s e m a
emptyParser
  <|> :: ParserT l s e m a -> ParserT l s e m a -> ParserT l s e m a
(<|>) = ParserT l s e m a -> ParserT l s e m a -> ParserT l s e m a
forall (m :: * -> *) l s e a.
Monad m =>
ParserT l s e m a -> ParserT l s e m a -> ParserT l s e m a
orParser
  some :: ParserT l s e m a -> ParserT l s e m [a]
some = ParserT l s e m a -> ParserT l s e m [a]
forall seq elem (m :: * -> *) l s e.
(Chunked seq elem, Monad m) =>
ParserT l s e m elem -> ParserT l s e m seq
greedyPlusParser
  many :: ParserT l s e m a -> ParserT l s e m [a]
many = ParserT l s e m a -> ParserT l s e m [a]
forall seq elem (m :: * -> *) l s e.
(Chunked seq elem, Monad m) =>
ParserT l s e m elem -> ParserT l s e m seq
greedyStarParser

instance Monad m => MonadPlus (ParserT l s e m) where
  mzero :: ParserT l s e m a
mzero = ParserT l s e m a
forall (f :: * -> *) a. Alternative f => f a
empty
  mplus :: ParserT l s e m a -> ParserT l s e m a -> ParserT l s e m a
mplus = ParserT l s e m a -> ParserT l s e m a -> ParserT l s e m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

instance Monad m => MonadState s (ParserT l s e m) where
  get :: ParserT l s e m s
get = (s -> m (Maybe (ParseResult l s e s))) -> ParserT l s e m s
forall l s e (m :: * -> *) a.
(s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
ParserT (\s
s -> Maybe (ParseResult l s e s) -> m (Maybe (ParseResult l s e s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseResult l s e s -> Maybe (ParseResult l s e s)
forall a. a -> Maybe a
Just (ParseSuccess s s -> ParseResult l s e s
forall l s e a. ParseSuccess s a -> ParseResult l s e a
ParseResultSuccess (s -> s -> ParseSuccess s s
forall s a. s -> a -> ParseSuccess s a
ParseSuccess s
s s
s))))
  put :: s -> ParserT l s e m ()
put s
t = (s -> m (Maybe (ParseResult l s e ()))) -> ParserT l s e m ()
forall l s e (m :: * -> *) a.
(s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
ParserT (\s
_ -> Maybe (ParseResult l s e ()) -> m (Maybe (ParseResult l s e ()))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseResult l s e () -> Maybe (ParseResult l s e ())
forall a. a -> Maybe a
Just (ParseSuccess s () -> ParseResult l s e ()
forall l s e a. ParseSuccess s a -> ParseResult l s e a
ParseResultSuccess (s -> () -> ParseSuccess s ()
forall s a. s -> a -> ParseSuccess s a
ParseSuccess s
t ()))))
  state :: (s -> (a, s)) -> ParserT l s e m a
state s -> (a, s)
f = (s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
forall l s e (m :: * -> *) a.
(s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
ParserT (\s
s -> let (!a
a, !s
t) = s -> (a, s)
f s
s in Maybe (ParseResult l s e a) -> m (Maybe (ParseResult l s e a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseResult l s e a -> Maybe (ParseResult l s e a)
forall a. a -> Maybe a
Just (ParseSuccess s a -> ParseResult l s e a
forall l s e a. ParseSuccess s a -> ParseResult l s e a
ParseResultSuccess (s -> a -> ParseSuccess s a
forall s a. s -> a -> ParseSuccess s a
ParseSuccess s
t a
a))))

-- | Catch only a subset of custom errors. This preserves label information vs rethrowing.
catchJustParser :: Monad m => (e -> Maybe b) -> ParserT l s e m a -> (b -> ParserT l s e m a) -> ParserT l s e m a
catchJustParser :: (e -> Maybe b)
-> ParserT l s e m a
-> (b -> ParserT l s e m a)
-> ParserT l s e m a
catchJustParser e -> Maybe b
filterer ParserT l s e m a
parser b -> ParserT l s e m a
handler = (s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
forall l s e (m :: * -> *) a.
(s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
ParserT (\s
s0 -> ParserT l s e m a -> s -> m (Maybe (ParseResult l s e a))
forall l s e (m :: * -> *) a.
ParserT l s e m a -> s -> m (Maybe (ParseResult l s e a))
runParserT ParserT l s e m a
parser s
s0 m (Maybe (ParseResult l s e a))
-> (Maybe (ParseResult l s e a) -> m (Maybe (ParseResult l s e a)))
-> m (Maybe (ParseResult l s e a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> Maybe (ParseResult l s e a) -> m (Maybe (ParseResult l s e a))
go s
s0) where
    go :: s -> Maybe (ParseResult l s e a) -> m (Maybe (ParseResult l s e a))
go s
s0 Maybe (ParseResult l s e a)
mres =
      case Maybe (ParseResult l s e a)
mres of
        Maybe (ParseResult l s e a)
Nothing -> Maybe (ParseResult l s e a) -> m (Maybe (ParseResult l s e a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ParseResult l s e a)
forall a. Maybe a
Nothing
        Just ParseResult l s e a
res ->
          case ParseResult l s e a
res of
            ParseResultSuccess ParseSuccess s a
_ ->
              -- Nothing to catch, yield existing success
              Maybe (ParseResult l s e a) -> m (Maybe (ParseResult l s e a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ParseResult l s e a)
mres
            ParseResultError NESeq (ParseError l s e)
es ->
              -- Find first custom error to handle
              s
-> Seq (ParseError l s e)
-> Seq (ParseError l s e)
-> m (Maybe (ParseResult l s e a))
goSplit s
s0 Seq (ParseError l s e)
forall a. Seq a
Empty (NESeq (ParseError l s e) -> Seq (ParseError l s e)
forall a. NESeq a -> Seq a
NESeq.toSeq NESeq (ParseError l s e)
es)

    goSplit :: s
-> Seq (ParseError l s e)
-> Seq (ParseError l s e)
-> m (Maybe (ParseResult l s e a))
goSplit s
s0 Seq (ParseError l s e)
beforeEs Seq (ParseError l s e)
afterEs =
      case (ParseError l s e -> Maybe (s, e))
-> Seq (ParseError l s e)
-> Maybe (SeqPartition (ParseError l s e) (s, e))
forall a b. (a -> Maybe b) -> Seq a -> Maybe (SeqPartition a b)
seqPartition ParseError l s e -> Maybe (s, e)
forall l s e. ParseError l s e -> Maybe (s, e)
extractCustomError Seq (ParseError l s e)
afterEs of
        Maybe (SeqPartition (ParseError l s e) (s, e))
Nothing ->
          -- No next custom error, finally yield all other errors
          Maybe (ParseResult l s e a) -> m (Maybe (ParseResult l s e a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ParseResult l s e a)
-> (NESeq (ParseError l s e) -> Maybe (ParseResult l s e a))
-> Maybe (NESeq (ParseError l s e))
-> Maybe (ParseResult l s e a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe (ParseResult l s e a)
forall (f :: * -> *) a. Alternative f => f a
empty (ParseResult l s e a -> Maybe (ParseResult l s e a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseResult l s e a -> Maybe (ParseResult l s e a))
-> (NESeq (ParseError l s e) -> ParseResult l s e a)
-> NESeq (ParseError l s e)
-> Maybe (ParseResult l s e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NESeq (ParseError l s e) -> ParseResult l s e a
forall l s e a. NESeq (ParseError l s e) -> ParseResult l s e a
ParseResultError) (Seq (ParseError l s e) -> Maybe (NESeq (ParseError l s e))
forall a. Seq a -> Maybe (NESeq a)
NESeq.nonEmptySeq (Seq (ParseError l s e)
beforeEs Seq (ParseError l s e)
-> Seq (ParseError l s e) -> Seq (ParseError l s e)
forall a. Semigroup a => a -> a -> a
<> Seq (ParseError l s e)
afterEs)))
        Just SeqPartition (ParseError l s e) (s, e)
sep ->
          -- Found custom error - handle it
          s
-> Seq (ParseError l s e)
-> SeqPartition (ParseError l s e) (s, e)
-> m (Maybe (ParseResult l s e a))
goHandle s
s0 Seq (ParseError l s e)
beforeEs SeqPartition (ParseError l s e) (s, e)
sep

    goHandle :: s
-> Seq (ParseError l s e)
-> SeqPartition (ParseError l s e) (s, e)
-> m (Maybe (ParseResult l s e a))
goHandle s
s0 Seq (ParseError l s e)
beforeEs (SeqPartition Seq (ParseError l s e)
nextBeforeEs ParseError l s e
targetE (s
_, e
e) Seq (ParseError l s e)
afterEs) =
      case e -> Maybe b
filterer e
e of
        Maybe b
Nothing ->
          -- Not handling error;  - find next custom error
          s
-> Seq (ParseError l s e)
-> Seq (ParseError l s e)
-> m (Maybe (ParseResult l s e a))
goSplit s
s0 (Seq (ParseError l s e)
beforeEs Seq (ParseError l s e)
-> Seq (ParseError l s e) -> Seq (ParseError l s e)
forall a. Semigroup a => a -> a -> a
<> (ParseError l s e
targetE ParseError l s e
-> Seq (ParseError l s e) -> Seq (ParseError l s e)
forall a. a -> Seq a -> Seq a
:<| Seq (ParseError l s e)
nextBeforeEs)) Seq (ParseError l s e)
afterEs
        Just b
b -> do
          -- NOTE(ejconlon) We resume parsing at the start state s0 (captured at catchError invocation)
          -- Is it reasonable to support parsing at the error state? (This is in the SeqPartition wildcard above)
          Maybe (ParseResult l s e a)
mres <- ParserT l s e m a -> s -> m (Maybe (ParseResult l s e a))
forall l s e (m :: * -> *) a.
ParserT l s e m a -> s -> m (Maybe (ParseResult l s e a))
runParserT (b -> ParserT l s e m a
handler b
b) s
s0
          case Maybe (ParseResult l s e a)
mres of
            Maybe (ParseResult l s e a)
Nothing ->
              -- No results from handled error - find next custom error
              s
-> Seq (ParseError l s e)
-> Seq (ParseError l s e)
-> m (Maybe (ParseResult l s e a))
goSplit s
s0 (Seq (ParseError l s e)
beforeEs Seq (ParseError l s e)
-> Seq (ParseError l s e) -> Seq (ParseError l s e)
forall a. Semigroup a => a -> a -> a
<> Seq (ParseError l s e)
nextBeforeEs) Seq (ParseError l s e)
afterEs
            Just ParseResult l s e a
res ->
              case ParseResult l s e a
res of
                ParseResultSuccess ParseSuccess s a
_ -> Maybe (ParseResult l s e a) -> m (Maybe (ParseResult l s e a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ParseResult l s e a)
mres
                ParseResultError NESeq (ParseError l s e)
es ->
                  -- Add to list of errors and find next custom error
                  s
-> Seq (ParseError l s e)
-> Seq (ParseError l s e)
-> m (Maybe (ParseResult l s e a))
goSplit s
s0 (Seq (ParseError l s e)
beforeEs Seq (ParseError l s e)
-> Seq (ParseError l s e) -> Seq (ParseError l s e)
forall a. Semigroup a => a -> a -> a
<> Seq (ParseError l s e)
nextBeforeEs Seq (ParseError l s e)
-> Seq (ParseError l s e) -> Seq (ParseError l s e)
forall a. Semigroup a => a -> a -> a
<> NESeq (ParseError l s e) -> Seq (ParseError l s e)
forall a. NESeq a -> Seq a
NESeq.toSeq NESeq (ParseError l s e)
es) Seq (ParseError l s e)
afterEs

-- | Throws a custom error
throwParser :: Monad m => e -> ParserT l s e m a
throwParser :: e -> ParserT l s e m a
throwParser e
e = (s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
forall l s e (m :: * -> *) a.
(s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
ParserT (\s
s -> Maybe (ParseResult l s e a) -> m (Maybe (ParseResult l s e a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseResult l s e a -> Maybe (ParseResult l s e a)
forall a. a -> Maybe a
Just (NESeq (ParseError l s e) -> ParseResult l s e a
forall l s e a. NESeq (ParseError l s e) -> ParseResult l s e a
ParseResultError (ParseError l s e -> NESeq (ParseError l s e)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MarkStack l s -> s -> CompoundError s e -> ParseError l s e
forall l s e.
MarkStack l s -> s -> CompoundError s e -> ParseError l s e
ParseError MarkStack l s
forall a. Stack a
emptyStack s
s (e -> CompoundError s e
forall s e. e -> CompoundError s e
CompoundErrorCustom e
e))))))

-- | Catches a custom error
catchParser :: Monad m => ParserT l s e m a -> (e -> ParserT l s e m a) -> ParserT l s e m a
catchParser :: ParserT l s e m a -> (e -> ParserT l s e m a) -> ParserT l s e m a
catchParser = (e -> Maybe e)
-> ParserT l s e m a
-> (e -> ParserT l s e m a)
-> ParserT l s e m a
forall (m :: * -> *) e b l s a.
Monad m =>
(e -> Maybe b)
-> ParserT l s e m a
-> (b -> ParserT l s e m a)
-> ParserT l s e m a
catchJustParser e -> Maybe e
forall a. a -> Maybe a
Just

instance Monad m => MonadError e (ParserT l s e m) where
  throwError :: e -> ParserT l s e m a
throwError = e -> ParserT l s e m a
forall (m :: * -> *) e l s a. Monad m => e -> ParserT l s e m a
throwParser
  catchError :: ParserT l s e m a -> (e -> ParserT l s e m a) -> ParserT l s e m a
catchError = (e -> Maybe e)
-> ParserT l s e m a
-> (e -> ParserT l s e m a)
-> ParserT l s e m a
forall (m :: * -> *) e b l s a.
Monad m =>
(e -> Maybe b)
-> ParserT l s e m a
-> (b -> ParserT l s e m a)
-> ParserT l s e m a
catchJustParser e -> Maybe e
forall a. a -> Maybe a
Just

-- | A simple failing parser
failParser :: Monad m => Text -> ParserT l s e m a
failParser :: Text -> ParserT l s e m a
failParser Text
msg = (s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
forall l s e (m :: * -> *) a.
(s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
ParserT (\s
s -> Maybe (ParseResult l s e a) -> m (Maybe (ParseResult l s e a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseResult l s e a -> Maybe (ParseResult l s e a)
forall a. a -> Maybe a
Just (NESeq (ParseError l s e) -> ParseResult l s e a
forall l s e a. NESeq (ParseError l s e) -> ParseResult l s e a
ParseResultError (ParseError l s e -> NESeq (ParseError l s e)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MarkStack l s -> s -> CompoundError s e -> ParseError l s e
forall l s e.
MarkStack l s -> s -> CompoundError s e -> ParseError l s e
ParseError MarkStack l s
forall a. Stack a
emptyStack s
s (Text -> CompoundError s e
forall s e. Text -> CompoundError s e
CompoundErrorFail Text
msg))))))

instance Monad m => MonadFail (ParserT l s e m) where
  fail :: String -> ParserT l s e m a
fail = Text -> ParserT l s e m a
forall (m :: * -> *) l s e a. Monad m => Text -> ParserT l s e m a
failParser (Text -> ParserT l s e m a)
-> (String -> Text) -> String -> ParserT l s e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

liftParser :: Monad m => m a -> ParserT l s e m a
liftParser :: m a -> ParserT l s e m a
liftParser m a
ma = (s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
forall l s e (m :: * -> *) a.
(s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
ParserT (\s
s -> (a -> Maybe (ParseResult l s e a))
-> m a -> m (Maybe (ParseResult l s e a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ParseResult l s e a -> Maybe (ParseResult l s e a)
forall a. a -> Maybe a
Just (ParseResult l s e a -> Maybe (ParseResult l s e a))
-> (a -> ParseResult l s e a) -> a -> Maybe (ParseResult l s e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseSuccess s a -> ParseResult l s e a
forall l s e a. ParseSuccess s a -> ParseResult l s e a
ParseResultSuccess (ParseSuccess s a -> ParseResult l s e a)
-> (a -> ParseSuccess s a) -> a -> ParseResult l s e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> a -> ParseSuccess s a
forall s a. s -> a -> ParseSuccess s a
ParseSuccess s
s) m a
ma)

instance MonadTrans (ParserT l s e) where
  lift :: m a -> ParserT l s e m a
lift = m a -> ParserT l s e m a
forall (m :: * -> *) a l s e. Monad m => m a -> ParserT l s e m a
liftParser

hoistParser :: (forall x. m x -> n x) -> ParserT l s e m a -> ParserT l s e n a
hoistParser :: (forall x. m x -> n x) -> ParserT l s e m a -> ParserT l s e n a
hoistParser forall x. m x -> n x
trans (ParserT s -> m (Maybe (ParseResult l s e a))
f) = (s -> n (Maybe (ParseResult l s e a))) -> ParserT l s e n a
forall l s e (m :: * -> *) a.
(s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
ParserT (m (Maybe (ParseResult l s e a)) -> n (Maybe (ParseResult l s e a))
forall x. m x -> n x
trans (m (Maybe (ParseResult l s e a))
 -> n (Maybe (ParseResult l s e a)))
-> (s -> m (Maybe (ParseResult l s e a)))
-> s
-> n (Maybe (ParseResult l s e a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m (Maybe (ParseResult l s e a))
f)

instance MFunctor (ParserT l s e) where
  hoist :: (forall a. m a -> n a) -> ParserT l s e m b -> ParserT l s e n b
hoist = (forall a. m a -> n a) -> ParserT l s e m b -> ParserT l s e n b
forall (m :: * -> *) (n :: * -> *) l s e a.
(forall x. m x -> n x) -> ParserT l s e m a -> ParserT l s e n a
hoistParser

-- | If the parser does not succeed, yield the given value.
defaultParser :: Monad m => a -> ParserT l s e m a -> ParserT l s e m a
defaultParser :: a -> ParserT l s e m a -> ParserT l s e m a
defaultParser a
val ParserT l s e m a
parser = ParserT l s e m a -> ParserT l s e m a -> ParserT l s e m a
forall (m :: * -> *) l s e a.
Monad m =>
ParserT l s e m a -> ParserT l s e m a -> ParserT l s e m a
orParser ParserT l s e m a
parser (a -> ParserT l s e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
val)

-- | A parser that yields 'Nothing' if the parser does not succeed, otherwise
-- wraps success in 'Just'.
optionalParser :: Monad m => ParserT l s e m a -> ParserT l s e m (Maybe a)
optionalParser :: ParserT l s e m a -> ParserT l s e m (Maybe a)
optionalParser ParserT l s e m a
parser = Maybe a -> ParserT l s e m (Maybe a) -> ParserT l s e m (Maybe a)
forall (m :: * -> *) a l s e.
Monad m =>
a -> ParserT l s e m a -> ParserT l s e m a
defaultParser Maybe a
forall a. Maybe a
Nothing ((a -> Maybe a) -> ParserT l s e m a -> ParserT l s e m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just ParserT l s e m a
parser)

-- | Run the parser speculatively and return results. Does not advance state or throw errors.
reflectParser :: Monad m => ParserT l s e m a -> ParserT l s e m (Maybe (ParseResult l s e a))
reflectParser :: ParserT l s e m a -> ParserT l s e m (Maybe (ParseResult l s e a))
reflectParser ParserT l s e m a
parser = (s -> m (Maybe (ParseResult l s e (Maybe (ParseResult l s e a)))))
-> ParserT l s e m (Maybe (ParseResult l s e a))
forall l s e (m :: * -> *) a.
(s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
ParserT s -> m (Maybe (ParseResult l s e (Maybe (ParseResult l s e a))))
go where
  go :: s -> m (Maybe (ParseResult l s e (Maybe (ParseResult l s e a))))
go s
s = do
    Maybe (ParseResult l s e a)
mres <- ParserT l s e m a -> s -> m (Maybe (ParseResult l s e a))
forall l s e (m :: * -> *) a.
ParserT l s e m a -> s -> m (Maybe (ParseResult l s e a))
runParserT ParserT l s e m a
parser s
s
    Maybe (ParseResult l s e (Maybe (ParseResult l s e a)))
-> m (Maybe (ParseResult l s e (Maybe (ParseResult l s e a))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseResult l s e (Maybe (ParseResult l s e a))
-> Maybe (ParseResult l s e (Maybe (ParseResult l s e a)))
forall a. a -> Maybe a
Just (ParseSuccess s (Maybe (ParseResult l s e a))
-> ParseResult l s e (Maybe (ParseResult l s e a))
forall l s e a. ParseSuccess s a -> ParseResult l s e a
ParseResultSuccess (s
-> Maybe (ParseResult l s e a)
-> ParseSuccess s (Maybe (ParseResult l s e a))
forall s a. s -> a -> ParseSuccess s a
ParseSuccess s
s Maybe (ParseResult l s e a)
mres)))

-- | Removes all failures from the parse results. Catches more errors than 'catchError (const empty)'
-- because this includes stream errors, not just custom errors.
-- If you want more fine-grained control, use 'reflectParser' and map over the results.
silenceParser :: Monad m => ParserT l s e m a -> ParserT l s e m a
silenceParser :: ParserT l s e m a -> ParserT l s e m a
silenceParser ParserT l s e m a
parser = (s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
forall l s e (m :: * -> *) a.
(s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
ParserT ((Maybe (ParseResult l s e a) -> Maybe (ParseResult l s e a))
-> m (Maybe (ParseResult l s e a))
-> m (Maybe (ParseResult l s e a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (ParseResult l s e a) -> Maybe (ParseResult l s e a)
forall l s e a.
Maybe (ParseResult l s e a) -> Maybe (ParseResult l s e a)
go (m (Maybe (ParseResult l s e a))
 -> m (Maybe (ParseResult l s e a)))
-> (s -> m (Maybe (ParseResult l s e a)))
-> s
-> m (Maybe (ParseResult l s e a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserT l s e m a -> s -> m (Maybe (ParseResult l s e a))
forall l s e (m :: * -> *) a.
ParserT l s e m a -> s -> m (Maybe (ParseResult l s e a))
runParserT ParserT l s e m a
parser) where
  go :: Maybe (ParseResult l s e a) -> Maybe (ParseResult l s e a)
go Maybe (ParseResult l s e a)
mres =
    case Maybe (ParseResult l s e a)
mres of
      Just (ParseResultSuccess ParseSuccess s a
_) -> Maybe (ParseResult l s e a)
mres
      Maybe (ParseResult l s e a)
_ -> Maybe (ParseResult l s e a)
forall a. Maybe a
Nothing

-- | Yield the results of the given parser, but rewind back to the starting state.
-- Note that these results may contain errors, so you may want to stifle them with 'silenceParser', for example.
lookAheadParser :: Monad m => ParserT l s e m a -> ParserT l s e m a
lookAheadParser :: ParserT l s e m a -> ParserT l s e m a
lookAheadParser ParserT l s e m a
parser = (s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
forall l s e (m :: * -> *) a.
(s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
ParserT (\s
s -> (Maybe (ParseResult l s e a) -> Maybe (ParseResult l s e a))
-> m (Maybe (ParseResult l s e a))
-> m (Maybe (ParseResult l s e a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ParseResult l s e a -> ParseResult l s e a)
-> Maybe (ParseResult l s e a) -> Maybe (ParseResult l s e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (s -> ParseResult l s e a -> ParseResult l s e a
forall s l e a. s -> ParseResult l s e a -> ParseResult l s e a
go s
s)) (ParserT l s e m a -> s -> m (Maybe (ParseResult l s e a))
forall l s e (m :: * -> *) a.
ParserT l s e m a -> s -> m (Maybe (ParseResult l s e a))
runParserT ParserT l s e m a
parser s
s)) where
  go :: s -> ParseResult l s e a -> ParseResult l s e a
go s
s ParseResult l s e a
res =
    case ParseResult l s e a
res of
      ParseResultError NESeq (ParseError l s e)
es -> NESeq (ParseError l s e) -> ParseResult l s e a
forall l s e a. NESeq (ParseError l s e) -> ParseResult l s e a
ParseResultError NESeq (ParseError l s e)
es
      ParseResultSuccess (ParseSuccess s
_ a
a) -> ParseSuccess s a -> ParseResult l s e a
forall l s e a. ParseSuccess s a -> ParseResult l s e a
ParseResultSuccess (s -> a -> ParseSuccess s a
forall s a. s -> a -> ParseSuccess s a
ParseSuccess s
s a
a)

-- | Push the label and current state onto the parse error mark stack.
-- Useful to delimit named sub-spans for error reporting.
markParser :: Monad m => Maybe l -> ParserT l s e m a -> ParserT l s e m a
markParser :: Maybe l -> ParserT l s e m a -> ParserT l s e m a
markParser Maybe l
ml ParserT l s e m a
parser = (s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
forall l s e (m :: * -> *) a.
(s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
ParserT (\s
s -> (Maybe (ParseResult l s e a) -> Maybe (ParseResult l s e a))
-> m (Maybe (ParseResult l s e a))
-> m (Maybe (ParseResult l s e a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ParseResult l s e a -> ParseResult l s e a)
-> Maybe (ParseResult l s e a) -> Maybe (ParseResult l s e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (s -> ParseResult l s e a -> ParseResult l s e a
go s
s)) (ParserT l s e m a -> s -> m (Maybe (ParseResult l s e a))
forall l s e (m :: * -> *) a.
ParserT l s e m a -> s -> m (Maybe (ParseResult l s e a))
runParserT ParserT l s e m a
parser s
s)) where
  go :: s -> ParseResult l s e a -> ParseResult l s e a
go s
s ParseResult l s e a
res =
    case ParseResult l s e a
res of
      ParseResultError NESeq (ParseError l s e)
es -> NESeq (ParseError l s e) -> ParseResult l s e a
forall l s e a. NESeq (ParseError l s e) -> ParseResult l s e a
ParseResultError ((ParseError l s e -> ParseError l s e)
-> NESeq (ParseError l s e) -> NESeq (ParseError l s e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Mark l s -> ParseError l s e -> ParseError l s e
forall l s e. Mark l s -> ParseError l s e -> ParseError l s e
markParseError (Maybe l -> s -> Mark l s
forall l s. Maybe l -> s -> Mark l s
Mark Maybe l
ml s
s)) NESeq (ParseError l s e)
es)
      ParseResultSuccess ParseSuccess s a
_ -> ParseResult l s e a
res

-- | Like 'markParser' but allows you to mutate state. See 'withToken' and 'withChunk'.
markWithStateParser :: Monad m => Maybe l -> (s -> (b, s)) -> (b -> ParserT l s e m a) -> ParserT l s e m a
markWithStateParser :: Maybe l
-> (s -> (b, s)) -> (b -> ParserT l s e m a) -> ParserT l s e m a
markWithStateParser Maybe l
ml s -> (b, s)
g b -> ParserT l s e m a
f = Maybe l -> ParserT l s e m a -> ParserT l s e m a
forall (m :: * -> *) l s e a.
Monad m =>
Maybe l -> ParserT l s e m a -> ParserT l s e m a
markParser Maybe l
ml ((s -> (b, s)) -> ParserT l s e m b
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state s -> (b, s)
g ParserT l s e m b -> (b -> ParserT l s e m a) -> ParserT l s e m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> ParserT l s e m a
f)

-- | Like 'markParser' but allows you to mutate state. See 'withToken' and 'withChunk'.
markWithOptStateParser :: Monad m => Maybe l -> (s -> Maybe (b, s)) -> (Maybe b -> ParserT l s e m a) -> ParserT l s e m a
markWithOptStateParser :: Maybe l
-> (s -> Maybe (b, s))
-> (Maybe b -> ParserT l s e m a)
-> ParserT l s e m a
markWithOptStateParser Maybe l
ml s -> Maybe (b, s)
g = Maybe l
-> (s -> (Maybe b, s))
-> (Maybe b -> ParserT l s e m a)
-> ParserT l s e m a
forall (m :: * -> *) l s b e a.
Monad m =>
Maybe l
-> (s -> (b, s)) -> (b -> ParserT l s e m a) -> ParserT l s e m a
markWithStateParser Maybe l
ml (\s
s -> (Maybe b, s)
-> ((b, s) -> (Maybe b, s)) -> Maybe (b, s) -> (Maybe b, s)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe b
forall a. Maybe a
Nothing, s
s) ((b -> Maybe b) -> (b, s) -> (Maybe b, s)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first b -> Maybe b
forall a. a -> Maybe a
Just) (s -> Maybe (b, s)
g s
s))

-- | Clear marks from parse errors. You can mark immediately after to widen the narrowest
-- marked span to the range you want to report.
unmarkParser :: Monad m => ParserT l s e m a -> ParserT l s e m a
unmarkParser :: ParserT l s e m a -> ParserT l s e m a
unmarkParser ParserT l s e m a
parser = (s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
forall l s e (m :: * -> *) a.
(s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
ParserT ((Maybe (ParseResult l s e a) -> Maybe (ParseResult l s e a))
-> m (Maybe (ParseResult l s e a))
-> m (Maybe (ParseResult l s e a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ParseResult l s e a -> ParseResult l s e a)
-> Maybe (ParseResult l s e a) -> Maybe (ParseResult l s e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParseResult l s e a -> ParseResult l s e a
forall l s e a. ParseResult l s e a -> ParseResult l s e a
go) (m (Maybe (ParseResult l s e a))
 -> m (Maybe (ParseResult l s e a)))
-> (s -> m (Maybe (ParseResult l s e a)))
-> s
-> m (Maybe (ParseResult l s e a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserT l s e m a -> s -> m (Maybe (ParseResult l s e a))
forall l s e (m :: * -> *) a.
ParserT l s e m a -> s -> m (Maybe (ParseResult l s e a))
runParserT ParserT l s e m a
parser) where
  go :: ParseResult l s e a -> ParseResult l s e a
go ParseResult l s e a
res =
    case ParseResult l s e a
res of
      ParseResultError NESeq (ParseError l s e)
es -> NESeq (ParseError l s e) -> ParseResult l s e a
forall l s e a. NESeq (ParseError l s e) -> ParseResult l s e a
ParseResultError ((ParseError l s e -> ParseError l s e)
-> NESeq (ParseError l s e) -> NESeq (ParseError l s e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParseError l s e -> ParseError l s e
forall l s e. ParseError l s e -> ParseError l s e
unmarkParseError NESeq (ParseError l s e)
es)
      ParseResultSuccess ParseSuccess s a
_ -> ParseResult l s e a
res

-- | If the first parser succeeds in the initial state, yield results from the second parser in the initial
-- state. This is likely the look-ahead you want, since errors from the first parser are completely ignored.
-- Use the first parser to check a prefix of input, and use the second to consume that input.
commitParser :: Monad m => ParserT l s e m () -> ParserT l s e m a -> ParserT l s e m a
commitParser :: ParserT l s e m () -> ParserT l s e m a -> ParserT l s e m a
commitParser ParserT l s e m ()
checker ParserT l s e m a
parser = do
  s
s <- ParserT l s e m s
forall s (m :: * -> *). MonadState s m => m s
get
  Maybe ()
o <- ParserT l s e m () -> ParserT l s e m (Maybe ())
forall (m :: * -> *) l s e a.
Monad m =>
ParserT l s e m a -> ParserT l s e m (Maybe a)
optionalParser ParserT l s e m ()
checker
  case Maybe ()
o of
    Maybe ()
Nothing -> ParserT l s e m a
forall (f :: * -> *) a. Alternative f => f a
empty
    Just ()
_ -> s -> ParserT l s e m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put s
s ParserT l s e m () -> ParserT l s e m a -> ParserT l s e m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT l s e m a
parser

-- | If the first parser yields NO results (success or failure), yield from the second.
-- Note that this is different from 'orParser' in that it does not try the second if there
-- are errors in the first. You might use this on the outside of a complex parser with
-- a fallback to 'fail' to indicate that there are no matches.
onEmptyParser :: Parser l s e a -> Parser l s e a -> Parser l s e a
onEmptyParser :: Parser l s e a -> Parser l s e a -> Parser l s e a
onEmptyParser Parser l s e a
parser Parser l s e a
fallback = (s -> Identity (Maybe (ParseResult l s e a))) -> Parser l s e a
forall l s e (m :: * -> *) a.
(s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
ParserT (\s
s -> Parser l s e a -> s -> Identity (Maybe (ParseResult l s e a))
forall l s e (m :: * -> *) a.
ParserT l s e m a -> s -> m (Maybe (ParseResult l s e a))
runParserT Parser l s e a
parser s
s Identity (Maybe (ParseResult l s e a))
-> (Maybe (ParseResult l s e a)
    -> Identity (Maybe (ParseResult l s e a)))
-> Identity (Maybe (ParseResult l s e a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s
-> Maybe (ParseResult l s e a)
-> Identity (Maybe (ParseResult l s e a))
go s
s) where
  go :: s
-> Maybe (ParseResult l s e a)
-> Identity (Maybe (ParseResult l s e a))
go s
s Maybe (ParseResult l s e a)
mres =
    case Maybe (ParseResult l s e a)
mres of
      Maybe (ParseResult l s e a)
Nothing -> Parser l s e a -> s -> Identity (Maybe (ParseResult l s e a))
forall l s e (m :: * -> *) a.
ParserT l s e m a -> s -> m (Maybe (ParseResult l s e a))
runParserT Parser l s e a
fallback s
s
      Just ParseResult l s e a
_ -> Maybe (ParseResult l s e a)
-> Identity (Maybe (ParseResult l s e a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ParseResult l s e a)
mres

-- Private utility functions

data SeqPartition a b = SeqPartition
  { SeqPartition a b -> Seq a
spBefore :: !(Seq a)
  , SeqPartition a b -> a
spKey :: !a
  , SeqPartition a b -> b
spValue :: !b
  , SeqPartition a b -> Seq a
spAfter :: !(Seq a)
  } deriving (SeqPartition a b -> SeqPartition a b -> Bool
(SeqPartition a b -> SeqPartition a b -> Bool)
-> (SeqPartition a b -> SeqPartition a b -> Bool)
-> Eq (SeqPartition a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b.
(Eq a, Eq b) =>
SeqPartition a b -> SeqPartition a b -> Bool
/= :: SeqPartition a b -> SeqPartition a b -> Bool
$c/= :: forall a b.
(Eq a, Eq b) =>
SeqPartition a b -> SeqPartition a b -> Bool
== :: SeqPartition a b -> SeqPartition a b -> Bool
$c== :: forall a b.
(Eq a, Eq b) =>
SeqPartition a b -> SeqPartition a b -> Bool
Eq, Int -> SeqPartition a b -> ShowS
[SeqPartition a b] -> ShowS
SeqPartition a b -> String
(Int -> SeqPartition a b -> ShowS)
-> (SeqPartition a b -> String)
-> ([SeqPartition a b] -> ShowS)
-> Show (SeqPartition a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> SeqPartition a b -> ShowS
forall a b. (Show a, Show b) => [SeqPartition a b] -> ShowS
forall a b. (Show a, Show b) => SeqPartition a b -> String
showList :: [SeqPartition a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [SeqPartition a b] -> ShowS
show :: SeqPartition a b -> String
$cshow :: forall a b. (Show a, Show b) => SeqPartition a b -> String
showsPrec :: Int -> SeqPartition a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> SeqPartition a b -> ShowS
Show)

seqPartition :: (a -> Maybe b) -> Seq a -> Maybe (SeqPartition a b)
seqPartition :: (a -> Maybe b) -> Seq a -> Maybe (SeqPartition a b)
seqPartition a -> Maybe b
f = Seq a -> Seq a -> Maybe (SeqPartition a b)
go Seq a
forall a. Seq a
Empty where
  go :: Seq a -> Seq a -> Maybe (SeqPartition a b)
go Seq a
before Seq a
after =
    case Seq a
after of
      Seq a
Empty -> Maybe (SeqPartition a b)
forall a. Maybe a
Nothing
      (a
x :<| Seq a
xs) ->
        case a -> Maybe b
f a
x of
          Maybe b
Nothing -> Seq a -> Seq a -> Maybe (SeqPartition a b)
go (Seq a
before Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
:|> a
x) Seq a
xs
          Just b
y -> SeqPartition a b -> Maybe (SeqPartition a b)
forall a. a -> Maybe a
Just (Seq a -> a -> b -> Seq a -> SeqPartition a b
forall a b. Seq a -> a -> b -> Seq a -> SeqPartition a b
SeqPartition Seq a
before a
x b
y Seq a
xs)

extractCustomError :: ParseError l s e -> Maybe (s, e)
extractCustomError :: ParseError l s e -> Maybe (s, e)
extractCustomError pe :: ParseError l s e
pe@(ParseError MarkStack l s
_ s
_ CompoundError s e
ce) =
  case CompoundError s e
ce of
    CompoundErrorCustom e
e -> (s, e) -> Maybe (s, e)
forall a. a -> Maybe a
Just (ParseError l s e -> s
forall l s e. ParseError l s e -> s
parseErrorResume ParseError l s e
pe, e
e)
    CompoundError s e
_ -> Maybe (s, e)
forall a. Maybe a
Nothing