module Control.Monad.Resumable.Class where
import Control.Monad.RWS
import Control.Monad.Reader
import Control.Monad.Writer
import Control.Monad.State
import Control.Monad.Error
import Control.Monad.Cont
class Monad m => MonadResumable req res m | m -> req res where
yield :: req -> (res -> m a) -> m a
handle :: m a -> (req -> (res -> m a) -> m a) -> m a
signal :: (MonadResumable req res m) => req -> m res
signal req = yield req return
respond :: MonadResumable req res m => (req -> m res) -> m a -> m a
respond f = flip handle (\ req k -> f req >>= k)
instance (Monoid w, MonadResumable req res m) =>
MonadResumable req res (RWST r w s m) where
yield req k = RWST $ \ r s -> yield req (\ res -> runRWST (k res) r s)
handle m h = RWST $ \ r s ->
let run m = runRWST m r s
in run m `handle` \ req k -> run (h req (\ res -> RWST $ \ _ _ -> k res))
instance MonadResumable req res m =>
MonadResumable req res (ReaderT r m) where
yield req k = ReaderT $ \ r -> yield req (flip runReaderT r . k)
handle m h = ReaderT $ \ r ->
let run = flip runReaderT r
in run m `handle` \ req k -> run (h req (\ res -> ReaderT $ \ _ -> k res))
instance (Monoid w, MonadResumable req res m) =>
MonadResumable req res (WriterT w m) where
yield req k = WriterT $ yield req (runWriterT . k)
handle m h =
mapWriterT (flip handle (\ req k -> runWriterT (h req (WriterT . k)))) m
instance MonadResumable req res m =>
MonadResumable req res (StateT s m) where
yield req k = StateT $ \ s -> yield req (flip runStateT s . k)
handle m h = StateT $ \ s ->
let run = flip runStateT s
in run m `handle` \ req k -> run (h req (\ res -> StateT $ \ _ -> k res))
instance (Error e, MonadResumable req res m) =>
MonadResumable req res (ErrorT e m) where
yield req k = ErrorT $ yield req (runErrorT . k)
handle m h =
mapErrorT (flip handle (\ req k -> runErrorT (h req (ErrorT . k)))) m
instance MonadResumable req res m =>
MonadResumable req res (ContT r m) where
yield req k = ContT $ \ cc -> yield req (flip runContT cc . k)
handle m h = ContT $ \ cc ->
let run = flip runContT cc
in run m `handle` \ req k -> run (h req (\ res -> ContT $ \ _ -> k res))