{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}

{-|
Module      : Hectoparsec.Primitive
Copyright   : (c) comp 2020
License     : MIT
Maintainer  : onecomputer00@gmail.com
Stability   : stable
Portability : portable

Primitive definitions and operations for parser combinators.
-}
module Hectoparsec.Primitive
    ( -- * Parser types
      ParserT(..)
    , Parser
    , ThenOk
    , ThenErr
    , Continuations
    , Reply(..)
    , makeParserT
    , contParserT
    ) where

import Control.Applicative
import Control.Monad
import Control.Monad.Cont.Class
import Control.Monad.Error.Class
import Control.Monad.IO.Class
import Control.Monad.RWS.Class
import Control.Monad.Trans
import Data.Functor.Identity
import Data.Proxy
import Data.String
import Hectoparsec.Class
import Hectoparsec.Error
import Hectoparsec.State
import Hectoparsec.Stream

{-|
The type of a parser for a stream @s@, using custom errors @e@ and custom labels @l@.

If custom errors or custom labels are not needed, you can simply set it to 'Data.Void.Void' to ignore it. Generally,
if your parser cannot error, you would do so. Otherwise, you should set the error and label types to something that
would allow you to create useful error messages. In particular, labels are tracked in order to create a list of
expected items whenever parsers fail.

'ParserT' implements 'MonadParser' for the primitive parser combinators, 'Alternative' for branching parsers, and the
usual stack of 'Functor', 'Applicative', and 'Monad', along with the classes from @mtl@.
-}
newtype ParserT s e l m a = ParserT { forall s e l (m :: * -> *) a.
ParserT s e l m a -> Continuations s e l m a
unParserT :: Continuations s e l m a }

-- | The 'ParserT' type specialized to the 'Identity' monad.
type Parser s e l = ParserT s e l Identity

-- | Continuation for a successful parse. The labels are used for tracking what was expected.
type ThenOk s l m a r = a -> [l] -> State s -> m r

-- | Continuation for a failed parse.
type ThenErr s e l m r = ParseError s e l -> State s -> m r

-- | Continuations for a parser. 'ParserT' uses this for performance reasons.
type Continuations s e l m a =
    forall r
    .  State s
    -> ThenOk s l m a r
    -> ThenErr s e l m r
    -> ThenOk s l m a r
    -> ThenErr s e l m r
    -> m r

-- | The reply after parsing.
data Reply s e l a = Reply
    { forall s e l a. Reply s e l a -> State s
replyState    :: !(State s)                     -- ^ Resulting state.
    , forall s e l a. Reply s e l a -> Bool
replyConsumed :: !Bool                          -- ^ Whether the parser consumed or not.
    , forall s e l a. Reply s e l a -> Either (ParseError s e l) a
replyResult   :: !(Either (ParseError s e l) a) -- ^ Either the error or result value.
    }

-- | Creates a parser based on a reply.
makeParserT :: Monad m => (State s -> m (Reply s e l a)) -> ParserT s e l m a
makeParserT :: forall (m :: * -> *) s e l a.
Monad m =>
(State s -> m (Reply s e l a)) -> ParserT s e l m a
makeParserT State s -> m (Reply s e l a)
r = Continuations s e l m a -> ParserT s e l m a
forall s e l (m :: * -> *) a.
Continuations s e l m a -> ParserT s e l m a
ParserT (Continuations s e l m a -> ParserT s e l m a)
-> Continuations s e l m a -> ParserT s e l m a
forall a b. (a -> b) -> a -> b
$ \State s
st ThenOk s l m a r
cok ThenErr s e l m r
cerr ThenOk s l m a r
uok ThenErr s e l m r
uerr -> do
    Reply State s
st' Bool
sump Either (ParseError s e l) a
res <- State s -> m (Reply s e l a)
r State s
st
    case (Bool
sump, Either (ParseError s e l) a
res) of
        (Bool
True, Right a
a)  -> ThenOk s l m a r
cok a
a [] State s
st'
        (Bool
True, Left ParseError s e l
e)   -> ThenErr s e l m r
cerr ParseError s e l
e State s
st'
        (Bool
False, Right a
a) -> ThenOk s l m a r
uok a
a [] State s
st'
        (Bool
False, Left ParseError s e l
e)  -> ThenErr s e l m r
uerr ParseError s e l
e State s
st'
{-# INLINE makeParserT #-}

-- | Runs a parser and retrieve the reply.
contParserT :: Monad m => ParserT s e l m a -> State s -> m (Reply s e l a)
contParserT :: forall (m :: * -> *) s e l a.
Monad m =>
ParserT s e l m a -> State s -> m (Reply s e l a)
contParserT ParserT s e l m a
p State s
s = ParserT s e l m a -> Continuations s e l m a
forall s e l (m :: * -> *) a.
ParserT s e l m a -> Continuations s e l m a
unParserT ParserT s e l m a
p State s
s ThenOk s l m a (Reply s e l a)
forall {f :: * -> *} {a} {p} {s} {e} {l}.
Applicative f =>
a -> p -> State s -> f (Reply s e l a)
cok ThenErr s e l m (Reply s e l a)
forall {f :: * -> *} {s} {e} {l} {a}.
Applicative f =>
ParseError s e l -> State s -> f (Reply s e l a)
cerr ThenOk s l m a (Reply s e l a)
forall {f :: * -> *} {a} {p} {s} {e} {l}.
Applicative f =>
a -> p -> State s -> f (Reply s e l a)
uok ThenErr s e l m (Reply s e l a)
forall {f :: * -> *} {s} {e} {l} {a}.
Applicative f =>
ParseError s e l -> State s -> f (Reply s e l a)
uerr
    where
        cok :: a -> p -> State s -> f (Reply s e l a)
cok a
a p
_ State s
st = Reply s e l a -> f (Reply s e l a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Reply s e l a -> f (Reply s e l a))
-> Reply s e l a -> f (Reply s e l a)
forall a b. (a -> b) -> a -> b
$ State s -> Bool -> Either (ParseError s e l) a -> Reply s e l a
forall s e l a.
State s -> Bool -> Either (ParseError s e l) a -> Reply s e l a
Reply State s
st Bool
True (a -> Either (ParseError s e l) a
forall a b. b -> Either a b
Right a
a)
        cerr :: ParseError s e l -> State s -> f (Reply s e l a)
cerr ParseError s e l
e State s
st  = Reply s e l a -> f (Reply s e l a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Reply s e l a -> f (Reply s e l a))
-> Reply s e l a -> f (Reply s e l a)
forall a b. (a -> b) -> a -> b
$ State s -> Bool -> Either (ParseError s e l) a -> Reply s e l a
forall s e l a.
State s -> Bool -> Either (ParseError s e l) a -> Reply s e l a
Reply State s
st Bool
True (ParseError s e l -> Either (ParseError s e l) a
forall a b. a -> Either a b
Left ParseError s e l
e)
        uok :: a -> p -> State s -> f (Reply s e l a)
uok a
a p
_ State s
st = Reply s e l a -> f (Reply s e l a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Reply s e l a -> f (Reply s e l a))
-> Reply s e l a -> f (Reply s e l a)
forall a b. (a -> b) -> a -> b
$ State s -> Bool -> Either (ParseError s e l) a -> Reply s e l a
forall s e l a.
State s -> Bool -> Either (ParseError s e l) a -> Reply s e l a
Reply State s
st Bool
False (a -> Either (ParseError s e l) a
forall a b. b -> Either a b
Right a
a)
        uerr :: ParseError s e l -> State s -> f (Reply s e l a)
uerr ParseError s e l
e State s
st  = Reply s e l a -> f (Reply s e l a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Reply s e l a -> f (Reply s e l a))
-> Reply s e l a -> f (Reply s e l a)
forall a b. (a -> b) -> a -> b
$ State s -> Bool -> Either (ParseError s e l) a -> Reply s e l a
forall s e l a.
State s -> Bool -> Either (ParseError s e l) a -> Reply s e l a
Reply State s
st Bool
False (ParseError s e l -> Either (ParseError s e l) a
forall a b. a -> Either a b
Left ParseError s e l
e)
{-# INLINE contParserT #-}

-- | Lifts the underlying 'Semigroup' into the parser.
instance Semigroup a => Semigroup (ParserT s e l m a) where
    ParserT s e l m a
p <> :: ParserT s e l m a -> ParserT s e l m a -> ParserT s e l m a
<> ParserT s e l m a
q = (a -> a -> a)
-> ParserT s e l m a -> ParserT s e l m a -> ParserT s e l m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) ParserT s e l m a
p ParserT s e l m a
q
    {-# INLINE (<>) #-}

-- | Lifts the underlying 'Monoid' into the parser.
instance Monoid a => Monoid (ParserT s e l m a) where
    mempty :: ParserT s e l m a
mempty = a -> ParserT s e l m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
    {-# INLINE mempty #-}

instance Functor (ParserT s e l m) where
    fmap :: forall a b. (a -> b) -> ParserT s e l m a -> ParserT s e l m b
fmap a -> b
f ParserT s e l m a
p = Continuations s e l m b -> ParserT s e l m b
forall s e l (m :: * -> *) a.
Continuations s e l m a -> ParserT s e l m a
ParserT (Continuations s e l m b -> ParserT s e l m b)
-> Continuations s e l m b -> ParserT s e l m b
forall a b. (a -> b) -> a -> b
$ \State s
st ThenOk s l m b r
cok ThenErr s e l m r
cerr ThenOk s l m b r
uok ThenErr s e l m r
uerr ->
        ParserT s e l m a -> Continuations s e l m a
forall s e l (m :: * -> *) a.
ParserT s e l m a -> Continuations s e l m a
unParserT ParserT s e l m a
p State s
st (ThenOk s l m b r
cok ThenOk s l m b r -> (a -> b) -> ThenOk s l m a r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) ThenErr s e l m r
cerr (ThenOk s l m b r
uok ThenOk s l m b r -> (a -> b) -> ThenOk s l m a r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) ThenErr s e l m r
uerr
    {-# INLINE fmap #-}

instance Applicative (ParserT s e l m) where
    pure :: forall a. a -> ParserT s e l m a
pure a
a = Continuations s e l m a -> ParserT s e l m a
forall s e l (m :: * -> *) a.
Continuations s e l m a -> ParserT s e l m a
ParserT (Continuations s e l m a -> ParserT s e l m a)
-> Continuations s e l m a -> ParserT s e l m a
forall a b. (a -> b) -> a -> b
$ \State s
st ThenOk s l m a r
_ ThenErr s e l m r
_ ThenOk s l m a r
uok ThenErr s e l m r
_ -> ThenOk s l m a r
uok a
a [] State s
st
    {-# INLINE pure #-}

    ParserT s e l m (a -> b)
p <*> :: forall a b.
ParserT s e l m (a -> b) -> ParserT s e l m a -> ParserT s e l m b
<*> ParserT s e l m a
q = Continuations s e l m b -> ParserT s e l m b
forall s e l (m :: * -> *) a.
Continuations s e l m a -> ParserT s e l m a
ParserT (Continuations s e l m b -> ParserT s e l m b)
-> Continuations s e l m b -> ParserT s e l m b
forall a b. (a -> b) -> a -> b
$ \State s
st ThenOk s l m b r
cok ThenErr s e l m r
cerr ThenOk s l m b r
uok ThenErr s e l m r
uerr ->
        let pcok :: (a -> b) -> [l] -> State s -> m r
pcok a -> b
pa [l]
pl State s
pst
                | [l] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [l]
pl   = ParserT s e l m a -> Continuations s e l m a
forall s e l (m :: * -> *) a.
ParserT s e l m a -> Continuations s e l m a
unParserT ParserT s e l m a
q State s
pst (ThenOk s l m b r
cok ThenOk s l m b r -> (a -> b) -> ThenOk s l m a r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
pa) ThenErr s e l m r
cerr (ThenOk s l m b r
cok ThenOk s l m b r -> (a -> b) -> ThenOk s l m a r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
pa) ThenErr s e l m r
cerr
                | Bool
otherwise = ParserT s e l m a -> Continuations s e l m a
forall s e l (m :: * -> *) a.
ParserT s e l m a -> Continuations s e l m a
unParserT ParserT s e l m a
q State s
pst (ThenOk s l m b r
cok ThenOk s l m b r -> (a -> b) -> ThenOk s l m a r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
pa) ThenErr s e l m r
cerr ([l] -> ThenOk s l m a r -> ThenOk s l m a r
forall l s (m :: * -> *) a r.
[l] -> ThenOk s l m a r -> ThenOk s l m a r
withOk [l]
pl (ThenOk s l m b r
cok ThenOk s l m b r -> (a -> b) -> ThenOk s l m a r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
pa)) ([l] -> ThenErr s e l m r -> ThenErr s e l m r
forall l s e (m :: * -> *) r.
[l] -> ThenErr s e l m r -> ThenErr s e l m r
withErr [l]
pl ThenErr s e l m r
cerr)
            puok :: (a -> b) -> [l] -> State s -> m r
puok a -> b
pa [l]
pl State s
pst
                | [l] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [l]
pl   = ParserT s e l m a -> Continuations s e l m a
forall s e l (m :: * -> *) a.
ParserT s e l m a -> Continuations s e l m a
unParserT ParserT s e l m a
q State s
pst (ThenOk s l m b r
cok ThenOk s l m b r -> (a -> b) -> ThenOk s l m a r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
pa) ThenErr s e l m r
cerr (ThenOk s l m b r
uok ThenOk s l m b r -> (a -> b) -> ThenOk s l m a r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
pa) ThenErr s e l m r
uerr
                | Bool
otherwise = ParserT s e l m a -> Continuations s e l m a
forall s e l (m :: * -> *) a.
ParserT s e l m a -> Continuations s e l m a
unParserT ParserT s e l m a
q State s
pst (ThenOk s l m b r
cok ThenOk s l m b r -> (a -> b) -> ThenOk s l m a r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
pa) ThenErr s e l m r
cerr ([l] -> ThenOk s l m a r -> ThenOk s l m a r
forall l s (m :: * -> *) a r.
[l] -> ThenOk s l m a r -> ThenOk s l m a r
withOk [l]
pl (ThenOk s l m b r
uok ThenOk s l m b r -> (a -> b) -> ThenOk s l m a r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
pa)) ([l] -> ThenErr s e l m r -> ThenErr s e l m r
forall l s e (m :: * -> *) r.
[l] -> ThenErr s e l m r -> ThenErr s e l m r
withErr [l]
pl ThenErr s e l m r
uerr)
        in ParserT s e l m (a -> b) -> Continuations s e l m (a -> b)
forall s e l (m :: * -> *) a.
ParserT s e l m a -> Continuations s e l m a
unParserT ParserT s e l m (a -> b)
p State s
st (a -> b) -> [l] -> State s -> m r
pcok ThenErr s e l m r
cerr (a -> b) -> [l] -> State s -> m r
puok ThenErr s e l m r
uerr
    {-# INLINE (<*>) #-}

    ParserT s e l m a
p *> :: forall a b.
ParserT s e l m a -> ParserT s e l m b -> ParserT s e l m b
*> ParserT s e l m b
q = ParserT s e l m a
p ParserT s e l m a -> (a -> ParserT s e l m b) -> ParserT s e l m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParserT s e l m b -> a -> ParserT s e l m b
forall a b. a -> b -> a
const ParserT s e l m b
q

    ParserT s e l m a
p <* :: forall a b.
ParserT s e l m a -> ParserT s e l m b -> ParserT s e l m a
<* ParserT s e l m b
q = do
        a
x <- ParserT s e l m a
p
        ParserT s e l m b -> ParserT s e l m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParserT s e l m b
q
        a -> ParserT s e l m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

{-|
Allows for branching parsers. The 'empty' parser will always fail.

Note that @p '<|>' q@ will only try @q@ if @p@ fails and did not consume any input. For parsers @p@ that consume input,
they can be backtracked to allow the next parser to be attempted using @'try' p@.

In general, if any branch comsumes input, regardless of success, that branch will be commited to, and error messages
will be based entirely on that branch.
-}
instance Alternative (ParserT s e l m) where
    empty :: forall a. ParserT s e l m a
empty = Continuations s e l m a -> ParserT s e l m a
forall s e l (m :: * -> *) a.
Continuations s e l m a -> ParserT s e l m a
ParserT (Continuations s e l m a -> ParserT s e l m a)
-> Continuations s e l m a -> ParserT s e l m a
forall a b. (a -> b) -> a -> b
$ \State s
st ThenOk s l m a r
_ ThenErr s e l m r
_ ThenOk s l m a r
_ ThenErr s e l m r
uerr -> ThenErr s e l m r
uerr (State s -> ErrorItem s e l -> ParseError s e l
forall s e l. State s -> ErrorItem s e l -> ParseError s e l
makeErrorAt State s
st (Unexpected s -> [l] -> ErrorItem s e l
forall s e l. Unexpected s -> [l] -> ErrorItem s e l
ErrorItemLabels Unexpected s
forall s. Unexpected s
UnexpectedEmpty [])) State s
st
    {-# INLINE empty #-}

    ParserT s e l m a
p <|> :: forall a.
ParserT s e l m a -> ParserT s e l m a -> ParserT s e l m a
<|> ParserT s e l m a
q = Continuations s e l m a -> ParserT s e l m a
forall s e l (m :: * -> *) a.
Continuations s e l m a -> ParserT s e l m a
ParserT (Continuations s e l m a -> ParserT s e l m a)
-> Continuations s e l m a -> ParserT s e l m a
forall a b. (a -> b) -> a -> b
$ \State s
st ThenOk s l m a r
cok ThenErr s e l m r
cerr ThenOk s l m a r
uok ThenErr s e l m r
uerr ->
        let puerr :: ThenErr s e l m r
puerr ParseError s e l
pe State s
pst =
                let quok :: ThenOk s l m a r
quok a
qa [l]
ql State s
qst = ThenOk s l m a r
uok a
qa (ParseError s e l -> State s -> [l] -> [l]
forall s e l. ParseError s e l -> State s -> [l] -> [l]
merge ParseError s e l
pe State s
qst [l]
ql) State s
qst
                    querr :: ThenErr s e l m r
querr ParseError s e l
qe State s
qst = (State s -> ParseError s e l -> m r)
-> (State s, ParseError s e l) -> m r
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (ThenErr s e l m r -> State s -> ParseError s e l -> m r
forall a b c. (a -> b -> c) -> b -> a -> c
flip ThenErr s e l m r
uerr) ((State s, ParseError s e l)
-> (State s, ParseError s e l) -> (State s, ParseError s e l)
forall s e l.
(State s, ParseError s e l)
-> (State s, ParseError s e l) -> (State s, ParseError s e l)
choose (State s
pst, ParseError s e l
pe) (State s
qst, ParseError s e l
qe))
                in ParserT s e l m a -> Continuations s e l m a
forall s e l (m :: * -> *) a.
ParserT s e l m a -> Continuations s e l m a
unParserT ParserT s e l m a
q State s
st ThenOk s l m a r
cok ThenErr s e l m r
cerr ThenOk s l m a r
quok ThenErr s e l m r
querr
        in ParserT s e l m a -> Continuations s e l m a
forall s e l (m :: * -> *) a.
ParserT s e l m a -> Continuations s e l m a
unParserT ParserT s e l m a
p State s
st ThenOk s l m a r
cok ThenErr s e l m r
cerr ThenOk s l m a r
uok ThenErr s e l m r
puerr
    {-# INLINE (<|>) #-}

-- | Equivalent to the 'Alternative' instance.
instance MonadPlus (ParserT s e l m) where

instance Monad (ParserT s e l m) where
    ParserT s e l m a
p >>= :: forall a b.
ParserT s e l m a -> (a -> ParserT s e l m b) -> ParserT s e l m b
>>= a -> ParserT s e l m b
q = Continuations s e l m b -> ParserT s e l m b
forall s e l (m :: * -> *) a.
Continuations s e l m a -> ParserT s e l m a
ParserT (Continuations s e l m b -> ParserT s e l m b)
-> Continuations s e l m b -> ParserT s e l m b
forall a b. (a -> b) -> a -> b
$ \State s
st ThenOk s l m b r
cok ThenErr s e l m r
cerr ThenOk s l m b r
uok ThenErr s e l m r
uerr ->
        let pcok :: a -> [l] -> State s -> m r
pcok a
pa [l]
pl State s
pst
                | [l] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [l]
pl   = ParserT s e l m b -> Continuations s e l m b
forall s e l (m :: * -> *) a.
ParserT s e l m a -> Continuations s e l m a
unParserT (a -> ParserT s e l m b
q a
pa) State s
pst ThenOk s l m b r
cok ThenErr s e l m r
cerr ThenOk s l m b r
cok ThenErr s e l m r
cerr
                | Bool
otherwise = ParserT s e l m b -> Continuations s e l m b
forall s e l (m :: * -> *) a.
ParserT s e l m a -> Continuations s e l m a
unParserT (a -> ParserT s e l m b
q a
pa) State s
pst ThenOk s l m b r
cok ThenErr s e l m r
cerr ([l] -> ThenOk s l m b r -> ThenOk s l m b r
forall l s (m :: * -> *) a r.
[l] -> ThenOk s l m a r -> ThenOk s l m a r
withOk [l]
pl ThenOk s l m b r
cok) ([l] -> ThenErr s e l m r -> ThenErr s e l m r
forall l s e (m :: * -> *) r.
[l] -> ThenErr s e l m r -> ThenErr s e l m r
withErr [l]
pl ThenErr s e l m r
cerr)
            puok :: a -> [l] -> State s -> m r
puok a
pa [l]
pl State s
pst
                | [l] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [l]
pl   = ParserT s e l m b -> Continuations s e l m b
forall s e l (m :: * -> *) a.
ParserT s e l m a -> Continuations s e l m a
unParserT (a -> ParserT s e l m b
q a
pa) State s
pst ThenOk s l m b r
cok ThenErr s e l m r
cerr ThenOk s l m b r
uok ThenErr s e l m r
uerr
                | Bool
otherwise = ParserT s e l m b -> Continuations s e l m b
forall s e l (m :: * -> *) a.
ParserT s e l m a -> Continuations s e l m a
unParserT (a -> ParserT s e l m b
q a
pa) State s
pst ThenOk s l m b r
cok ThenErr s e l m r
cerr ([l] -> ThenOk s l m b r -> ThenOk s l m b r
forall l s (m :: * -> *) a r.
[l] -> ThenOk s l m a r -> ThenOk s l m a r
withOk [l]
pl ThenOk s l m b r
uok) ([l] -> ThenErr s e l m r -> ThenErr s e l m r
forall l s e (m :: * -> *) r.
[l] -> ThenErr s e l m r -> ThenErr s e l m r
withErr [l]
pl ThenErr s e l m r
uerr)
        in ParserT s e l m a -> Continuations s e l m a
forall s e l (m :: * -> *) a.
ParserT s e l m a -> Continuations s e l m a
unParserT ParserT s e l m a
p State s
st a -> [l] -> State s -> m r
pcok ThenErr s e l m r
cerr a -> [l] -> State s -> m r
puok ThenErr s e l m r
uerr
    {-# INLINE (>>=) #-}

instance MonadFail (ParserT s e l m) where
    fail :: forall a. String -> ParserT s e l m a
fail String
msg = Continuations s e l m a -> ParserT s e l m a
forall s e l (m :: * -> *) a.
Continuations s e l m a -> ParserT s e l m a
ParserT (Continuations s e l m a -> ParserT s e l m a)
-> Continuations s e l m a -> ParserT s e l m a
forall a b. (a -> b) -> a -> b
$ \State s
st ThenOk s l m a r
_ ThenErr s e l m r
_ ThenOk s l m a r
_ ThenErr s e l m r
uerr -> ThenErr s e l m r
uerr (State s -> ErrorItem s e l -> ParseError s e l
forall s e l. State s -> ErrorItem s e l -> ParseError s e l
makeErrorAt State s
st (ErrorItem s e l -> ParseError s e l)
-> ErrorItem s e l -> ParseError s e l
forall a b. (a -> b) -> a -> b
$ [Message e] -> ErrorItem s e l
forall s e l. [Message e] -> ErrorItem s e l
ErrorItemMessages [String -> Message e
forall e. String -> Message e
MessageFail String
msg]) State s
st
    {-# INLINE fail #-}

instance Stream s => MonadParser s e l (ParserT s e l m) where
    matchToken :: forall a.
(Maybe (Token s) -> Either (ErrorItem s e l) a)
-> ParserT s e l m a
matchToken Maybe (Token s) -> Either (ErrorItem s e l) a
match = Continuations s e l m a -> ParserT s e l m a
forall s e l (m :: * -> *) a.
Continuations s e l m a -> ParserT s e l m a
ParserT (Continuations s e l m a -> ParserT s e l m a)
-> Continuations s e l m a -> ParserT s e l m a
forall a b. (a -> b) -> a -> b
$ \st :: State s
st@(State {s
Int
Pos
stateOffset :: forall s. State s -> Int
statePos :: forall s. State s -> Pos
stateInput :: forall s. State s -> s
stateOffset :: Int
statePos :: Pos
stateInput :: s
..}) ThenOk s l m a r
cok ThenErr s e l m r
_ ThenOk s l m a r
uok ThenErr s e l m r
uerr ->
        case s -> Maybe (Token s, s)
forall s. Stream s => s -> Maybe (Token s, s)
streamUncons s
stateInput of
            Maybe (Token s, s)
Nothing -> case Maybe (Token s) -> Either (ErrorItem s e l) a
match Maybe (Token s)
forall a. Maybe a
Nothing of
                Left ErrorItem s e l
err -> ThenErr s e l m r
uerr (State s -> ErrorItem s e l -> ParseError s e l
forall s e l. State s -> ErrorItem s e l -> ParseError s e l
makeErrorAt State s
st ErrorItem s e l
err) State s
st
                Right a
res -> ThenOk s l m a r
uok a
res [] State s
st
            Just (Token s
tok, s
toks) -> case Maybe (Token s) -> Either (ErrorItem s e l) a
match (Token s -> Maybe (Token s)
forall a. a -> Maybe a
Just Token s
tok) of
                Left ErrorItem s e l
err -> ThenErr s e l m r
uerr (State s -> ErrorItem s e l -> ParseError s e l
forall s e l. State s -> ErrorItem s e l -> ParseError s e l
makeErrorAt State s
st ErrorItem s e l
err) State s
st
                Right a
res -> ThenOk s l m a r
cok a
res []
                    (State s
st
                        { stateInput :: s
stateInput = s
toks
                        , statePos :: Pos
statePos = Proxy s -> Token s -> Pos -> Pos
forall s (proxy :: * -> *).
Stream s =>
proxy s -> Token s -> Pos -> Pos
updatePosToken Proxy s
proxy Token s
tok Pos
statePos
                        })
        where proxy :: Proxy s
proxy = Proxy s
forall {k} (t :: k). Proxy t
Proxy :: Proxy s
    {-# INLINE matchToken #-}

    matchTokens :: forall a.
Int -> (Chunk s -> Either (ErrorItem s e l) a) -> ParserT s e l m a
matchTokens Int
n Chunk s -> Either (ErrorItem s e l) a
match = Continuations s e l m a -> ParserT s e l m a
forall s e l (m :: * -> *) a.
Continuations s e l m a -> ParserT s e l m a
ParserT (Continuations s e l m a -> ParserT s e l m a)
-> Continuations s e l m a -> ParserT s e l m a
forall a b. (a -> b) -> a -> b
$ \st :: State s
st@(State {s
Int
Pos
stateOffset :: Int
statePos :: Pos
stateInput :: s
stateOffset :: forall s. State s -> Int
statePos :: forall s. State s -> Pos
stateInput :: forall s. State s -> s
..}) ThenOk s l m a r
cok ThenErr s e l m r
_ ThenOk s l m a r
uok ThenErr s e l m r
uerr ->
        let (Chunk s
xs, s
ys) = Int -> s -> (Chunk s, s)
forall s. Stream s => Int -> s -> (Chunk s, s)
streamSplitAt Int
n s
stateInput
        in case Chunk s -> Either (ErrorItem s e l) a
match Chunk s
xs of
            Left ErrorItem s e l
err -> ThenErr s e l m r
uerr (State s -> ErrorItem s e l -> ParseError s e l
forall s e l. State s -> ErrorItem s e l -> ParseError s e l
makeErrorAt State s
st ErrorItem s e l
err) State s
st
            Right a
res -> if Proxy s -> Chunk s -> Bool
forall s (proxy :: * -> *). Stream s => proxy s -> Chunk s -> Bool
chunkNull Proxy s
proxy Chunk s
xs
                then ThenOk s l m a r
uok a
res [] State s
st
                else ThenOk s l m a r
cok a
res []
                    (State s
st
                        { stateInput :: s
stateInput = s
ys
                        , statePos :: Pos
statePos = Proxy s -> Chunk s -> Pos -> Pos
forall s (proxy :: * -> *).
Stream s =>
proxy s -> Chunk s -> Pos -> Pos
updatePosChunk Proxy s
proxy Chunk s
xs Pos
statePos
                        })
        where
            proxy :: Proxy s
proxy = Proxy s
forall {k} (t :: k). Proxy t
Proxy :: Proxy s
    {-# INLINE matchTokens #-}

    matchTokenWhile :: forall a.
(Token s -> Bool)
-> (Chunk s -> Either (ErrorItem s e l) a) -> ParserT s e l m a
matchTokenWhile Token s -> Bool
p Chunk s -> Either (ErrorItem s e l) a
match = Continuations s e l m a -> ParserT s e l m a
forall s e l (m :: * -> *) a.
Continuations s e l m a -> ParserT s e l m a
ParserT (Continuations s e l m a -> ParserT s e l m a)
-> Continuations s e l m a -> ParserT s e l m a
forall a b. (a -> b) -> a -> b
$ \st :: State s
st@(State {s
Int
Pos
stateOffset :: Int
statePos :: Pos
stateInput :: s
stateOffset :: forall s. State s -> Int
statePos :: forall s. State s -> Pos
stateInput :: forall s. State s -> s
..}) ThenOk s l m a r
cok ThenErr s e l m r
_ ThenOk s l m a r
uok ThenErr s e l m r
uerr ->
        let (Chunk s
xs, s
ys) = (Token s -> Bool) -> s -> (Chunk s, s)
forall s. Stream s => (Token s -> Bool) -> s -> (Chunk s, s)
streamSpan Token s -> Bool
p s
stateInput
        in case Chunk s -> Either (ErrorItem s e l) a
match Chunk s
xs of
            Left ErrorItem s e l
err  -> ThenErr s e l m r
uerr (State s -> ErrorItem s e l -> ParseError s e l
forall s e l. State s -> ErrorItem s e l -> ParseError s e l
makeErrorAt State s
st ErrorItem s e l
err) State s
st
            Right a
res -> if Proxy s -> Chunk s -> Bool
forall s (proxy :: * -> *). Stream s => proxy s -> Chunk s -> Bool
chunkNull Proxy s
proxy Chunk s
xs
                then ThenOk s l m a r
uok a
res [] State s
st
                else ThenOk s l m a r
cok a
res []
                    (State s
st
                        { stateInput :: s
stateInput = s
ys
                        , statePos :: Pos
statePos = Proxy s -> Chunk s -> Pos -> Pos
forall s (proxy :: * -> *).
Stream s =>
proxy s -> Chunk s -> Pos -> Pos
updatePosChunk Proxy s
proxy Chunk s
xs Pos
statePos
                        })
        where
            proxy :: Proxy s
proxy = Proxy s
forall {k} (t :: k). Proxy t
Proxy :: Proxy s
    {-# INLINE matchTokenWhile #-}

    endOfInput :: ParserT s e l m ()
endOfInput = Continuations s e l m () -> ParserT s e l m ()
forall s e l (m :: * -> *) a.
Continuations s e l m a -> ParserT s e l m a
ParserT (Continuations s e l m () -> ParserT s e l m ())
-> Continuations s e l m () -> ParserT s e l m ()
forall a b. (a -> b) -> a -> b
$ \st :: State s
st@(State {s
Int
Pos
stateOffset :: Int
statePos :: Pos
stateInput :: s
stateOffset :: forall s. State s -> Int
statePos :: forall s. State s -> Pos
stateInput :: forall s. State s -> s
..}) ThenOk s l m () r
_ ThenErr s e l m r
_ ThenOk s l m () r
uok ThenErr s e l m r
uerr ->
        case s -> Maybe (Token s, s)
forall s. Stream s => s -> Maybe (Token s, s)
streamUncons s
stateInput of
            Maybe (Token s, s)
Nothing -> ThenOk s l m () r
uok () [] State s
st
            Just (Token s, s)
_  -> ThenErr s e l m r
uerr (State s -> ErrorItem s e l -> ParseError s e l
forall s e l. State s -> ErrorItem s e l -> ParseError s e l
makeErrorAt State s
st (Unexpected s -> [l] -> ErrorItem s e l
forall s e l. Unexpected s -> [l] -> ErrorItem s e l
ErrorItemLabels Unexpected s
forall s. Unexpected s
UnexpectedEnd [])) State s
st
    {-# INLINE endOfInput #-}

    withLabel :: forall a. Maybe l -> ParserT s e l m a -> ParserT s e l m a
withLabel Maybe l
lbl ParserT s e l m a
p = Continuations s e l m a -> ParserT s e l m a
forall s e l (m :: * -> *) a.
Continuations s e l m a -> ParserT s e l m a
ParserT (Continuations s e l m a -> ParserT s e l m a)
-> Continuations s e l m a -> ParserT s e l m a
forall a b. (a -> b) -> a -> b
$ \State s
st ThenOk s l m a r
cok ThenErr s e l m r
cerr ThenOk s l m a r
uok ThenErr s e l m r
uerr ->
        let pcok :: ThenOk s l m a r
pcok a
pa [l]
pl State s
st' = case Maybe l
lbl of
                -- We only want to be able to remove the last label.
                -- If something was consumed, it does not make sense to replace the previous label.
                Maybe l
Nothing -> ThenOk s l m a r
cok a
pa (Maybe l -> [l] -> [l]
forall {a}. Maybe a -> [a] -> [a]
replaceLabel Maybe l
forall a. Maybe a
Nothing [l]
pl) State s
st'
                Just l
_  -> ThenOk s l m a r
cok a
pa [l]
pl State s
st'
            puok :: ThenOk s l m a r
puok a
pa [l]
pl State s
st' = ThenOk s l m a r
uok a
pa (Maybe l -> [l] -> [l]
forall {a}. Maybe a -> [a] -> [a]
replaceLabel Maybe l
lbl [l]
pl) State s
st'
            puerr :: ThenErr s e l m r
puerr ParseError s e l
pe = ThenErr s e l m r
uerr ThenErr s e l m r
-> (ErrorItem s e l -> ParseError s e l)
-> ErrorItem s e l
-> State s
-> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Int -> ErrorItem s e l -> ParseError s e l
forall s e l. Pos -> Int -> ErrorItem s e l -> ParseError s e l
ParseError (ParseError s e l -> Pos
forall s e l. ParseError s e l -> Pos
parseErrorPos ParseError s e l
pe) (ParseError s e l -> Int
forall s e l. ParseError s e l -> Int
parseErrorOffset ParseError s e l
pe) (ErrorItem s e l -> State s -> m r)
-> ErrorItem s e l -> State s -> m r
forall a b. (a -> b) -> a -> b
$
                case ParseError s e l -> ErrorItem s e l
forall s e l. ParseError s e l -> ErrorItem s e l
parseErrorItem ParseError s e l
pe of
                    ErrorItemLabels Unexpected s
unex [l]
_ -> Unexpected s -> [l] -> ErrorItem s e l
forall s e l. Unexpected s -> [l] -> ErrorItem s e l
ErrorItemLabels Unexpected s
unex ([l] -> (l -> [l]) -> Maybe l -> [l]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] l -> [l]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe l
lbl)
                    ErrorItem s e l
ei -> ErrorItem s e l
ei
        in ParserT s e l m a -> Continuations s e l m a
forall s e l (m :: * -> *) a.
ParserT s e l m a -> Continuations s e l m a
unParserT ParserT s e l m a
p State s
st ThenOk s l m a r
pcok ThenErr s e l m r
cerr ThenOk s l m a r
puok ThenErr s e l m r
puerr
        where
            replaceLabel :: Maybe a -> [a] -> [a]
replaceLabel Maybe a
_ [] = []
            replaceLabel Maybe a
Nothing (a
_:[a]
xs) = [a]
xs
            replaceLabel (Just a
x) (a
_:[a]
xs) = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs
    {-# INLINE withLabel #-}

    try :: forall a. ParserT s e l m a -> ParserT s e l m a
try ParserT s e l m a
p = Continuations s e l m a -> ParserT s e l m a
forall s e l (m :: * -> *) a.
Continuations s e l m a -> ParserT s e l m a
ParserT (Continuations s e l m a -> ParserT s e l m a)
-> Continuations s e l m a -> ParserT s e l m a
forall a b. (a -> b) -> a -> b
$ \State s
st ThenOk s l m a r
cok ThenErr s e l m r
_ ThenOk s l m a r
uok ThenErr s e l m r
uerr ->
        let puerr :: ThenErr s e l m r
puerr ParseError s e l
pe State s
_ = ThenErr s e l m r
uerr ParseError s e l
pe State s
st
        in ParserT s e l m a -> Continuations s e l m a
forall s e l (m :: * -> *) a.
ParserT s e l m a -> Continuations s e l m a
unParserT ParserT s e l m a
p State s
st ThenOk s l m a r
cok ThenErr s e l m r
puerr ThenOk s l m a r
uok ThenErr s e l m r
puerr
    {-# INLINE try #-}

    lookAhead :: forall a. ParserT s e l m a -> ParserT s e l m a
lookAhead ParserT s e l m a
p = Continuations s e l m a -> ParserT s e l m a
forall s e l (m :: * -> *) a.
Continuations s e l m a -> ParserT s e l m a
ParserT (Continuations s e l m a -> ParserT s e l m a)
-> Continuations s e l m a -> ParserT s e l m a
forall a b. (a -> b) -> a -> b
$ \State s
st ThenOk s l m a r
_ ThenErr s e l m r
cerr ThenOk s l m a r
uok ThenErr s e l m r
uerr ->
        let puok :: ThenOk s l m a r
puok a
pa [l]
_ State s
_ = ThenOk s l m a r
uok a
pa [] State s
st
        in ParserT s e l m a -> Continuations s e l m a
forall s e l (m :: * -> *) a.
ParserT s e l m a -> Continuations s e l m a
unParserT ParserT s e l m a
p State s
st ThenOk s l m a r
puok ThenErr s e l m r
cerr ThenOk s l m a r
puok ThenErr s e l m r
uerr
    {-# INLINE lookAhead #-}

    notFollowedBy :: forall a. ParserT s e l m a -> ParserT s e l m ()
notFollowedBy ParserT s e l m a
p = Continuations s e l m () -> ParserT s e l m ()
forall s e l (m :: * -> *) a.
Continuations s e l m a -> ParserT s e l m a
ParserT (Continuations s e l m () -> ParserT s e l m ())
-> Continuations s e l m () -> ParserT s e l m ()
forall a b. (a -> b) -> a -> b
$ \State s
st ThenOk s l m () r
_ ThenErr s e l m r
_ ThenOk s l m () r
uok ThenErr s e l m r
uerr ->
        let puok :: a -> [l] -> State s -> m r
puok a
_ [l]
_ State s
_ =
                let tok :: Maybe (Token s)
tok = (Token s, s) -> Token s
forall a b. (a, b) -> a
fst ((Token s, s) -> Token s) -> Maybe (Token s, s) -> Maybe (Token s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> Maybe (Token s, s)
forall s. Stream s => s -> Maybe (Token s, s)
streamUncons (State s -> s
forall s. State s -> s
stateInput State s
st)
                in ThenErr s e l m r
uerr (State s -> ErrorItem s e l -> ParseError s e l
forall s e l. State s -> ErrorItem s e l -> ParseError s e l
makeErrorAt State s
st (ErrorItem s e l -> ParseError s e l)
-> ErrorItem s e l -> ParseError s e l
forall a b. (a -> b) -> a -> b
$ Unexpected s -> [l] -> ErrorItem s e l
forall s e l. Unexpected s -> [l] -> ErrorItem s e l
ErrorItemLabels (Unexpected s
-> (Token s -> Unexpected s) -> Maybe (Token s) -> Unexpected s
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Unexpected s
forall s. Unexpected s
UnexpectedEnd Token s -> Unexpected s
forall s. Token s -> Unexpected s
UnexpectedToken Maybe (Token s)
tok) []) State s
st
            puerr :: ThenErr s e l m r
puerr ParseError s e l
_ State s
_ = ThenOk s l m () r
uok () [] State s
st
        in ParserT s e l m a -> Continuations s e l m a
forall s e l (m :: * -> *) a.
ParserT s e l m a -> Continuations s e l m a
unParserT ParserT s e l m a
p State s
st a -> [l] -> State s -> m r
puok ThenErr s e l m r
puerr a -> [l] -> State s -> m r
puok ThenErr s e l m r
puerr
    {-# INLINE notFollowedBy #-}

    recover :: forall a.
(ParseError s e l -> ParserT s e l m a)
-> ParserT s e l m a -> ParserT s e l m a
recover ParseError s e l -> ParserT s e l m a
recv ParserT s e l m a
p = Continuations s e l m a -> ParserT s e l m a
forall s e l (m :: * -> *) a.
Continuations s e l m a -> ParserT s e l m a
ParserT (Continuations s e l m a -> ParserT s e l m a)
-> Continuations s e l m a -> ParserT s e l m a
forall a b. (a -> b) -> a -> b
$ \State s
st ThenOk s l m a r
cok ThenErr s e l m r
cerr ThenOk s l m a r
uok ThenErr s e l m r
uerr ->
        let pcerr :: ThenErr s e l m r
pcerr ParseError s e l
pe State s
pst =
                let rcok :: ThenOk s l m a r
rcok a
ra [l]
_ State s
rst  = ThenOk s l m a r
cok a
ra [] State s
rst
                    rcerr :: ThenErr s e l m r
rcerr ParseError s e l
_ State s
_      = ThenErr s e l m r
cerr ParseError s e l
pe State s
pst
                    ruok :: ThenOk s l m a r
ruok a
ra [l]
rl State s
rst = ThenOk s l m a r
uok a
ra (ParseError s e l -> State s -> [l] -> [l]
forall s e l. ParseError s e l -> State s -> [l] -> [l]
merge ParseError s e l
pe State s
rst [l]
rl) State s
rst
                    ruerr :: ThenErr s e l m r
ruerr ParseError s e l
_ State s
_      = ThenErr s e l m r
cerr ParseError s e l
pe State s
pst
                in ParserT s e l m a -> Continuations s e l m a
forall s e l (m :: * -> *) a.
ParserT s e l m a -> Continuations s e l m a
unParserT (ParseError s e l -> ParserT s e l m a
recv ParseError s e l
pe) State s
pst ThenOk s l m a r
rcok ThenErr s e l m r
rcerr ThenOk s l m a r
ruok ThenErr s e l m r
ruerr
            puerr :: ThenErr s e l m r
puerr ParseError s e l
pe State s
pst =
                let rcok :: ThenOk s l m a r
rcok a
ra [l]
rl State s
rst = ThenOk s l m a r
cok a
ra (ParseError s e l -> State s -> [l] -> [l]
forall s e l. ParseError s e l -> State s -> [l] -> [l]
merge ParseError s e l
pe State s
rst [l]
rl) State s
rst
                    rcerr :: ThenErr s e l m r
rcerr ParseError s e l
_ State s
_      = ThenErr s e l m r
uerr ParseError s e l
pe State s
pst
                    ruok :: ThenOk s l m a r
ruok a
ra [l]
rl State s
rst = ThenOk s l m a r
uok a
ra (ParseError s e l -> State s -> [l] -> [l]
forall s e l. ParseError s e l -> State s -> [l] -> [l]
merge ParseError s e l
pe State s
rst [l]
rl) State s
rst
                    ruerr :: ThenErr s e l m r
ruerr ParseError s e l
_ State s
_      = ThenErr s e l m r
uerr ParseError s e l
pe State s
pst
                in ParserT s e l m a -> Continuations s e l m a
forall s e l (m :: * -> *) a.
ParserT s e l m a -> Continuations s e l m a
unParserT (ParseError s e l -> ParserT s e l m a
recv ParseError s e l
pe) State s
pst ThenOk s l m a r
rcok ThenErr s e l m r
rcerr ThenOk s l m a r
ruok ThenErr s e l m r
ruerr
        in ParserT s e l m a -> Continuations s e l m a
forall s e l (m :: * -> *) a.
ParserT s e l m a -> Continuations s e l m a
unParserT ParserT s e l m a
p State s
st ThenOk s l m a r
cok ThenErr s e l m r
pcerr ThenOk s l m a r
uok ThenErr s e l m r
puerr
    {-# INLINE recover #-}

    observing :: forall a.
ParserT s e l m a -> ParserT s e l m (Either (ParseError s e l) a)
observing ParserT s e l m a
p = Continuations s e l m (Either (ParseError s e l) a)
-> ParserT s e l m (Either (ParseError s e l) a)
forall s e l (m :: * -> *) a.
Continuations s e l m a -> ParserT s e l m a
ParserT (Continuations s e l m (Either (ParseError s e l) a)
 -> ParserT s e l m (Either (ParseError s e l) a))
-> Continuations s e l m (Either (ParseError s e l) a)
-> ParserT s e l m (Either (ParseError s e l) a)
forall a b. (a -> b) -> a -> b
$ \State s
st ThenOk s l m (Either (ParseError s e l) a) r
cok ThenErr s e l m r
_ ThenOk s l m (Either (ParseError s e l) a) r
uok ThenErr s e l m r
_ ->
        let pcerr :: ThenErr s e l m r
pcerr ParseError s e l
pe State s
pst = ThenOk s l m (Either (ParseError s e l) a) r
cok (ParseError s e l -> Either (ParseError s e l) a
forall a b. a -> Either a b
Left ParseError s e l
pe) [] State s
pst
            puerr :: ThenErr s e l m r
puerr ParseError s e l
pe State s
pst = ThenOk s l m (Either (ParseError s e l) a) r
uok (ParseError s e l -> Either (ParseError s e l) a
forall a b. a -> Either a b
Left ParseError s e l
pe) [] State s
pst
        in ParserT s e l m a -> Continuations s e l m a
forall s e l (m :: * -> *) a.
ParserT s e l m a -> Continuations s e l m a
unParserT ParserT s e l m a
p State s
st (ThenOk s l m (Either (ParseError s e l) a) r
cok ThenOk s l m (Either (ParseError s e l) a) r
-> (a -> Either (ParseError s e l) a) -> ThenOk s l m a r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either (ParseError s e l) a
forall a b. b -> Either a b
Right) ThenErr s e l m r
pcerr (ThenOk s l m (Either (ParseError s e l) a) r
uok ThenOk s l m (Either (ParseError s e l) a) r
-> (a -> Either (ParseError s e l) a) -> ThenOk s l m a r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either (ParseError s e l) a
forall a b. b -> Either a b
Right) ThenErr s e l m r
puerr
    {-# INLINE observing #-}

    parseError :: forall a. ParseError s e l -> ParserT s e l m a
parseError ParseError s e l
e = Continuations s e l m a -> ParserT s e l m a
forall s e l (m :: * -> *) a.
Continuations s e l m a -> ParserT s e l m a
ParserT (Continuations s e l m a -> ParserT s e l m a)
-> Continuations s e l m a -> ParserT s e l m a
forall a b. (a -> b) -> a -> b
$ \State s
st ThenOk s l m a r
_ ThenErr s e l m r
_ ThenOk s l m a r
_ ThenErr s e l m r
uerr -> ThenErr s e l m r
uerr ParseError s e l
e State s
st
    {-# INLINE parseError #-}

    getState :: ParserT s e l m (State s)
getState = Continuations s e l m (State s) -> ParserT s e l m (State s)
forall s e l (m :: * -> *) a.
Continuations s e l m a -> ParserT s e l m a
ParserT (Continuations s e l m (State s) -> ParserT s e l m (State s))
-> Continuations s e l m (State s) -> ParserT s e l m (State s)
forall a b. (a -> b) -> a -> b
$ \State s
st ThenOk s l m (State s) r
_ ThenErr s e l m r
_ ThenOk s l m (State s) r
uok ThenErr s e l m r
_ -> ThenOk s l m (State s) r
uok State s
st [] State s
st
    {-# INLINE getState #-}

    putState :: State s -> ParserT s e l m ()
putState State s
st = Continuations s e l m () -> ParserT s e l m ()
forall s e l (m :: * -> *) a.
Continuations s e l m a -> ParserT s e l m a
ParserT (Continuations s e l m () -> ParserT s e l m ())
-> Continuations s e l m () -> ParserT s e l m ()
forall a b. (a -> b) -> a -> b
$ \State s
_ ThenOk s l m () r
_ ThenErr s e l m r
_ ThenOk s l m () r
uok ThenErr s e l m r
_ -> ThenOk s l m () r
uok () [] State s
st
    {-# INLINE putState #-}

-- | Allows for overloaded string literals to become parsers. This is equivalent to calling 'string'.
instance (Stream s, IsString a, Eq a, a ~ Chunk s) => IsString (ParserT s e l m a) where
    fromString :: String -> ParserT s e l m a
fromString String
xs = Chunk s -> ParserT s e l m (Chunk s)
forall s e l (m :: * -> *).
(MonadParser s e l m, Eq (Chunk s)) =>
Chunk s -> m (Chunk s)
string (String -> Chunk s
forall a. IsString a => String -> a
fromString String
xs)
    {-# INLINE fromString #-}

-- | Merges the labels from a parse error and the labels at some state together.
merge :: ParseError s e l -> State s -> [l] -> [l]
merge :: forall s e l. ParseError s e l -> State s -> [l] -> [l]
merge ParseError s e l
pe State s
qst [l]
ql =
        let pl :: [l]
pl = case ParseError s e l -> ErrorItem s e l
forall s e l. ParseError s e l -> ErrorItem s e l
parseErrorItem ParseError s e l
pe of
                ErrorItemLabels Unexpected s
_ [l]
ls -> [l]
ls
                ErrorItem s e l
_ -> [l]
forall a. Monoid a => a
mempty
        in case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ParseError s e l -> Int
forall s e l. ParseError s e l -> Int
parseErrorOffset ParseError s e l
pe) (State s -> Int
forall s. State s -> Int
stateOffset State s
qst) of
            Ordering
LT -> [l]
ql
            Ordering
EQ -> [l]
pl [l] -> [l] -> [l]
forall a. Semigroup a => a -> a -> a
<> [l]
ql
            Ordering
GT -> [l]
pl
{-# INLINE merge #-}

-- | Choose the longer matching state and merge the errors together.
choose :: (State s, ParseError s e l) -> (State s, ParseError s e l) -> (State s, ParseError s e l)
choose :: forall s e l.
(State s, ParseError s e l)
-> (State s, ParseError s e l) -> (State s, ParseError s e l)
choose (State s
pst, ParseError s e l
pe) (State s
qst, ParseError s e l
qe) =
    case Pos -> Pos -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (State s -> Pos
forall s. State s -> Pos
statePos State s
pst) (State s -> Pos
forall s. State s -> Pos
statePos State s
qst) of
        Ordering
GT -> (State s
pst, ParseError s e l
pe ParseError s e l -> ParseError s e l -> ParseError s e l
forall a. Semigroup a => a -> a -> a
<> ParseError s e l
qe)
        Ordering
_  -> (State s
qst, ParseError s e l
pe ParseError s e l -> ParseError s e l -> ParseError s e l
forall a. Semigroup a => a -> a -> a
<> ParseError s e l
qe)
{-# INLINE choose #-}

-- | Append labels to a success continuation.
withOk :: [l] -> ThenOk s l m a r -> ThenOk s l m a r
withOk :: forall l s (m :: * -> *) a r.
[l] -> ThenOk s l m a r -> ThenOk s l m a r
withOk [l]
ls1 ThenOk s l m a r
k = \a
a [l]
ls2 State s
st -> ThenOk s l m a r
k a
a ([l]
ls1 [l] -> [l] -> [l]
forall a. Semigroup a => a -> a -> a
<> [l]
ls2) State s
st
{-# INLINE withOk #-}

-- | Append labels to a failure continuation.
withErr :: [l] -> ThenErr s e l m r -> ThenErr s e l m r
withErr :: forall l s e (m :: * -> *) r.
[l] -> ThenErr s e l m r -> ThenErr s e l m r
withErr [l]
ls1 ThenErr s e l m r
k = \ParseError s e l
e State s
st -> case ParseError s e l
e of
    ParseError Pos
p Int
o (ErrorItemLabels Unexpected s
unex [l]
ls2) -> ThenErr s e l m r
k (Pos -> Int -> ErrorItem s e l -> ParseError s e l
forall s e l. Pos -> Int -> ErrorItem s e l -> ParseError s e l
ParseError Pos
p Int
o (Unexpected s -> [l] -> ErrorItem s e l
forall s e l. Unexpected s -> [l] -> ErrorItem s e l
ErrorItemLabels Unexpected s
unex ([l]
ls1 [l] -> [l] -> [l]
forall a. Semigroup a => a -> a -> a
<> [l]
ls2))) State s
st
    ParseError s e l
_ -> ThenErr s e l m r
k ParseError s e l
e State s
st
{-# INLINE withErr #-}

instance MonadTrans (ParserT s e l) where
    lift :: forall (m :: * -> *) a. Monad m => m a -> ParserT s e l m a
lift m a
m = Continuations s e l m a -> ParserT s e l m a
forall s e l (m :: * -> *) a.
Continuations s e l m a -> ParserT s e l m a
ParserT (Continuations s e l m a -> ParserT s e l m a)
-> Continuations s e l m a -> ParserT s e l m a
forall a b. (a -> b) -> a -> b
$ \State s
st ThenOk s l m a r
_ ThenErr s e l m r
_ ThenOk s l m a r
uok ThenErr s e l m r
_ -> m a
m m a -> (a -> m r) -> m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> ThenOk s l m a r
uok a
a [] State s
st
    {-# INLINE lift #-}

instance MonadIO m => MonadIO (ParserT s e l m) where
    liftIO :: forall a. IO a -> ParserT s e l m a
liftIO IO a
m = m a -> ParserT s e l m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
m)
    {-# INLINE liftIO #-}

instance MonadCont m => MonadCont (ParserT s e l m) where
    callCC :: forall a b.
((a -> ParserT s e l m b) -> ParserT s e l m a)
-> ParserT s e l m a
callCC (a -> ParserT s e l m b) -> ParserT s e l m a
k =
        (State s -> m (Reply s e l a)) -> ParserT s e l m a
forall (m :: * -> *) s e l a.
Monad m =>
(State s -> m (Reply s e l a)) -> ParserT s e l m a
makeParserT ((State s -> m (Reply s e l a)) -> ParserT s e l m a)
-> (State s -> m (Reply s e l a)) -> ParserT s e l m a
forall a b. (a -> b) -> a -> b
$ \State s
st ->
            ((Reply s e l a -> m (Reply s e l b)) -> m (Reply s e l a))
-> m (Reply s e l a)
forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
callCC (((Reply s e l a -> m (Reply s e l b)) -> m (Reply s e l a))
 -> m (Reply s e l a))
-> ((Reply s e l a -> m (Reply s e l b)) -> m (Reply s e l a))
-> m (Reply s e l a)
forall a b. (a -> b) -> a -> b
$ \Reply s e l a -> m (Reply s e l b)
c ->
                ParserT s e l m a -> State s -> m (Reply s e l a)
forall (m :: * -> *) s e l a.
Monad m =>
ParserT s e l m a -> State s -> m (Reply s e l a)
contParserT ((a -> ParserT s e l m b) -> ParserT s e l m a
k ((a -> ParserT s e l m b) -> ParserT s e l m a)
-> (a -> ParserT s e l m b) -> ParserT s e l m a
forall a b. (a -> b) -> a -> b
$ \a
a -> (State s -> m (Reply s e l b)) -> ParserT s e l m b
forall (m :: * -> *) s e l a.
Monad m =>
(State s -> m (Reply s e l a)) -> ParserT s e l m a
makeParserT ((State s -> m (Reply s e l b)) -> ParserT s e l m b)
-> (State s -> m (Reply s e l b)) -> ParserT s e l m b
forall a b. (a -> b) -> a -> b
$ \State s
st' -> Reply s e l a -> m (Reply s e l b)
c (Reply s e l a -> m (Reply s e l b))
-> Reply s e l a -> m (Reply s e l b)
forall a b. (a -> b) -> a -> b
$ State s -> Bool -> Either (ParseError s e l) a -> Reply s e l a
forall s e l a.
State s -> Bool -> Either (ParseError s e l) a -> Reply s e l a
Reply State s
st' Bool
False (a -> Either (ParseError s e l) a
forall a b. b -> Either a b
Right a
a)) State s
st
    {-# INLINE callCC #-}

instance MonadError err m => MonadError err (ParserT s e l m) where
    throwError :: forall a. err -> ParserT s e l m a
throwError err
e = m a -> ParserT s e l m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (err -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError err
e)
    {-# INLINE throwError #-}

    catchError :: forall a.
ParserT s e l m a
-> (err -> ParserT s e l m a) -> ParserT s e l m a
catchError ParserT s e l m a
p err -> ParserT s e l m a
h =
        (State s -> m (Reply s e l a)) -> ParserT s e l m a
forall (m :: * -> *) s e l a.
Monad m =>
(State s -> m (Reply s e l a)) -> ParserT s e l m a
makeParserT ((State s -> m (Reply s e l a)) -> ParserT s e l m a)
-> (State s -> m (Reply s e l a)) -> ParserT s e l m a
forall a b. (a -> b) -> a -> b
$ \State s
st ->
            m (Reply s e l a)
-> (err -> m (Reply s e l a)) -> m (Reply s e l a)
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (ParserT s e l m a -> State s -> m (Reply s e l a)
forall (m :: * -> *) s e l a.
Monad m =>
ParserT s e l m a -> State s -> m (Reply s e l a)
contParserT ParserT s e l m a
p State s
st) ((err -> m (Reply s e l a)) -> m (Reply s e l a))
-> (err -> m (Reply s e l a)) -> m (Reply s e l a)
forall a b. (a -> b) -> a -> b
$ \err
e ->
                ParserT s e l m a -> State s -> m (Reply s e l a)
forall (m :: * -> *) s e l a.
Monad m =>
ParserT s e l m a -> State s -> m (Reply s e l a)
contParserT (err -> ParserT s e l m a
h err
e) State s
st
    {-# INLINE catchError #-}

instance MonadReader r m => MonadReader r (ParserT s e l m) where
    ask :: ParserT s e l m r
ask = m r -> ParserT s e l m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
    {-# INLINE ask #-}

    local :: forall a. (r -> r) -> ParserT s e l m a -> ParserT s e l m a
local r -> r
f ParserT s e l m a
p = (State s -> m (Reply s e l a)) -> ParserT s e l m a
forall (m :: * -> *) s e l a.
Monad m =>
(State s -> m (Reply s e l a)) -> ParserT s e l m a
makeParserT ((State s -> m (Reply s e l a)) -> ParserT s e l m a)
-> (State s -> m (Reply s e l a)) -> ParserT s e l m a
forall a b. (a -> b) -> a -> b
$ \State s
st -> (r -> r) -> m (Reply s e l a) -> m (Reply s e l a)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f (ParserT s e l m a -> State s -> m (Reply s e l a)
forall (m :: * -> *) s e l a.
Monad m =>
ParserT s e l m a -> State s -> m (Reply s e l a)
contParserT ParserT s e l m a
p State s
st)
    {-# INLINE local #-}

instance MonadState st m => MonadState st (ParserT s e l m) where
    get :: ParserT s e l m st
get = m st -> ParserT s e l m st
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m st
forall s (m :: * -> *). MonadState s m => m s
get
    {-# INLINE get #-}

    put :: st -> ParserT s e l m ()
put st
st = m () -> ParserT s e l m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (st -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put st
st)
    {-# INLINE put #-}

instance MonadWriter w m => MonadWriter w (ParserT s e l m) where
    writer :: forall a. (a, w) -> ParserT s e l m a
writer (a, w)
m = m a -> ParserT s e l m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((a, w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer (a, w)
m)
    {-# INLINE writer #-}

    tell :: w -> ParserT s e l m ()
tell w
m = m () -> ParserT s e l m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell w
m)
    {-# INLINE tell #-}

    listen :: forall a. ParserT s e l m a -> ParserT s e l m (a, w)
listen ParserT s e l m a
p = (State s -> m (Reply s e l (a, w))) -> ParserT s e l m (a, w)
forall (m :: * -> *) s e l a.
Monad m =>
(State s -> m (Reply s e l a)) -> ParserT s e l m a
makeParserT ((State s -> m (Reply s e l (a, w))) -> ParserT s e l m (a, w))
-> (State s -> m (Reply s e l (a, w))) -> ParserT s e l m (a, w)
forall a b. (a -> b) -> a -> b
$ \State s
st -> m (Reply s e l a) -> m (Reply s e l (a, w))
forall {m :: * -> *} {b} {s} {e} {l} {a}.
MonadWriter b m =>
m (Reply s e l a) -> m (Reply s e l (a, b))
over (m (Reply s e l a) -> m (Reply s e l (a, w)))
-> m (Reply s e l a) -> m (Reply s e l (a, w))
forall a b. (a -> b) -> a -> b
$ ParserT s e l m a -> State s -> m (Reply s e l a)
forall (m :: * -> *) s e l a.
Monad m =>
ParserT s e l m a -> State s -> m (Reply s e l a)
contParserT ParserT s e l m a
p State s
st
        where
            over :: m (Reply s e l a) -> m (Reply s e l (a, b))
over m (Reply s e l a)
m = do
                (Reply s e l a
rep, b
w) <- m (Reply s e l a) -> m (Reply s e l a, b)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen m (Reply s e l a)
m
                Reply s e l (a, b) -> m (Reply s e l (a, b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Reply s e l (a, b) -> m (Reply s e l (a, b)))
-> Reply s e l (a, b) -> m (Reply s e l (a, b))
forall a b. (a -> b) -> a -> b
$! case Reply s e l a -> Either (ParseError s e l) a
forall s e l a. Reply s e l a -> Either (ParseError s e l) a
replyResult Reply s e l a
rep of
                    Left ParseError s e l
e  -> Reply s e l a
rep { replyResult :: Either (ParseError s e l) (a, b)
replyResult = ParseError s e l -> Either (ParseError s e l) (a, b)
forall a b. a -> Either a b
Left ParseError s e l
e }
                    Right a
a -> Reply s e l a
rep { replyResult :: Either (ParseError s e l) (a, b)
replyResult = (a, b) -> Either (ParseError s e l) (a, b)
forall a b. b -> Either a b
Right (a
a, b
w) }
    {-# INLINE listen #-}

    pass :: forall a. ParserT s e l m (a, w -> w) -> ParserT s e l m a
pass ParserT s e l m (a, w -> w)
p = (State s -> m (Reply s e l a)) -> ParserT s e l m a
forall (m :: * -> *) s e l a.
Monad m =>
(State s -> m (Reply s e l a)) -> ParserT s e l m a
makeParserT ((State s -> m (Reply s e l a)) -> ParserT s e l m a)
-> (State s -> m (Reply s e l a)) -> ParserT s e l m a
forall a b. (a -> b) -> a -> b
$ \State s
st -> m (Reply s e l (a, w -> w)) -> m (Reply s e l a)
forall {w} {m :: * -> *} {s} {e} {l} {a}.
MonadWriter w m =>
m (Reply s e l (a, w -> w)) -> m (Reply s e l a)
over (m (Reply s e l (a, w -> w)) -> m (Reply s e l a))
-> m (Reply s e l (a, w -> w)) -> m (Reply s e l a)
forall a b. (a -> b) -> a -> b
$ ParserT s e l m (a, w -> w)
-> State s -> m (Reply s e l (a, w -> w))
forall (m :: * -> *) s e l a.
Monad m =>
ParserT s e l m a -> State s -> m (Reply s e l a)
contParserT ParserT s e l m (a, w -> w)
p State s
st
        where
            over :: m (Reply s e l (a, w -> w)) -> m (Reply s e l a)
over m (Reply s e l (a, w -> w))
m = m (Reply s e l a, w -> w) -> m (Reply s e l a)
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass (m (Reply s e l a, w -> w) -> m (Reply s e l a))
-> m (Reply s e l a, w -> w) -> m (Reply s e l a)
forall a b. (a -> b) -> a -> b
$ do
                Reply s e l (a, w -> w)
rep <- m (Reply s e l (a, w -> w))
m
                (Reply s e l a, w -> w) -> m (Reply s e l a, w -> w)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Reply s e l a, w -> w) -> m (Reply s e l a, w -> w))
-> (Reply s e l a, w -> w) -> m (Reply s e l a, w -> w)
forall a b. (a -> b) -> a -> b
$! case Reply s e l (a, w -> w) -> Either (ParseError s e l) (a, w -> w)
forall s e l a. Reply s e l a -> Either (ParseError s e l) a
replyResult Reply s e l (a, w -> w)
rep of
                    Left ParseError s e l
e       -> (Reply s e l (a, w -> w)
rep { replyResult :: Either (ParseError s e l) a
replyResult = ParseError s e l -> Either (ParseError s e l) a
forall a b. a -> Either a b
Left ParseError s e l
e }, w -> w
forall a. a -> a
id)
                    Right (a
a, w -> w
f) -> (Reply s e l (a, w -> w)
rep { replyResult :: Either (ParseError s e l) a
replyResult = a -> Either (ParseError s e l) a
forall a b. b -> Either a b
Right a
a }, w -> w
f)
    {-# INLINE pass #-}

instance MonadRWS r w st m => MonadRWS r w st (ParserT s e l m)