module Annotations.MultiRec.ParserCombinators (YP, mkBounded, unit, chainr, chainl) where
import Annotations.Bounds
import Annotations.BoundsParser
import Annotations.MultiRec.Yield
import Control.Monad.Trans
import qualified Text.Parsec as P
import Generics.MultiRec hiding (show)
import Data.Function
type YP s fam m = P s (YieldT Bounds fam m)
unit :: (Fam fam, EqS fam, HFunctor fam (PF fam), Monad m) =>
fam a ->
YP s fam m a ->
YP s fam m a
unit w p = do
left <- getPos
x <- p
mkBounded w left x
mkBounded :: (Fam fam, EqS fam, HFunctor fam (PF fam), Monad m) => fam a -> Range -> a -> YP s fam m a
mkBounded w left x = do
right <- getPos
lift $ yield w (Bounds left right) x
chainr :: (Fam fam, EqS fam, HFunctor fam (PF fam), Monad m, Show a) =>
fam a -> YP s fam m a -> YP s fam m (a -> a -> a) -> YP s fam m a
chainr w px pf = fix $ \loop -> do
left <- getPos
x <- px
P.option x $ do
f <- pf
y <- loop
mkBounded w left (f x y)
chainl :: (Fam fam, EqS fam, HFunctor fam (PF fam), Monad m, Show a) =>
fam a -> YP s fam m a -> YP s fam m (a -> a -> a) -> YP s fam m a
chainl w px pf = do
left <- getPos
px >>= rest left
where
rest left = fix $ \loop x -> P.option x $ do
f <- pf
y <- px
mkBounded w left (f x y) >>= loop