095349d · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Add MonadError, MonadReader and MonadState instances

095349dHarendra Kumar9 years ago

src/Asyncly/AsyncT.hs+24

compare with master

unifiedsplit

@@ -47,7 +47,10 @@ import Control.Monad (ap, liftM, MonadPlus(..), mzero,

47 when)

48import Control.Monad.Base (MonadBase (..), liftBaseDefault)

49import Control.Monad.Catch (MonadThrow, throwM)

50+import Control.Monad.Error.Class (MonadError(..))

50import Control.Monad.IO.Class (MonadIO(..))

51import Control.Monad.IO.Class (MonadIO(..))

52+import Control.Monad.Reader.Class (MonadReader(..))

53+import Control.Monad.State.Class (MonadState(..))

51import Control.Monad.Trans.Class (MonadTrans (lift))

54import Control.Monad.Trans.Class (MonadTrans (lift))

52import Control.Monad.Trans.Control (MonadBaseControl, liftBaseWith)

55import Control.Monad.Trans.Control (MonadBaseControl, liftBaseWith)

53import Data.Functor (void)

56import Data.Functor (void)

@@ -516,6 +519,27 @@ instance MonadIO m => MonadIO (AsyncT m) where

516instance MonadThrow m => MonadThrow (AsyncT m) where

519instance MonadThrow m => MonadThrow (AsyncT m) where

517 throwM = lift . throwM

520 throwM = lift . throwM

518

521

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+

519------------------------------------------------------------------------------

543------------------------------------------------------------------------------

520-- MonadRecorder

544-- MonadRecorder

521------------------------------------------------------------------------------

545------------------------------------------------------------------------------