{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Text.Parsec.Free.Eval where

import                    Control.Monad.Free
import                    Control.Monad.Trans.Class
import qualified "parsec" Text.Parsec.Char as P
import qualified "parsec" Text.Parsec.Combinator as P
import                    Text.Parsec.Free
import qualified "parsec" Text.Parsec.Prim as P

eval' :: forall s u m t a. (Show t, P.Stream s m t)
      => (forall u' b c. Bool -> ParsecF s u' m c -> P.ParsecT s u m b
              -> P.ParsecT s u m b)
      -> (forall u' b c. Show b => Bool -> ParsecF s u' m c -> P.ParsecT s u m b
              -> P.ParsecT s u m b)
      -> (forall b. Bool -> P.ParsecT s u m b -> P.ParsecT s u m b)
      -> ParsecDSL s u m a -> P.ParsecT s u m a
eval' :: forall s u (m :: * -> *) t a.
(Show t, Stream s m t) =>
(forall u' b c.
 Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b)
-> (forall u' b c.
    Show b =>
    Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b)
-> (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b)
-> ParsecDSL s u m a
-> ParsecT s u m a
eval' forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind = forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
True
  where
    go :: forall x. Bool -> ParsecDSL s u m x -> P.ParsecT s u m x
    go :: forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
True (ParsecDSL (Pure x
x)) = forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
True (forall s u (m :: * -> *) r. r -> ParsecF s u m r
Preturn x
x) (forall (m :: * -> *) a. Monad m => a -> m a
return x
x)
    go Bool
b (ParsecDSL Free (ParsecF s u m) x
prs) = forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
(f (m a) -> m a) -> Free f a -> m a
iterM forall y. ParsecF s u m (ParsecT s u m y) -> ParsecT s u m y
phi Free (ParsecF s u m) x
prs
      where
        phi :: forall y. ParsecF s u m (P.ParsecT s u m y) -> P.ParsecT s u m y
        phi :: forall y. ParsecF s u m (ParsecT s u m y) -> ParsecT s u m y
phi ParsecF s u m (ParsecT s u m y)
z = case ParsecF s u m (ParsecT s u m y)
z of
            Plifted ParsecT s u m a
p a -> ParsecT s u m y
k            -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
False ParsecF s u m (ParsecT s u m y)
z ParsecT s u m a
p            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ParsecT s u m y
k
            Preturn ParsecT s u m y
k              -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall (m :: * -> *) a. Monad m => a -> m a
return ())      forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  ParsecT s u m y
k
            Pbind ParsecT s u m y
k                -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
False ParsecF s u m (ParsecT s u m y)
z (forall (m :: * -> *) a. Monad m => a -> m a
return ())  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  ParsecT s u m y
k
            Peffect m a
m a -> ParsecT s u m y
k            -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
m)         forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ParsecT s u m y
k
            Pquiet ParsecDSL s u m a
p a -> ParsecT s u m y
k             -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
False ParsecF s u m (ParsecT s u m y)
z (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
False ParsecDSL s u m a
p) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ParsecT s u m y
k

            PgetState u -> ParsecT s u m y
k            -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z forall (m :: * -> *) s u. Monad m => ParsecT s u m u
P.getState        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= u -> ParsecT s u m y
k
            PputState u
u ParsecT s u m y
k          -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
P.putState u
u)    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  ParsecT s u m y
k
            PmodifyState u -> u
g ParsecT s u m y
k       -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
P.modifyState u -> u
g) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  ParsecT s u m y
k

            PgetPosition SourcePos -> ParsecT s u m y
k         -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
P.getPosition     forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SourcePos -> ParsecT s u m y
k
            PsetPosition SourcePos
p ParsecT s u m y
k       -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
P.setPosition SourcePos
p) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  ParsecT s u m y
k

            PgetInput s -> ParsecT s u m y
k            -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z forall (m :: * -> *) s u. Monad m => ParsecT s u m s
P.getInput     forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> ParsecT s u m y
k
            PsetInput s
s ParsecT s u m y
k          -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
P.setInput s
s) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  ParsecT s u m y
k

            PgetParserState State s u -> ParsecT s u m y
k      -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z forall (m :: * -> *) s u. Monad m => ParsecT s u m (State s u)
P.getParserState        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= State s u -> ParsecT s u m y
k
            PsetParserState State s u
s State s u -> ParsecT s u m y
k    -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall (m :: * -> *) s u.
Monad m =>
State s u -> ParsecT s u m (State s u)
P.setParserState State s u
s)    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= State s u -> ParsecT s u m y
k
            PupdateParserState State s u -> State s u
g State s u -> ParsecT s u m y
k -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s u (m :: * -> *).
(State s u -> State s u) -> ParsecT s u m (State s u)
P.updateParserState State s u -> State s u
g) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= State s u -> ParsecT s u m y
k

            Ptokens [t] -> String
a SourcePos -> [t] -> SourcePos
e [t]
c [t] -> ParsecT s u m y
k        -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s (m :: * -> *) t u.
(Stream s m t, Eq t) =>
([t] -> String)
-> (SourcePos -> [t] -> SourcePos) -> [t] -> ParsecT s u m [t]
P.tokens [t] -> String
a SourcePos -> [t] -> SourcePos
e [t]
c)        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [t] -> ParsecT s u m y
k
            PtokenPrimEx t -> String
a SourcePos -> t -> s -> SourcePos
e Maybe (SourcePos -> t -> s -> u -> u)
c t -> Maybe a
d a -> ParsecT s u m y
k -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s (m :: * -> *) t u a.
Stream s m t =>
(t -> String)
-> (SourcePos -> t -> s -> SourcePos)
-> Maybe (SourcePos -> t -> s -> u -> u)
-> (t -> Maybe a)
-> ParsecT s u m a
P.tokenPrimEx t -> String
a SourcePos -> t -> s -> SourcePos
e Maybe (SourcePos -> t -> s -> u -> u)
c t -> Maybe a
d) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ParsecT s u m y
k

            PalphaNum Char -> ParsecT s u m y
k            -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.alphaNum    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> ParsecT s u m y
k
            PanyChar Char -> ParsecT s u m y
k             -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.anyChar     forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> ParsecT s u m y
k
            PanyToken t -> ParsecT s u m y
k            -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
P.anyToken    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= t -> ParsecT s u m y
k
            Pchar Char
c ParsecT s u m y
k              -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h  Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
c)    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  ParsecT s u m y
k
            Pcrlf Char -> ParsecT s u m y
k                -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.crlf        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> ParsecT s u m y
k
            Pdigit Char -> ParsecT s u m y
k               -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit       forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> ParsecT s u m y
k
            PendOfLine Char -> ParsecT s u m y
k           -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.endOfLine   forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> ParsecT s u m y
k
            Peof ParsecT s u m y
k                 -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
P.eof @_ @_ @t) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  ParsecT s u m y
k
            PhexDigit Char -> ParsecT s u m y
k            -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.hexDigit    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> ParsecT s u m y
k
            Pletter Char -> ParsecT s u m y
k              -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.letter      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> ParsecT s u m y
k
            Plower Char -> ParsecT s u m y
k               -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.lower       forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> ParsecT s u m y
k
            Pnewline Char -> ParsecT s u m y
k             -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.newline     forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> ParsecT s u m y
k
            PnoneOf String
xs Char -> ParsecT s u m y
k           -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.noneOf String
xs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> ParsecT s u m y
k
            PoctDigit Char -> ParsecT s u m y
k            -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.octDigit    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> ParsecT s u m y
k
            PoneOf String
xs Char -> ParsecT s u m y
k            -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
xs)  forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> ParsecT s u m y
k
            Psatisfy Char -> Bool
g Char -> ParsecT s u m y
k           -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
P.satisfy Char -> Bool
g) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> ParsecT s u m y
k
            Pspace Char -> ParsecT s u m y
k               -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.space       forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> ParsecT s u m y
k
            Pspaces ParsecT s u m y
k              -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces      forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  ParsecT s u m y
k
            Pstring String
s ParsecT s u m y
k            -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h  Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
s)  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  ParsecT s u m y
k
            Ptab Char -> ParsecT s u m y
k                 -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.tab         forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> ParsecT s u m y
k
            Pupper Char -> ParsecT s u m y
k               -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.upper       forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> ParsecT s u m y
k

            PparserFail String
s          -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s u (m :: * -> *) a. String -> ParsecT s u m a
P.parserFail String
s)
            ParsecF s u m (ParsecT s u m y)
PparserZero            -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z forall s u (m :: * -> *) a. ParsecT s u m a
P.parserZero
            Punexpected String
s          -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
P.unexpected String
s)

            PparserPlus ParsecDSL s u m a
p ParsecDSL s u m a
q a -> ParsecT s u m y
k      -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.parserPlus (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p))
                                                         (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
q)))     forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ParsecT s u m y
k
            Plabel ParsecDSL s u m a
p String
a a -> ParsecT s u m y
k           -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
False (forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
P.label (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p) String
a))       forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ParsecT s u m y
k
            Plabels ParsecDSL s u m a
p [String]
a a -> ParsecT s u m y
k          -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
False (forall s u (m :: * -> *) a.
ParsecT s u m a -> [String] -> ParsecT s u m a
P.labels (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p) [String]
a))      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ParsecT s u m y
k
            Ptry ParsecDSL s u m a
p a -> ParsecT s u m y
k               -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
False (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p)))           forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ParsecT s u m y
k
            Pchainl ParsecDSL s u m a
p ParsecDSL s u m (a -> a -> a)
q a
a a -> ParsecT s u m y
k        -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a
-> ParsecT s u m (a -> a -> a) -> a -> ParsecT s u m a
P.chainl (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p))
                                                     (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m (a -> a -> a)
q)) a
a)       forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ParsecT s u m y
k
            Pchainl1 ParsecDSL s u m a
p ParsecDSL s u m (a -> a -> a)
q a -> ParsecT s u m y
k         -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a
P.chainl1 (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p))
                                                      (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m (a -> a -> a)
q)))        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ParsecT s u m y
k
            Pchainr ParsecDSL s u m a
p ParsecDSL s u m (a -> a -> a)
q a
a a -> ParsecT s u m y
k        -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a
-> ParsecT s u m (a -> a -> a) -> a -> ParsecT s u m a
P.chainr (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p))
                                                     (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m (a -> a -> a)
q)) a
a)       forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ParsecT s u m y
k
            Pchainr1 ParsecDSL s u m a
p ParsecDSL s u m (a -> a -> a)
q a -> ParsecT s u m y
k         -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a
P.chainr1 (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p))
                                                      (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m (a -> a -> a)
q)))        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ParsecT s u m y
k
            Pchoice [ParsecDSL s u m a]
xs a -> ParsecT s u m y
k           -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
P.choice (forall a b. (a -> b) -> [a] -> [b]
map (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b) [ParsecDSL s u m a]
xs))  forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ParsecT s u m y
k
            Pcount Int
n ParsecDSL s u m a
p [a] -> ParsecT s u m y
k           -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
P.count Int
n (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p)))       forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [a] -> ParsecT s u m y
k
            PlookAhead ParsecDSL s u m a
p a -> ParsecT s u m y
k         -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
False (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
P.lookAhead (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p)))     forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ParsecT s u m y
k
            Pmany ParsecDSL s u m a
p [a] -> ParsecT s u m y
k              -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p)))           forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [a] -> ParsecT s u m y
k
            Pmany1 ParsecDSL s u m a
p [a] -> ParsecT s u m y
k             -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p)))          forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [a] -> ParsecT s u m y
k
            PmanyAccum a -> [a] -> [a]
acc ParsecDSL s u m a
p [a] -> ParsecT s u m y
k     -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall a s u (m :: * -> *).
(a -> [a] -> [a]) -> ParsecT s u m a -> ParsecT s u m [a]
P.manyAccum a -> [a] -> [a]
acc (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p)))  forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [a] -> ParsecT s u m y
k
            PnotFollowedBy ParsecDSL s u m a
p ParsecT s u m y
k     -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
False (forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
P.notFollowedBy (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p))) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  ParsecT s u m y
k
            Poption a
a ParsecDSL s u m a
p a -> ParsecT s u m y
k          -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
False (forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option a
a (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p)))      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ParsecT s u m y
k
            PoptionMaybe ParsecDSL s u m a
p Maybe a -> ParsecT s u m y
k       -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
False (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
P.optionMaybe (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p)))   forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe a -> ParsecT s u m y
k
            Poptional ParsecDSL s u m a
p ParsecT s u m y
k          -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
False (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
P.optional (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p)))      forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  ParsecT s u m y
k
            PskipMany ParsecDSL s u m a
p ParsecT s u m y
k          -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
P.skipMany (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p)))       forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  ParsecT s u m y
k
            PskipMany1 ParsecDSL s u m a
p ParsecT s u m y
k         -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
P.skipMany1 (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p)))      forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  ParsecT s u m y
k
            PmanyTill ParsecDSL s u m a
p ParsecDSL s u m end
e [a] -> ParsecT s u m y
k        -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
P.manyTill (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p))
                                                       (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m end
e)))       forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [a] -> ParsecT s u m y
k
            Pbetween ParsecDSL s u m open
o ParsecDSL s u m close
c ParsecDSL s u m a
p a -> ParsecT s u m y
k       -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
P.between (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m open
o))
                                                      (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m close
c))
                                                      (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p)))        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ParsecT s u m y
k
            PendBy ParsecDSL s u m a
p ParsecDSL s u m sep
s [a] -> ParsecT s u m y
k           -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
P.endBy (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p))
                                                    (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m sep
s)))          forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [a] -> ParsecT s u m y
k
            PendBy1 ParsecDSL s u m a
p ParsecDSL s u m sep
s [a] -> ParsecT s u m y
k          -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
P.endBy1 (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p))
                                                     (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m sep
s)))         forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [a] -> ParsecT s u m y
k
            PsepBy ParsecDSL s u m a
p ParsecDSL s u m sep
s [a] -> ParsecT s u m y
k           -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
P.sepBy (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p))
                                                    (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m sep
s)))          forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [a] -> ParsecT s u m y
k
            PsepBy1 ParsecDSL s u m a
p ParsecDSL s u m sep
s [a] -> ParsecT s u m y
k          -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
P.sepBy1 (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p))
                                                     (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m sep
s)))         forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [a] -> ParsecT s u m y
k
            PsepEndBy ParsecDSL s u m a
p ParsecDSL s u m sep
s [a] -> ParsecT s u m y
k        -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
P.sepEndBy (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p))
                                                       (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m sep
s)))       forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [a] -> ParsecT s u m y
k
            PsepEndBy1 ParsecDSL s u m a
p ParsecDSL s u m sep
s [a] -> ParsecT s u m y
k       -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
P.sepEndBy1 (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p))
                                                        (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m sep
s)))      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [a] -> ParsecT s u m y
k

            Pidentifier ParsecDSL s u m String
d String -> ParsecT s u m y
k        -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
False ParsecDSL s u m String
d) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ParsecT s u m y
k
            Preserved ParsecDSL s u m ()
d String
_ ParsecT s u m y
k        -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h  Bool
b ParsecF s u m (ParsecT s u m y)
z (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
False ParsecDSL s u m ()
d) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  ParsecT s u m y
k
            Poperator ParsecDSL s u m String
d String -> ParsecT s u m y
k          -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
False ParsecDSL s u m String
d) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ParsecT s u m y
k
            PreservedOp ParsecDSL s u m ()
d String
_ ParsecT s u m y
k      -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h  Bool
b ParsecF s u m (ParsecT s u m y)
z (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
False ParsecDSL s u m ()
d) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  ParsecT s u m y
k
            PcharLiteral ParsecDSL s u m Char
d Char -> ParsecT s u m y
k       -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
False ParsecDSL s u m Char
d) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> ParsecT s u m y
k
            PstringLiteral ParsecDSL s u m String
d String -> ParsecT s u m y
k     -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
False ParsecDSL s u m String
d) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ParsecT s u m y
k
            Pnatural ParsecDSL s u m Integer
d Integer -> ParsecT s u m y
k           -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
False ParsecDSL s u m Integer
d) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Integer -> ParsecT s u m y
k
            Pinteger ParsecDSL s u m Integer
d Integer -> ParsecT s u m y
k           -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
False ParsecDSL s u m Integer
d) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Integer -> ParsecT s u m y
k
            Pfloat ParsecDSL s u m Double
d Double -> ParsecT s u m y
k             -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
False ParsecDSL s u m Double
d) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Double -> ParsecT s u m y
k
            PnaturalOrFloat ParsecDSL s u m (Either Integer Double)
d Either Integer Double -> ParsecT s u m y
k    -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
False ParsecDSL s u m (Either Integer Double)
d) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either Integer Double -> ParsecT s u m y
k
            Pdecimal ParsecDSL s u m Integer
d Integer -> ParsecT s u m y
k           -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
False ParsecDSL s u m Integer
d) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Integer -> ParsecT s u m y
k
            Phexadecimal ParsecDSL s u m Integer
d Integer -> ParsecT s u m y
k       -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
False ParsecDSL s u m Integer
d) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Integer -> ParsecT s u m y
k
            Poctal ParsecDSL s u m Integer
d Integer -> ParsecT s u m y
k             -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
False ParsecDSL s u m Integer
d) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Integer -> ParsecT s u m y
k
            Psymbol ParsecDSL s u m String
d String
_ String -> ParsecT s u m y
k          -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h  Bool
b ParsecF s u m (ParsecT s u m y)
z (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
False ParsecDSL s u m String
d) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ParsecT s u m y
k
            Plexeme ParsecDSL s u m a
d a -> ParsecT s u m y
k            -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h  Bool
b ParsecF s u m (ParsecT s u m y)
z (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
False ParsecDSL s u m a
d) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ParsecT s u m y
k
            PwhiteSpace ParsecDSL s u m ()
d ParsecT s u m y
k        -> forall u' b c.
Show b =>
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
hS Bool
b ParsecF s u m (ParsecT s u m y)
z (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
False ParsecDSL s u m ()
d) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  ParsecT s u m y
k

            Pparens ParsecDSL s u m a
p a -> ParsecT s u m y
k            -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
False (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ParsecT s u m y
k
            Pbraces ParsecDSL s u m a
p a -> ParsecT s u m y
k            -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
False (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ParsecT s u m y
k
            Pangles ParsecDSL s u m a
p a -> ParsecT s u m y
k            -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
False (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ParsecT s u m y
k
            Pbrackets ParsecDSL s u m a
p a -> ParsecT s u m y
k          -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
False (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ParsecT s u m y
k
            Psquares ParsecDSL s u m a
p a -> ParsecT s u m y
k           -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
False (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m a
p)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ParsecT s u m y
k
            Psemi ParsecDSL s u m String
p String -> ParsecT s u m y
k              -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
False (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m String
p)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ParsecT s u m y
k
            Pcomma ParsecDSL s u m String
p String -> ParsecT s u m y
k             -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
False (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m String
p)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ParsecT s u m y
k
            Pcolon ParsecDSL s u m String
p String -> ParsecT s u m y
k             -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
False (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m String
p)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ParsecT s u m y
k
            Pdot ParsecDSL s u m String
p String -> ParsecT s u m y
k               -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
False (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m String
p)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ParsecT s u m y
k
            PsemiSep ParsecDSL s u m [a]
p [a] -> ParsecT s u m y
k           -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m [a]
p)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [a] -> ParsecT s u m y
k
            PsemiSep1 ParsecDSL s u m [a]
p [a] -> ParsecT s u m y
k          -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m [a]
p)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [a] -> ParsecT s u m y
k
            PcommaSep ParsecDSL s u m [a]
p [a] -> ParsecT s u m y
k          -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m [a]
p)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [a] -> ParsecT s u m y
k
            PcommaSep1 ParsecDSL s u m [a]
p [a] -> ParsecT s u m y
k         -> forall u' b c.
Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b
h Bool
b ParsecF s u m (ParsecT s u m y)
z (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b
ind Bool
True (forall x. Bool -> ParsecDSL s u m x -> ParsecT s u m x
go Bool
b ParsecDSL s u m [a]
p)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [a] -> ParsecT s u m y
k

eval :: forall s u m t a. (Show t, P.Stream s m t) => ParsecDSL s u m a -> P.ParsecT s u m a
eval :: forall s u (m :: * -> *) t a.
(Show t, Stream s m t) =>
ParsecDSL s u m a -> ParsecT s u m a
eval = forall s u (m :: * -> *) t a.
(Show t, Stream s m t) =>
(forall u' b c.
 Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b)
-> (forall u' b c.
    Show b =>
    Bool -> ParsecF s u' m c -> ParsecT s u m b -> ParsecT s u m b)
-> (forall b. Bool -> ParsecT s u m b -> ParsecT s u m b)
-> ParsecDSL s u m a
-> ParsecT s u m a
eval' (forall a b. a -> b -> a
const (forall a b. a -> b -> a
const forall a. a -> a
id)) (forall a b. a -> b -> a
const (forall a b. a -> b -> a
const forall a. a -> a
id)) (forall a b. a -> b -> a
const forall a. a -> a
id)