@@ -47,7 +47,10 @@ import Control.Monad (ap, liftM, MonadPlus(..), mzero,
4747 when)
4848import Control.Monad.Base (MonadBase (..), liftBaseDefault)
4949import Control.Monad.Catch (MonadThrow, throwM)
50+import Control.Monad.Error.Class (MonadError(..))
5051import Control.Monad.IO.Class (MonadIO(..))
52+import Control.Monad.Reader.Class (MonadReader(..))
53+import Control.Monad.State.Class (MonadState(..))
5154import Control.Monad.Trans.Class (MonadTrans (lift))
5255import Control.Monad.Trans.Control (MonadBaseControl, liftBaseWith)
5356import Data.Functor (void)
@@ -516,6 +519,27 @@ instance MonadIO m => MonadIO (AsyncT m) where
516519instance MonadThrow m => MonadThrow (AsyncT m) where
517520 throwM = lift . throwM
518521
522+-- XXX handle and test cross thread state transfer
523+instance MonadError e m => MonadError e (AsyncT m) where
524+ throwError = lift . throwError
525+ catchError m h = AsyncT $ \ctx stp yld ->
526+ let handle r = r `catchError` \e -> (runAsyncT (h e)) ctx stp yld
527+ yield a c Nothing = yld a c Nothing
528+ yield a c (Just r) = yld a c (Just (catchError r h))
529+ in handle $ (runAsyncT m) ctx stp yield
530+
531+instance MonadReader r m => MonadReader r (AsyncT m) where
532+ ask = lift ask
533+ local f m = AsyncT $ \ctx stp yld ->
534+ let yield a c Nothing = local f $ yld a c Nothing
535+ yield a c (Just r) = local f $ yld a c (Just (local f r))
536+ in (runAsyncT m) ctx (local f stp) yield
537+
538+instance MonadState s m => MonadState s (AsyncT m) where
539+ get = lift get
540+ put x = lift (put x)
541+ state k = lift (state k)
542+
519543------------------------------------------------------------------------------
520544-- MonadRecorder
521545------------------------------------------------------------------------------