[Haskell-cafe] My try for a CoroutineT monad tranformer
David Menendez
dave at zednenem.com
Fri Apr 25 20:42:03 EDT 2008
On Fri, Apr 25, 2008 at 3:45 PM, Dan Weston <westondan at imageworks.com> wrote:
> Is there a Haskell Wiki page (or blog) on Monad Suspension? This looks like
> a nice paradigm that apfelmus points out "can be used to considerably
> shorten your code", but only if the rest of us learn how!
There are a few papers which deal with resumption monads, which appear
to be closely related.
You can also express CoroutineT (or something very much like it) using
a free monad.
data Term f a = Var a | Branch (f (Term f a))
instance Functor f => Monad (Term f) where
return = Var
Var a >>= f = f a
Branch as >>= f = Branch (fmap (>>= f) as)
lift :: (Functor f) => f a -> Term f a
lift m = Branch (fmap Var m)
runTerm :: (Monad m) => Term m () -> m (Maybe (Term m ()))
runTerm (Var ()) = return Nothing
runTerm (Branch m) = fmap Just m
pause :: (Monad m) => Term m ()
pause = Branch (return (Var ()))
Note that runTerm and pause really only require Applicative.
I believe Suspend can be implemented similarly. Note that "SuspendT v
m a" is isomorphic to "m (Term (ReaderT v m) a)".
--
Dave Menendez <dave at zednenem.com>
<http://www.eyrie.org/~zednenem/>
More information about the Haskell-Cafe
mailing list