Skip to content
Snippets Groups Projects
Commit f8623e15 authored by Edward Kmett's avatar Edward Kmett
Browse files

Merge pull request #25 from snoyberg/master

Additional MonadThrow instances for transformers
parents 30e77cfc 97ec6839
No related branches found
No related tags found
No related merge requests found
...@@ -86,6 +86,10 @@ import qualified Control.Monad.Trans.State.Lazy as LazyS ...@@ -86,6 +86,10 @@ import qualified Control.Monad.Trans.State.Lazy as LazyS
import qualified Control.Monad.Trans.State.Strict as StrictS import qualified Control.Monad.Trans.State.Strict as StrictS
import qualified Control.Monad.Trans.Writer.Lazy as LazyW import qualified Control.Monad.Trans.Writer.Lazy as LazyW
import qualified Control.Monad.Trans.Writer.Strict as StrictW import qualified Control.Monad.Trans.Writer.Strict as StrictW
import Control.Monad.Trans.List (ListT)
import Control.Monad.Trans.Maybe (MaybeT)
import Control.Monad.Trans.Error (ErrorT, Error)
import Control.Monad.Trans.Cont (ContT)
import Control.Monad.Trans.Identity import Control.Monad.Trans.Identity
import Control.Monad.Reader as Reader import Control.Monad.Reader as Reader
import Control.Monad.RWS import Control.Monad.RWS
...@@ -221,6 +225,16 @@ instance (MonadCatch m, Monoid w) => MonadCatch (StrictRWS.RWST r w s m) where ...@@ -221,6 +225,16 @@ instance (MonadCatch m, Monoid w) => MonadCatch (StrictRWS.RWST r w s m) where
StrictRWS.RWST $ \r s -> uninterruptibleMask $ \u -> StrictRWS.runRWST (a $ q u) r s StrictRWS.RWST $ \r s -> uninterruptibleMask $ \u -> StrictRWS.runRWST (a $ q u) r s
where q u (StrictRWS.RWST b) = StrictRWS.RWST $ \ r s -> u (b r s) where q u (StrictRWS.RWST b) = StrictRWS.RWST $ \ r s -> u (b r s)
-- Transformers which are only instances of MonadThrow, not MonadCatch
instance MonadThrow m => MonadThrow (ListT m) where
throwM = lift . throwM
instance MonadThrow m => MonadThrow (MaybeT m) where
throwM = lift . throwM
instance (Error e, MonadThrow m) => MonadThrow (ErrorT e m) where
throwM = lift . throwM
instance MonadThrow m => MonadThrow (ContT r m) where
throwM = lift . throwM
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- $utilities -- $utilities
-- These functions follow those from "Control.Exception", except that they are -- These functions follow those from "Control.Exception", except that they are
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment