rubyのyieldの再現。
クロージャを毎度作る感じでできないか試していたらコンパイルが通りました。
Main.hs
import Yield
main = print $ collect $ do
yield 1
yield 2
yield 3
collect :: Yield () y a -> [y]
collect m = fst $ foldYield cons [] m
where
cons ys y = (y:ys, ())
Yield.hs
data Yield x y a = Yield y (x -> Yield x y a) | Stop a
instance Monad (Yield x y) where
return = Stop
Yield y c >>= f = Yield y ((>>= f) . c)
Stop a >>= f = f a
yield :: y -> Yield x y x
yield y = Yield y return
foldYield :: (a -> y -> (a, x)) -> a -> Yield x y b -> (a, b)
foldYield _ a (Stop b) = (a, b)
foldYield f a (Yield y c) = let (a', x) = f a y in foldYield f a' $ c x
モナド変換子版。
YieldT.hs
newtype YieldT x y m a = YieldT { runYieldT :: m (Either (y, x -> YieldT x y m a) a) }
instance (Monad m) => Monad (YieldT x y m) where
return a = YieldT $ return $ Right a
m >>= f = YieldT $ do
p <- runYieldT m
case p of
Right a -> runYieldT $ f a
Left (y, c) -> return $ Left (y, (>>= f) . c)
instance MonadTrans (YieldT x y) where
lift = YieldT . liftM Right
yieldT :: (Monad m) => y -> YieldT x y m x
yieldT y = YieldT $ return $ Left (y, return)
foldYieldT :: (Monad m) => (a -> y -> m (a, x)) -> a -> YieldT x y m b -> m (a, b)
foldYieldT f a m = do
p <- runYieldT m
case p of
Right b -> return (a, b)
Left (y, c) -> do
(a', x) <- f a y
foldYieldT f a' (c x)