{-# 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' h hS ind = go True where go :: forall x. Bool -> ParsecDSL s u m x -> P.ParsecT s u m x go True (ParsecDSL (Pure x)) = h True (Preturn x) (return x) go b (ParsecDSL prs) = iterM phi prs where phi :: forall y. ParsecF s u m (P.ParsecT s u m y) -> P.ParsecT s u m y phi z = case z of Plifted p k -> h False z p >>= k Preturn k -> h b z (return ()) >> k Pbind k -> h False z (return ()) >> k Peffect m k -> h b z (lift m) >>= k Pquiet p k -> h False z (go False p) >>= k PgetState k -> h b z P.getState >>= k PputState u k -> h b z (P.putState u) >> k PmodifyState g k -> h b z (P.modifyState g) >> k PgetPosition k -> h b z P.getPosition >>= k PsetPosition p k -> h b z (P.setPosition p) >> k PgetInput k -> h b z P.getInput >>= k PsetInput s k -> h b z (P.setInput s) >> k PgetParserState k -> h b z P.getParserState >>= k PsetParserState s k -> h b z (P.setParserState s) >>= k PupdateParserState g k -> h b z (P.updateParserState g) >>= k Ptokens a e c k -> h b z (P.tokens a e c) >>= k PtokenPrimEx a e c d k -> h b z (P.tokenPrimEx a e c d) >>= k PalphaNum k -> hS b z P.alphaNum >>= k PanyChar k -> hS b z P.anyChar >>= k PanyToken k -> hS b z P.anyToken >>= k Pchar c k -> h b z (P.char c) >> k Pcrlf k -> hS b z P.crlf >>= k Pdigit k -> hS b z P.digit >>= k PendOfLine k -> hS b z P.endOfLine >>= k Peof k -> hS b z (P.eof @_ @_ @t) >> k PhexDigit k -> hS b z P.hexDigit >>= k Pletter k -> hS b z P.letter >>= k Plower k -> hS b z P.lower >>= k Pnewline k -> hS b z P.newline >>= k PnoneOf xs k -> hS b z (P.noneOf xs) >>= k PoctDigit k -> hS b z P.octDigit >>= k PoneOf xs k -> hS b z (P.oneOf xs) >>= k Psatisfy g k -> hS b z (P.satisfy g) >>= k Pspace k -> hS b z P.space >>= k Pspaces k -> hS b z P.spaces >> k Pstring s k -> h b z (P.string s) >> k Ptab k -> hS b z P.tab >>= k Pupper k -> hS b z P.upper >>= k PparserFail s -> h b z (P.parserFail s) PparserZero -> h b z P.parserZero Punexpected s -> h b z (P.unexpected s) PparserPlus p q k -> h b z (P.parserPlus (ind True (go b p)) (ind True (go b q))) >>= k Plabel p a k -> h b z (ind False (P.label (go b p) a)) >>= k Plabels p a k -> h b z (ind False (P.labels (go b p) a)) >>= k Ptry p k -> h b z (ind False (P.try (go b p))) >>= k Pchainl p q a k -> h b z (P.chainl (ind True (go b p)) (ind True (go b q)) a) >>= k Pchainl1 p q k -> h b z (P.chainl1 (ind True (go b p)) (ind True (go b q))) >>= k Pchainr p q a k -> h b z (P.chainr (ind True (go b p)) (ind True (go b q)) a) >>= k Pchainr1 p q k -> h b z (P.chainr1 (ind True (go b p)) (ind True (go b q))) >>= k Pchoice xs k -> h b z (P.choice (map (ind True . go b) xs)) >>= k Pcount n p k -> h b z (P.count n (ind True (go b p))) >>= k PlookAhead p k -> h b z (ind False (P.lookAhead (go b p))) >>= k Pmany p k -> h b z (P.many (ind True (go b p))) >>= k Pmany1 p k -> h b z (P.many1 (ind True (go b p))) >>= k PmanyAccum acc p k -> h b z (P.manyAccum acc (ind True (go b p))) >>= k PnotFollowedBy p k -> h b z (ind False (P.notFollowedBy (go b p))) >> k Poption a p k -> h b z (ind False (P.option a (go b p))) >>= k PoptionMaybe p k -> h b z (ind False (P.optionMaybe (go b p))) >>= k Poptional p k -> h b z (ind False (P.optional (go b p))) >> k PskipMany p k -> h b z (P.skipMany (ind True (go b p))) >> k PskipMany1 p k -> h b z (P.skipMany1 (ind True (go b p))) >> k PmanyTill p e k -> h b z (P.manyTill (ind True (go b p)) (ind True (go b e))) >>= k Pbetween o c p k -> h b z (P.between (ind True (go b o)) (ind True (go b c)) (ind True (go b p))) >>= k PendBy p s k -> h b z (P.endBy (ind True (go b p)) (ind True (go b s))) >>= k PendBy1 p s k -> h b z (P.endBy1 (ind True (go b p)) (ind True (go b s))) >>= k PsepBy p s k -> h b z (P.sepBy (ind True (go b p)) (ind True (go b s))) >>= k PsepBy1 p s k -> h b z (P.sepBy1 (ind True (go b p)) (ind True (go b s))) >>= k PsepEndBy p s k -> h b z (P.sepEndBy (ind True (go b p)) (ind True (go b s))) >>= k PsepEndBy1 p s k -> h b z (P.sepEndBy1 (ind True (go b p)) (ind True (go b s))) >>= k Pidentifier d k -> hS b z (go False d) >>= k Preserved d _ k -> h b z (go False d) >> k Poperator d k -> hS b z (go False d) >>= k PreservedOp d _ k -> h b z (go False d) >> k PcharLiteral d k -> hS b z (go False d) >>= k PstringLiteral d k -> hS b z (go False d) >>= k Pnatural d k -> hS b z (go False d) >>= k Pinteger d k -> hS b z (go False d) >>= k Pfloat d k -> hS b z (go False d) >>= k PnaturalOrFloat d k -> hS b z (go False d) >>= k Pdecimal d k -> hS b z (go False d) >>= k Phexadecimal d k -> hS b z (go False d) >>= k Poctal d k -> hS b z (go False d) >>= k Psymbol d _ k -> h b z (go False d) >>= k Plexeme d k -> h b z (go False d) >>= k PwhiteSpace d k -> hS b z (go False d) >> k Pparens p k -> h b z (ind False (go b p)) >>= k Pbraces p k -> h b z (ind False (go b p)) >>= k Pangles p k -> h b z (ind False (go b p)) >>= k Pbrackets p k -> h b z (ind False (go b p)) >>= k Psquares p k -> h b z (ind False (go b p)) >>= k Psemi p k -> h b z (ind False (go b p)) >>= k Pcomma p k -> h b z (ind False (go b p)) >>= k Pcolon p k -> h b z (ind False (go b p)) >>= k Pdot p k -> h b z (ind False (go b p)) >>= k PsemiSep p k -> h b z (ind True (go b p)) >>= k PsemiSep1 p k -> h b z (ind True (go b p)) >>= k PcommaSep p k -> h b z (ind True (go b p)) >>= k PcommaSep1 p k -> h b z (ind True (go b p)) >>= 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 = eval' (const (const id)) (const (const id)) (const id)