From 886eec4cb2bd5fca6d3d627c1d054c244a3d5273 Mon Sep 17 00:00:00 2001 From: Ellie Hermaszewska Date: Sat, 13 May 2023 11:53:10 +0800 Subject: [PATCH] Make ResultsCont operate over lists --- Text/Earley/Parser/Internal.hs | 28 ++++++++++++++++------------ 1 file changed, 16 insertions(+), 12 deletions(-) diff --git a/Text/Earley/Parser/Internal.hs b/Text/Earley/Parser/Internal.hs index 7d031a1..1ceb61f 100644 --- a/Text/Earley/Parser/Internal.hs +++ b/Text/Earley/Parser/Internal.hs @@ -122,25 +122,29 @@ data State s r e t a where -> State s r e t c Final :: !(Results s a) -> State s r e t a -newtype ResultsCont s a b = ResultsCont {unResultsCont :: a -> Results s b} +newtype ResultsCont s a b = ResultsCont {unResultsCont :: [a] -> Results s b} deriving(Functor) -instance Applicative (ResultsCont s a) where - pure = ResultsCont . const . pure - ResultsCont f <*> ResultsCont x = ResultsCont (\a -> f a <*> x a) +instance Category (ResultsCont s) where + id = ResultsCont (Results . pure) + ResultsCont f . ResultsCont g = ResultsCont $ \xs -> Results $ do + ys <- unResults (g xs) + unResults (f ys) -instance Monad (ResultsCont s a) where - ResultsCont x >>= k = ResultsCont (\a -> ($ a) . unResultsCont . k =<< x a) +resultArr' :: ([a] -> [b]) -> ResultsCont s a b +resultArr' f = ResultsCont (Results . pure . f) -instance Category (ResultsCont s) where - id = ResultsCont pure - ResultsCont f . ResultsCont g = ResultsCont (f <=< g) +resultArrs :: [a -> b] -> ResultsCont s a b +resultArrs f = ResultsCont (Results . pure . liftA2 ($) f) -resultArr :: (a -> b) -> ResultsCont s a b -resultArr f = ResultsCont (pure . f) +resultArrs' :: [[a] -> [b]] -> ResultsCont s a b +resultArrs' f = ResultsCont (Results . pure . go) + where go x = ($ x) =<< f resultBind :: ResultsCont s a b -> Results s a -> Results s b -resultBind (ResultsCont f) x = f =<< x +resultBind (ResultsCont f) (Results x) = Results $ do + y <- x + unResults (f y) manyResults :: [a] -> Results s a manyResults = Results. pure