LoginSignup
3

More than 5 years have passed since last update.

yieldのあるモナド

Posted at

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)

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
3