{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnboxedTuples #-}
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
module Control.Monad.Exception (
E.Exception(..),
E.SomeException,
MonadException(..),
onException,
MonadAsyncException(..),
bracket,
bracket_,
ExceptionT(..),
mapExceptionT,
liftException
) where
#if !MIN_VERSION_base(4,6,0)
import Prelude hiding (catch)
#endif /*!MIN_VERSION_base(4,6,0) */
import Control.Applicative
import qualified Control.Exception as E (Exception(..),
SomeException,
catch,
throw,
finally)
import qualified Control.Exception as E (mask)
import Control.Monad (MonadPlus(..))
import Control.Monad.Fix (MonadFix(..))
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Trans.Error (Error(..),
ErrorT(..),
mapErrorT,
runErrorT)
import Control.Monad.Trans.Except (ExceptT(..),
mapExceptT,
runExceptT)
import Control.Monad.Trans.Identity (IdentityT(..),
mapIdentityT,
runIdentityT)
import Control.Monad.Trans.List (ListT(..),
mapListT,
runListT)
import Control.Monad.Trans.Maybe (MaybeT(..),
mapMaybeT,
runMaybeT)
import Control.Monad.Trans.RWS.Lazy as Lazy (RWST(..),
mapRWST,
runRWST)
import Control.Monad.Trans.RWS.Strict as Strict (RWST(..),
mapRWST,
runRWST)
import Control.Monad.Trans.Reader (ReaderT(..),
mapReaderT)
import Control.Monad.Trans.State.Lazy as Lazy (StateT(..),
mapStateT,
runStateT)
import Control.Monad.Trans.State.Strict as Strict (StateT(..),
mapStateT,
runStateT)
import Control.Monad.Trans.Writer.Lazy as Lazy (WriterT(..),
mapWriterT,
runWriterT)
import Control.Monad.Trans.Writer.Strict as Strict (WriterT(..),
mapWriterT,
runWriterT)
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (Monoid)
#endif /* !MIN_VERSION_base(4,8,0) */
import GHC.Conc.Sync (STM(..),
catchSTM,
throwSTM)
class (Monad m) => MonadException m where
throw :: E.Exception e => e -> m a
catch :: E.Exception e
=> m a
-> (e -> m a)
-> m a
finally :: m a
-> m b
-> m a
act :: m a
act `finally` sequel :: m b
sequel = do
a
a <- m a
act m a -> m b -> m a
forall (m :: * -> *) a b. MonadException m => m a -> m b -> m a
`onException` m b
sequel
b
_ <- m b
sequel
a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
onException :: MonadException m
=> m a
-> m b
-> m a
onException :: m a -> m b -> m a
onException act :: m a
act what :: m b
what =
m a
act m a -> (SomeException -> m a) -> m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \(SomeException
e :: E.SomeException) -> m b
what m b -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomeException -> m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throw SomeException
e
class (MonadIO m, MonadException m) => MonadAsyncException m where
mask :: ((forall a. m a -> m a) -> m b) -> m b
bracket :: MonadAsyncException m
=> m a
-> (a -> m b)
-> (a -> m c)
-> m c
bracket :: m a -> (a -> m b) -> (a -> m c) -> m c
bracket before :: m a
before after :: a -> m b
after thing :: a -> m c
thing =
((forall a. m a -> m a) -> m c) -> m c
forall (m :: * -> *) b.
MonadAsyncException m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m c) -> m c)
-> ((forall a. m a -> m a) -> m c) -> m c
forall a b. (a -> b) -> a -> b
$ \restore :: forall a. m a -> m a
restore -> do
a
a <- m a
before
m c -> m c
forall a. m a -> m a
restore (a -> m c
thing a
a) m c -> m b -> m c
forall (m :: * -> *) a b. MonadException m => m a -> m b -> m a
`finally` a -> m b
after a
a
bracket_ :: MonadAsyncException m
=> m a
-> m b
-> m c
-> m c
bracket_ :: m a -> m b -> m c -> m c
bracket_ before :: m a
before after :: m b
after thing :: m c
thing =
m a -> (a -> m b) -> (a -> m c) -> m c
forall (m :: * -> *) a b c.
MonadAsyncException m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket m a
before (m b -> a -> m b
forall a b. a -> b -> a
const m b
after) (m c -> a -> m c
forall a b. a -> b -> a
const m c
thing)
newtype ExceptionT m a =
ExceptionT { ExceptionT m a -> m (Either SomeException a)
runExceptionT :: m (Either E.SomeException a) }
mapExceptionT :: (m (Either E.SomeException a) -> n (Either E.SomeException b))
-> ExceptionT m a
-> ExceptionT n b
mapExceptionT :: (m (Either SomeException a) -> n (Either SomeException b))
-> ExceptionT m a -> ExceptionT n b
mapExceptionT f :: m (Either SomeException a) -> n (Either SomeException b)
f = n (Either SomeException b) -> ExceptionT n b
forall (m :: * -> *) a.
m (Either SomeException a) -> ExceptionT m a
ExceptionT (n (Either SomeException b) -> ExceptionT n b)
-> (ExceptionT m a -> n (Either SomeException b))
-> ExceptionT m a
-> ExceptionT n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either SomeException a) -> n (Either SomeException b)
f (m (Either SomeException a) -> n (Either SomeException b))
-> (ExceptionT m a -> m (Either SomeException a))
-> ExceptionT m a
-> n (Either SomeException b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptionT m a -> m (Either SomeException a)
forall (m :: * -> *) a.
ExceptionT m a -> m (Either SomeException a)
runExceptionT
liftException :: MonadException m => Either E.SomeException a -> m a
liftException :: Either SomeException a -> m a
liftException (Left e :: SomeException
e) = SomeException -> m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throw SomeException
e
liftException (Right a :: a
a) = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
instance MonadTrans ExceptionT where
lift :: m a -> ExceptionT m a
lift m :: m a
m = m (Either SomeException a) -> ExceptionT m a
forall (m :: * -> *) a.
m (Either SomeException a) -> ExceptionT m a
ExceptionT (m (Either SomeException a) -> ExceptionT m a)
-> m (Either SomeException a) -> ExceptionT m a
forall a b. (a -> b) -> a -> b
$ do
a
a <- m a
m
Either SomeException a -> m (Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either SomeException a
forall a b. b -> Either a b
Right a
a)
instance (Functor m, Monad m) => Applicative (ExceptionT m) where
pure :: a -> ExceptionT m a
pure a :: a
a = m (Either SomeException a) -> ExceptionT m a
forall (m :: * -> *) a.
m (Either SomeException a) -> ExceptionT m a
ExceptionT (m (Either SomeException a) -> ExceptionT m a)
-> m (Either SomeException a) -> ExceptionT m a
forall a b. (a -> b) -> a -> b
$ Either SomeException a -> m (Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either SomeException a
forall a b. b -> Either a b
Right a
a)
f :: ExceptionT m (a -> b)
f <*> :: ExceptionT m (a -> b) -> ExceptionT m a -> ExceptionT m b
<*> v :: ExceptionT m a
v = m (Either SomeException b) -> ExceptionT m b
forall (m :: * -> *) a.
m (Either SomeException a) -> ExceptionT m a
ExceptionT (m (Either SomeException b) -> ExceptionT m b)
-> m (Either SomeException b) -> ExceptionT m b
forall a b. (a -> b) -> a -> b
$ do
Either SomeException (a -> b)
mf <- ExceptionT m (a -> b) -> m (Either SomeException (a -> b))
forall (m :: * -> *) a.
ExceptionT m a -> m (Either SomeException a)
runExceptionT ExceptionT m (a -> b)
f
case Either SomeException (a -> b)
mf of
Left e :: SomeException
e -> Either SomeException b -> m (Either SomeException b)
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Either SomeException b
forall a b. a -> Either a b
Left SomeException
e)
Right k :: a -> b
k -> do
Either SomeException a
mv <- ExceptionT m a -> m (Either SomeException a)
forall (m :: * -> *) a.
ExceptionT m a -> m (Either SomeException a)
runExceptionT ExceptionT m a
v
case Either SomeException a
mv of
Left e :: SomeException
e -> Either SomeException b -> m (Either SomeException b)
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Either SomeException b
forall a b. a -> Either a b
Left SomeException
e)
Right x :: a
x -> Either SomeException b -> m (Either SomeException b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Either SomeException b
forall a b. b -> Either a b
Right (a -> b
k a
x))
instance (Functor m) => Functor (ExceptionT m) where
fmap :: (a -> b) -> ExceptionT m a -> ExceptionT m b
fmap f :: a -> b
f = m (Either SomeException b) -> ExceptionT m b
forall (m :: * -> *) a.
m (Either SomeException a) -> ExceptionT m a
ExceptionT (m (Either SomeException b) -> ExceptionT m b)
-> (ExceptionT m a -> m (Either SomeException b))
-> ExceptionT m a
-> ExceptionT m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either SomeException a -> Either SomeException b)
-> m (Either SomeException a) -> m (Either SomeException b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Either SomeException a -> Either SomeException b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (m (Either SomeException a) -> m (Either SomeException b))
-> (ExceptionT m a -> m (Either SomeException a))
-> ExceptionT m a
-> m (Either SomeException b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptionT m a -> m (Either SomeException a)
forall (m :: * -> *) a.
ExceptionT m a -> m (Either SomeException a)
runExceptionT
instance (Monad m) => Monad (ExceptionT m) where
#if MIN_VERSION_base(4,8,0)
return :: a -> ExceptionT m a
return = a -> ExceptionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
#else /* !MIN_VERSION_base(4,8,0) */
return a = ExceptionT $ return (Right a)
#endif /* !MIN_VERSION_base(4,8,0) */
m :: ExceptionT m a
m >>= :: ExceptionT m a -> (a -> ExceptionT m b) -> ExceptionT m b
>>= k :: a -> ExceptionT m b
k = m (Either SomeException b) -> ExceptionT m b
forall (m :: * -> *) a.
m (Either SomeException a) -> ExceptionT m a
ExceptionT (m (Either SomeException b) -> ExceptionT m b)
-> m (Either SomeException b) -> ExceptionT m b
forall a b. (a -> b) -> a -> b
$ do
Either SomeException a
a <- ExceptionT m a -> m (Either SomeException a)
forall (m :: * -> *) a.
ExceptionT m a -> m (Either SomeException a)
runExceptionT ExceptionT m a
m
case Either SomeException a
a of
Left l :: SomeException
l -> Either SomeException b -> m (Either SomeException b)
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Either SomeException b
forall a b. a -> Either a b
Left SomeException
l)
Right r :: a
r -> ExceptionT m b -> m (Either SomeException b)
forall (m :: * -> *) a.
ExceptionT m a -> m (Either SomeException a)
runExceptionT (a -> ExceptionT m b
k a
r)
#if MIN_VERSION_base(4,13,0)
instance (Monad m) => MonadFail (ExceptionT m) where
#endif
fail :: String -> ExceptionT m a
fail msg :: String
msg = m (Either SomeException a) -> ExceptionT m a
forall (m :: * -> *) a.
m (Either SomeException a) -> ExceptionT m a
ExceptionT (m (Either SomeException a) -> ExceptionT m a)
-> m (Either SomeException a) -> ExceptionT m a
forall a b. (a -> b) -> a -> b
$ Either SomeException a -> m (Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Either SomeException a
forall a b. a -> Either a b
Left (IOError -> SomeException
forall e. Exception e => e -> SomeException
E.toException (String -> IOError
userError String
msg)))
instance (Monad m) => MonadPlus (ExceptionT m) where
mzero :: ExceptionT m a
mzero = m (Either SomeException a) -> ExceptionT m a
forall (m :: * -> *) a.
m (Either SomeException a) -> ExceptionT m a
ExceptionT (m (Either SomeException a) -> ExceptionT m a)
-> m (Either SomeException a) -> ExceptionT m a
forall a b. (a -> b) -> a -> b
$ Either SomeException a -> m (Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Either SomeException a
forall a b. a -> Either a b
Left (IOError -> SomeException
forall e. Exception e => e -> SomeException
E.toException (String -> IOError
userError "")))
m :: ExceptionT m a
m mplus :: ExceptionT m a -> ExceptionT m a -> ExceptionT m a
`mplus` n :: ExceptionT m a
n = m (Either SomeException a) -> ExceptionT m a
forall (m :: * -> *) a.
m (Either SomeException a) -> ExceptionT m a
ExceptionT (m (Either SomeException a) -> ExceptionT m a)
-> m (Either SomeException a) -> ExceptionT m a
forall a b. (a -> b) -> a -> b
$ do
Either SomeException a
a <- ExceptionT m a -> m (Either SomeException a)
forall (m :: * -> *) a.
ExceptionT m a -> m (Either SomeException a)
runExceptionT ExceptionT m a
m
case Either SomeException a
a of
Left _ -> ExceptionT m a -> m (Either SomeException a)
forall (m :: * -> *) a.
ExceptionT m a -> m (Either SomeException a)
runExceptionT ExceptionT m a
n
Right r :: a
r -> Either SomeException a -> m (Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either SomeException a
forall a b. b -> Either a b
Right a
r)
instance (Functor m, Monad m) => Alternative (ExceptionT m) where
empty :: ExceptionT m a
empty = ExceptionT m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
<|> :: ExceptionT m a -> ExceptionT m a -> ExceptionT m a
(<|>) = ExceptionT m a -> ExceptionT m a -> ExceptionT m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
instance (MonadFix m) => MonadFix (ExceptionT m) where
mfix :: (a -> ExceptionT m a) -> ExceptionT m a
mfix f :: a -> ExceptionT m a
f = m (Either SomeException a) -> ExceptionT m a
forall (m :: * -> *) a.
m (Either SomeException a) -> ExceptionT m a
ExceptionT (m (Either SomeException a) -> ExceptionT m a)
-> m (Either SomeException a) -> ExceptionT m a
forall a b. (a -> b) -> a -> b
$ (Either SomeException a -> m (Either SomeException a))
-> m (Either SomeException a)
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix ((Either SomeException a -> m (Either SomeException a))
-> m (Either SomeException a))
-> (Either SomeException a -> m (Either SomeException a))
-> m (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ \a :: Either SomeException a
a -> ExceptionT m a -> m (Either SomeException a)
forall (m :: * -> *) a.
ExceptionT m a -> m (Either SomeException a)
runExceptionT (ExceptionT m a -> m (Either SomeException a))
-> ExceptionT m a -> m (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ a -> ExceptionT m a
f (a -> ExceptionT m a) -> a -> ExceptionT m a
forall a b. (a -> b) -> a -> b
$ case Either SomeException a
a of
Right r :: a
r -> a
r
_ -> String -> a
forall a. HasCallStack => String -> a
error "empty mfix argument"
instance (Monad m) => MonadException (ExceptionT m) where
throw :: e -> ExceptionT m a
throw e :: e
e = m (Either SomeException a) -> ExceptionT m a
forall (m :: * -> *) a.
m (Either SomeException a) -> ExceptionT m a
ExceptionT (m (Either SomeException a) -> ExceptionT m a)
-> m (Either SomeException a) -> ExceptionT m a
forall a b. (a -> b) -> a -> b
$ Either SomeException a -> m (Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Either SomeException a
forall a b. a -> Either a b
Left (e -> SomeException
forall e. Exception e => e -> SomeException
E.toException e
e))
m :: ExceptionT m a
m catch :: ExceptionT m a -> (e -> ExceptionT m a) -> ExceptionT m a
`catch` h :: e -> ExceptionT m a
h = m (Either SomeException a) -> ExceptionT m a
forall (m :: * -> *) a.
m (Either SomeException a) -> ExceptionT m a
ExceptionT (m (Either SomeException a) -> ExceptionT m a)
-> m (Either SomeException a) -> ExceptionT m a
forall a b. (a -> b) -> a -> b
$ do
Either SomeException a
a <- ExceptionT m a -> m (Either SomeException a)
forall (m :: * -> *) a.
ExceptionT m a -> m (Either SomeException a)
runExceptionT ExceptionT m a
m
case Either SomeException a
a of
Left l :: SomeException
l -> case SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
E.fromException SomeException
l of
Just e :: e
e -> ExceptionT m a -> m (Either SomeException a)
forall (m :: * -> *) a.
ExceptionT m a -> m (Either SomeException a)
runExceptionT (e -> ExceptionT m a
h e
e)
Nothing -> Either SomeException a -> m (Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Either SomeException a
forall a b. a -> Either a b
Left SomeException
l)
Right r :: a
r -> Either SomeException a -> m (Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either SomeException a
forall a b. b -> Either a b
Right a
r)
instance (MonadIO m) => MonadIO (ExceptionT m) where
liftIO :: IO a -> ExceptionT m a
liftIO m :: IO a
m = m (Either SomeException a) -> ExceptionT m a
forall (m :: * -> *) a.
m (Either SomeException a) -> ExceptionT m a
ExceptionT (m (Either SomeException a) -> ExceptionT m a)
-> m (Either SomeException a) -> ExceptionT m a
forall a b. (a -> b) -> a -> b
$ IO (Either SomeException a) -> m (Either SomeException a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SomeException a) -> m (Either SomeException a))
-> IO (Either SomeException a) -> m (Either SomeException a)
forall a b. (a -> b) -> a -> b
$
(a -> Either SomeException a)
-> IO a -> IO (Either SomeException a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either SomeException a
forall a b. b -> Either a b
Right IO a
m IO (Either SomeException a)
-> (SomeException -> IO (Either SomeException a))
-> IO (Either SomeException a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \(SomeException
e :: E.SomeException) -> Either SomeException a -> IO (Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Either SomeException a
forall a b. a -> Either a b
Left SomeException
e)
instance (MonadAsyncException m) => MonadAsyncException (ExceptionT m) where
mask :: ((forall a. ExceptionT m a -> ExceptionT m a) -> ExceptionT m b)
-> ExceptionT m b
mask act :: (forall a. ExceptionT m a -> ExceptionT m a) -> ExceptionT m b
act = m (Either SomeException b) -> ExceptionT m b
forall (m :: * -> *) a.
m (Either SomeException a) -> ExceptionT m a
ExceptionT (m (Either SomeException b) -> ExceptionT m b)
-> m (Either SomeException b) -> ExceptionT m b
forall a b. (a -> b) -> a -> b
$ ((forall a. m a -> m a) -> m (Either SomeException b))
-> m (Either SomeException b)
forall (m :: * -> *) b.
MonadAsyncException m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m (Either SomeException b))
-> m (Either SomeException b))
-> ((forall a. m a -> m a) -> m (Either SomeException b))
-> m (Either SomeException b)
forall a b. (a -> b) -> a -> b
$ \restore :: forall a. m a -> m a
restore ->
ExceptionT m b -> m (Either SomeException b)
forall (m :: * -> *) a.
ExceptionT m a -> m (Either SomeException a)
runExceptionT (ExceptionT m b -> m (Either SomeException b))
-> ExceptionT m b -> m (Either SomeException b)
forall a b. (a -> b) -> a -> b
$ (forall a. ExceptionT m a -> ExceptionT m a) -> ExceptionT m b
act ((m (Either SomeException a) -> m (Either SomeException a))
-> ExceptionT m a -> ExceptionT m a
forall (m :: * -> *) a (n :: * -> *) b.
(m (Either SomeException a) -> n (Either SomeException b))
-> ExceptionT m a -> ExceptionT n b
mapExceptionT m (Either SomeException a) -> m (Either SomeException a)
forall a. m a -> m a
restore)
instance MonadException IO where
catch :: IO a -> (e -> IO a) -> IO a
catch = IO a -> (e -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch
throw :: e -> IO a
throw = e -> IO a
forall a e. Exception e => e -> a
E.throw
finally :: IO a -> IO b -> IO a
finally = IO a -> IO b -> IO a
forall a b. IO a -> IO b -> IO a
E.finally
#if __GLASGOW_HASKELL__ >= 700
instance MonadAsyncException IO where
mask :: ((forall a. IO a -> IO a) -> IO b) -> IO b
mask = ((forall a. IO a -> IO a) -> IO b) -> IO b
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
E.mask
#else /* __GLASGOW_HASKELL__ < 700 */
instance MonadAsyncException IO where
mask act = do
b <- E.blocked
if b
then act id
else E.block $ act E.unblock
#endif /* __GLASGOW_HASKELL__ < 700 */
instance MonadException STM where
catch :: STM a -> (e -> STM a) -> STM a
catch = STM a -> (e -> STM a) -> STM a
forall e a. Exception e => STM a -> (e -> STM a) -> STM a
catchSTM
throw :: e -> STM a
throw = e -> STM a
forall e a. Exception e => e -> STM a
throwSTM
instance (MonadException m, Error e) =>
MonadException (ErrorT e m) where
throw :: e -> ErrorT e m a
throw = m a -> ErrorT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ErrorT e m a) -> (e -> m a) -> e -> ErrorT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throw
m :: ErrorT e m a
m catch :: ErrorT e m a -> (e -> ErrorT e m a) -> ErrorT e m a
`catch` h :: e -> ErrorT e m a
h = (m (Either e a) -> m (Either e a)) -> ErrorT e m a -> ErrorT e m a
forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ErrorT e m a -> ErrorT e' n b
mapErrorT (\m' :: m (Either e a)
m' -> m (Either e a)
m' m (Either e a) -> (e -> m (Either e a)) -> m (Either e a)
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e :: e
e -> ErrorT e m a -> m (Either e a)
forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
runErrorT (e -> ErrorT e m a
h e
e)) ErrorT e m a
m
act :: ErrorT e m a
act finally :: ErrorT e m a -> ErrorT e m b -> ErrorT e m a
`finally` sequel :: ErrorT e m b
sequel =
(m (Either e a) -> m (Either e a)) -> ErrorT e m a -> ErrorT e m a
forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ErrorT e m a -> ErrorT e' n b
mapErrorT (\act' :: m (Either e a)
act' -> m (Either e a)
act' m (Either e a) -> m (Either e b) -> m (Either e a)
forall (m :: * -> *) a b. MonadException m => m a -> m b -> m a
`finally` ErrorT e m b -> m (Either e b)
forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
runErrorT ErrorT e m b
sequel) ErrorT e m a
act
instance (MonadException m) =>
MonadException (ExceptT e' m) where
throw :: e -> ExceptT e' m a
throw = m a -> ExceptT e' m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ExceptT e' m a) -> (e -> m a) -> e -> ExceptT e' m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throw
m :: ExceptT e' m a
m catch :: ExceptT e' m a -> (e -> ExceptT e' m a) -> ExceptT e' m a
`catch` h :: e -> ExceptT e' m a
h = (m (Either e' a) -> m (Either e' a))
-> ExceptT e' m a -> ExceptT e' m a
forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT (\m' :: m (Either e' a)
m' -> m (Either e' a)
m' m (Either e' a) -> (e -> m (Either e' a)) -> m (Either e' a)
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e :: e
e -> ExceptT e' m a -> m (Either e' a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (e -> ExceptT e' m a
h e
e)) ExceptT e' m a
m
act :: ExceptT e' m a
act finally :: ExceptT e' m a -> ExceptT e' m b -> ExceptT e' m a
`finally` sequel :: ExceptT e' m b
sequel =
(m (Either e' a) -> m (Either e' a))
-> ExceptT e' m a -> ExceptT e' m a
forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT (\act' :: m (Either e' a)
act' -> m (Either e' a)
act' m (Either e' a) -> m (Either e' b) -> m (Either e' a)
forall (m :: * -> *) a b. MonadException m => m a -> m b -> m a
`finally` ExceptT e' m b -> m (Either e' b)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e' m b
sequel) ExceptT e' m a
act
instance (MonadException m) =>
MonadException (IdentityT m) where
throw :: e -> IdentityT m a
throw = m a -> IdentityT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> IdentityT m a) -> (e -> m a) -> e -> IdentityT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throw
m :: IdentityT m a
m catch :: IdentityT m a -> (e -> IdentityT m a) -> IdentityT m a
`catch` h :: e -> IdentityT m a
h = (m a -> m a) -> IdentityT m a -> IdentityT m a
forall k1 k2 (m :: k1 -> *) (a :: k1) (n :: k2 -> *) (b :: k2).
(m a -> n b) -> IdentityT m a -> IdentityT n b
mapIdentityT (\m' :: m a
m' -> m a
m' m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e :: e
e -> IdentityT m a -> m a
forall k (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT (e -> IdentityT m a
h e
e)) IdentityT m a
m
instance MonadException m =>
MonadException (ListT m) where
throw :: e -> ListT m a
throw = m a -> ListT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ListT m a) -> (e -> m a) -> e -> ListT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throw
m :: ListT m a
m catch :: ListT m a -> (e -> ListT m a) -> ListT m a
`catch` h :: e -> ListT m a
h = (m [a] -> m [a]) -> ListT m a -> ListT m a
forall (m :: * -> *) a (n :: * -> *) b.
(m [a] -> n [b]) -> ListT m a -> ListT n b
mapListT (\m' :: m [a]
m' -> m [a]
m' m [a] -> (e -> m [a]) -> m [a]
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e :: e
e -> ListT m a -> m [a]
forall (m :: * -> *) a. ListT m a -> m [a]
runListT (e -> ListT m a
h e
e)) ListT m a
m
instance (MonadException m) =>
MonadException (MaybeT m) where
throw :: e -> MaybeT m a
throw = m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> MaybeT m a) -> (e -> m a) -> e -> MaybeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throw
m :: MaybeT m a
m catch :: MaybeT m a -> (e -> MaybeT m a) -> MaybeT m a
`catch` h :: e -> MaybeT m a
h = (m (Maybe a) -> m (Maybe a)) -> MaybeT m a -> MaybeT m a
forall (m :: * -> *) a (n :: * -> *) b.
(m (Maybe a) -> n (Maybe b)) -> MaybeT m a -> MaybeT n b
mapMaybeT (\m' :: m (Maybe a)
m' -> m (Maybe a)
m' m (Maybe a) -> (e -> m (Maybe a)) -> m (Maybe a)
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e :: e
e -> MaybeT m a -> m (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (e -> MaybeT m a
h e
e)) MaybeT m a
m
act :: MaybeT m a
act finally :: MaybeT m a -> MaybeT m b -> MaybeT m a
`finally` sequel :: MaybeT m b
sequel =
(m (Maybe a) -> m (Maybe a)) -> MaybeT m a -> MaybeT m a
forall (m :: * -> *) a (n :: * -> *) b.
(m (Maybe a) -> n (Maybe b)) -> MaybeT m a -> MaybeT n b
mapMaybeT (\act' :: m (Maybe a)
act' -> m (Maybe a)
act' m (Maybe a) -> m (Maybe b) -> m (Maybe a)
forall (m :: * -> *) a b. MonadException m => m a -> m b -> m a
`finally` MaybeT m b -> m (Maybe b)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT MaybeT m b
sequel) MaybeT m a
act
instance (Monoid w, MonadException m) =>
MonadException (Lazy.RWST r w s m) where
throw :: e -> RWST r w s m a
throw = m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> RWST r w s m a) -> (e -> m a) -> e -> RWST r w s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throw
m :: RWST r w s m a
m catch :: RWST r w s m a -> (e -> RWST r w s m a) -> RWST r w s m a
`catch` h :: e -> RWST r w s m a
h = (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \r :: r
r s :: s
s ->
RWST r w s m a -> r -> s -> m (a, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Lazy.runRWST RWST r w s m a
m r
r s
s m (a, s, w) -> (e -> m (a, s, w)) -> m (a, s, w)
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e :: e
e -> RWST r w s m a -> r -> s -> m (a, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Lazy.runRWST (e -> RWST r w s m a
h e
e) r
r s
s
instance (Monoid w, MonadException m) =>
MonadException (Strict.RWST r w s m) where
throw :: e -> RWST r w s m a
throw = m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> RWST r w s m a) -> (e -> m a) -> e -> RWST r w s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throw
m :: RWST r w s m a
m catch :: RWST r w s m a -> (e -> RWST r w s m a) -> RWST r w s m a
`catch` h :: e -> RWST r w s m a
h = (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \r :: r
r s :: s
s ->
RWST r w s m a -> r -> s -> m (a, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Strict.runRWST RWST r w s m a
m r
r s
s m (a, s, w) -> (e -> m (a, s, w)) -> m (a, s, w)
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e :: e
e -> RWST r w s m a -> r -> s -> m (a, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Strict.runRWST (e -> RWST r w s m a
h e
e) r
r s
s
instance (MonadException m) =>
MonadException (ReaderT r m) where
throw :: e -> ReaderT r m a
throw = m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT r m a) -> (e -> m a) -> e -> ReaderT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throw
m :: ReaderT r m a
m catch :: ReaderT r m a -> (e -> ReaderT r m a) -> ReaderT r m a
`catch` h :: e -> ReaderT r m a
h = (r -> m a) -> ReaderT r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m a) -> ReaderT r m a) -> (r -> m a) -> ReaderT r m a
forall a b. (a -> b) -> a -> b
$ \r :: r
r ->
ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
m r
r m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e :: e
e -> ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (e -> ReaderT r m a
h e
e) r
r
instance (MonadException m) =>
MonadException (Lazy.StateT s m) where
throw :: e -> StateT s m a
throw = m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT s m a) -> (e -> m a) -> e -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throw
m :: StateT s m a
m catch :: StateT s m a -> (e -> StateT s m a) -> StateT s m a
`catch` h :: e -> StateT s m a
h = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \s :: s
s ->
StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Lazy.runStateT StateT s m a
m s
s m (a, s) -> (e -> m (a, s)) -> m (a, s)
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e :: e
e -> StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Lazy.runStateT (e -> StateT s m a
h e
e) s
s
instance (MonadException m) =>
MonadException (Strict.StateT s m) where
throw :: e -> StateT s m a
throw = m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT s m a) -> (e -> m a) -> e -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throw
m :: StateT s m a
m catch :: StateT s m a -> (e -> StateT s m a) -> StateT s m a
`catch` h :: e -> StateT s m a
h = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \s :: s
s ->
StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Strict.runStateT StateT s m a
m s
s m (a, s) -> (e -> m (a, s)) -> m (a, s)
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e :: e
e -> StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Strict.runStateT (e -> StateT s m a
h e
e) s
s
instance (Monoid w, MonadException m) =>
MonadException (Lazy.WriterT w m) where
throw :: e -> WriterT w m a
throw = m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WriterT w m a) -> (e -> m a) -> e -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throw
m :: WriterT w m a
m catch :: WriterT w m a -> (e -> WriterT w m a) -> WriterT w m a
`catch` h :: e -> WriterT w m a
h = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT (m (a, w) -> WriterT w m a) -> m (a, w) -> WriterT w m a
forall a b. (a -> b) -> a -> b
$
WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Lazy.runWriterT WriterT w m a
m m (a, w) -> (e -> m (a, w)) -> m (a, w)
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e :: e
e -> WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Lazy.runWriterT (e -> WriterT w m a
h e
e)
instance (Monoid w, MonadException m) =>
MonadException (Strict.WriterT w m) where
throw :: e -> WriterT w m a
throw = m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WriterT w m a) -> (e -> m a) -> e -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throw
m :: WriterT w m a
m catch :: WriterT w m a -> (e -> WriterT w m a) -> WriterT w m a
`catch` h :: e -> WriterT w m a
h = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT (m (a, w) -> WriterT w m a) -> m (a, w) -> WriterT w m a
forall a b. (a -> b) -> a -> b
$
WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Strict.runWriterT WriterT w m a
m m (a, w) -> (e -> m (a, w)) -> m (a, w)
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e :: e
e -> WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Strict.runWriterT (e -> WriterT w m a
h e
e)
instance (MonadAsyncException m, Error e) =>
MonadAsyncException (ErrorT e m) where
mask :: ((forall a. ErrorT e m a -> ErrorT e m a) -> ErrorT e m b)
-> ErrorT e m b
mask act :: (forall a. ErrorT e m a -> ErrorT e m a) -> ErrorT e m b
act = m (Either e b) -> ErrorT e m b
forall e (m :: * -> *) a. m (Either e a) -> ErrorT e m a
ErrorT (m (Either e b) -> ErrorT e m b) -> m (Either e b) -> ErrorT e m b
forall a b. (a -> b) -> a -> b
$ ((forall a. m a -> m a) -> m (Either e b)) -> m (Either e b)
forall (m :: * -> *) b.
MonadAsyncException m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m (Either e b)) -> m (Either e b))
-> ((forall a. m a -> m a) -> m (Either e b)) -> m (Either e b)
forall a b. (a -> b) -> a -> b
$ \restore :: forall a. m a -> m a
restore ->
ErrorT e m b -> m (Either e b)
forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
runErrorT (ErrorT e m b -> m (Either e b)) -> ErrorT e m b -> m (Either e b)
forall a b. (a -> b) -> a -> b
$ (forall a. ErrorT e m a -> ErrorT e m a) -> ErrorT e m b
act ((m (Either e a) -> m (Either e a)) -> ErrorT e m a -> ErrorT e m a
forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ErrorT e m a -> ErrorT e' n b
mapErrorT m (Either e a) -> m (Either e a)
forall a. m a -> m a
restore)
instance (MonadAsyncException m) =>
MonadAsyncException (ExceptT e' m) where
mask :: ((forall a. ExceptT e' m a -> ExceptT e' m a) -> ExceptT e' m b)
-> ExceptT e' m b
mask act :: (forall a. ExceptT e' m a -> ExceptT e' m a) -> ExceptT e' m b
act = m (Either e' b) -> ExceptT e' m b
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e' b) -> ExceptT e' m b)
-> m (Either e' b) -> ExceptT e' m b
forall a b. (a -> b) -> a -> b
$ ((forall a. m a -> m a) -> m (Either e' b)) -> m (Either e' b)
forall (m :: * -> *) b.
MonadAsyncException m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m (Either e' b)) -> m (Either e' b))
-> ((forall a. m a -> m a) -> m (Either e' b)) -> m (Either e' b)
forall a b. (a -> b) -> a -> b
$ \restore :: forall a. m a -> m a
restore ->
ExceptT e' m b -> m (Either e' b)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT e' m b -> m (Either e' b))
-> ExceptT e' m b -> m (Either e' b)
forall a b. (a -> b) -> a -> b
$ (forall a. ExceptT e' m a -> ExceptT e' m a) -> ExceptT e' m b
act ((m (Either e' a) -> m (Either e' a))
-> ExceptT e' m a -> ExceptT e' m a
forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT m (Either e' a) -> m (Either e' a)
forall a. m a -> m a
restore)
instance (MonadAsyncException m) =>
MonadAsyncException (IdentityT m) where
mask :: ((forall a. IdentityT m a -> IdentityT m a) -> IdentityT m b)
-> IdentityT m b
mask act :: (forall a. IdentityT m a -> IdentityT m a) -> IdentityT m b
act = m b -> IdentityT m b
forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (m b -> IdentityT m b) -> m b -> IdentityT m b
forall a b. (a -> b) -> a -> b
$ ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadAsyncException m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m b) -> m b)
-> ((forall a. m a -> m a) -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \restore :: forall a. m a -> m a
restore ->
IdentityT m b -> m b
forall k (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT (IdentityT m b -> m b) -> IdentityT m b -> m b
forall a b. (a -> b) -> a -> b
$ (forall a. IdentityT m a -> IdentityT m a) -> IdentityT m b
act ((m a -> m a) -> IdentityT m a -> IdentityT m a
forall k1 k2 (m :: k1 -> *) (a :: k1) (n :: k2 -> *) (b :: k2).
(m a -> n b) -> IdentityT m a -> IdentityT n b
mapIdentityT m a -> m a
forall a. m a -> m a
restore)
instance (MonadAsyncException m) =>
MonadAsyncException (ListT m) where
mask :: ((forall a. ListT m a -> ListT m a) -> ListT m b) -> ListT m b
mask act :: (forall a. ListT m a -> ListT m a) -> ListT m b
act = m [b] -> ListT m b
forall (m :: * -> *) a. m [a] -> ListT m a
ListT (m [b] -> ListT m b) -> m [b] -> ListT m b
forall a b. (a -> b) -> a -> b
$ ((forall a. m a -> m a) -> m [b]) -> m [b]
forall (m :: * -> *) b.
MonadAsyncException m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m [b]) -> m [b])
-> ((forall a. m a -> m a) -> m [b]) -> m [b]
forall a b. (a -> b) -> a -> b
$ \restore :: forall a. m a -> m a
restore ->
ListT m b -> m [b]
forall (m :: * -> *) a. ListT m a -> m [a]
runListT (ListT m b -> m [b]) -> ListT m b -> m [b]
forall a b. (a -> b) -> a -> b
$ (forall a. ListT m a -> ListT m a) -> ListT m b
act ((m [a] -> m [a]) -> ListT m a -> ListT m a
forall (m :: * -> *) a (n :: * -> *) b.
(m [a] -> n [b]) -> ListT m a -> ListT n b
mapListT m [a] -> m [a]
forall a. m a -> m a
restore)
instance (MonadAsyncException m) =>
MonadAsyncException (MaybeT m) where
mask :: ((forall a. MaybeT m a -> MaybeT m a) -> MaybeT m b) -> MaybeT m b
mask act :: (forall a. MaybeT m a -> MaybeT m a) -> MaybeT m b
act = m (Maybe b) -> MaybeT m b
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe b) -> MaybeT m b) -> m (Maybe b) -> MaybeT m b
forall a b. (a -> b) -> a -> b
$ ((forall a. m a -> m a) -> m (Maybe b)) -> m (Maybe b)
forall (m :: * -> *) b.
MonadAsyncException m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m (Maybe b)) -> m (Maybe b))
-> ((forall a. m a -> m a) -> m (Maybe b)) -> m (Maybe b)
forall a b. (a -> b) -> a -> b
$ \restore :: forall a. m a -> m a
restore ->
MaybeT m b -> m (Maybe b)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m b -> m (Maybe b)) -> MaybeT m b -> m (Maybe b)
forall a b. (a -> b) -> a -> b
$ (forall a. MaybeT m a -> MaybeT m a) -> MaybeT m b
act ((m (Maybe a) -> m (Maybe a)) -> MaybeT m a -> MaybeT m a
forall (m :: * -> *) a (n :: * -> *) b.
(m (Maybe a) -> n (Maybe b)) -> MaybeT m a -> MaybeT n b
mapMaybeT m (Maybe a) -> m (Maybe a)
forall a. m a -> m a
restore)
instance (Monoid w, MonadAsyncException m) =>
MonadAsyncException (Lazy.RWST r w s m) where
mask :: ((forall a. RWST r w s m a -> RWST r w s m a) -> RWST r w s m b)
-> RWST r w s m b
mask act :: (forall a. RWST r w s m a -> RWST r w s m a) -> RWST r w s m b
act = (r -> s -> m (b, s, w)) -> RWST r w s m b
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST ((r -> s -> m (b, s, w)) -> RWST r w s m b)
-> (r -> s -> m (b, s, w)) -> RWST r w s m b
forall a b. (a -> b) -> a -> b
$ \r :: r
r s :: s
s -> ((forall a. m a -> m a) -> m (b, s, w)) -> m (b, s, w)
forall (m :: * -> *) b.
MonadAsyncException m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m (b, s, w)) -> m (b, s, w))
-> ((forall a. m a -> m a) -> m (b, s, w)) -> m (b, s, w)
forall a b. (a -> b) -> a -> b
$ \restore :: forall a. m a -> m a
restore ->
RWST r w s m b -> r -> s -> m (b, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Lazy.runRWST ((forall a. RWST r w s m a -> RWST r w s m a) -> RWST r w s m b
act ((m (a, s, w) -> m (a, s, w)) -> RWST r w s m a -> RWST r w s m a
forall (m :: * -> *) a s w (n :: * -> *) b w' r.
(m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
Lazy.mapRWST m (a, s, w) -> m (a, s, w)
forall a. m a -> m a
restore)) r
r s
s
instance (Monoid w, MonadAsyncException m) =>
MonadAsyncException (Strict.RWST r w s m) where
mask :: ((forall a. RWST r w s m a -> RWST r w s m a) -> RWST r w s m b)
-> RWST r w s m b
mask act :: (forall a. RWST r w s m a -> RWST r w s m a) -> RWST r w s m b
act = (r -> s -> m (b, s, w)) -> RWST r w s m b
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST ((r -> s -> m (b, s, w)) -> RWST r w s m b)
-> (r -> s -> m (b, s, w)) -> RWST r w s m b
forall a b. (a -> b) -> a -> b
$ \r :: r
r s :: s
s -> ((forall a. m a -> m a) -> m (b, s, w)) -> m (b, s, w)
forall (m :: * -> *) b.
MonadAsyncException m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m (b, s, w)) -> m (b, s, w))
-> ((forall a. m a -> m a) -> m (b, s, w)) -> m (b, s, w)
forall a b. (a -> b) -> a -> b
$ \restore :: forall a. m a -> m a
restore ->
RWST r w s m b -> r -> s -> m (b, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Strict.runRWST ((forall a. RWST r w s m a -> RWST r w s m a) -> RWST r w s m b
act ((m (a, s, w) -> m (a, s, w)) -> RWST r w s m a -> RWST r w s m a
forall (m :: * -> *) a s w (n :: * -> *) b w' r.
(m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
Strict.mapRWST m (a, s, w) -> m (a, s, w)
forall a. m a -> m a
restore)) r
r s
s
instance (MonadAsyncException m) =>
MonadAsyncException (ReaderT r m) where
mask :: ((forall a. ReaderT r m a -> ReaderT r m a) -> ReaderT r m b)
-> ReaderT r m b
mask act :: (forall a. ReaderT r m a -> ReaderT r m a) -> ReaderT r m b
act = (r -> m b) -> ReaderT r m b
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m b) -> ReaderT r m b) -> (r -> m b) -> ReaderT r m b
forall a b. (a -> b) -> a -> b
$ \r :: r
r -> ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadAsyncException m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m b) -> m b)
-> ((forall a. m a -> m a) -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \restore :: forall a. m a -> m a
restore ->
ReaderT r m b -> r -> m b
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ((forall a. ReaderT r m a -> ReaderT r m a) -> ReaderT r m b
act ((m a -> m a) -> ReaderT r m a -> ReaderT r m a
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT m a -> m a
forall a. m a -> m a
restore)) r
r
instance (MonadAsyncException m) =>
MonadAsyncException (Lazy.StateT s m) where
mask :: ((forall a. StateT s m a -> StateT s m a) -> StateT s m b)
-> StateT s m b
mask act :: (forall a. StateT s m a -> StateT s m a) -> StateT s m b
act = (s -> m (b, s)) -> StateT s m b
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT ((s -> m (b, s)) -> StateT s m b)
-> (s -> m (b, s)) -> StateT s m b
forall a b. (a -> b) -> a -> b
$ \s :: s
s -> ((forall a. m a -> m a) -> m (b, s)) -> m (b, s)
forall (m :: * -> *) b.
MonadAsyncException m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m (b, s)) -> m (b, s))
-> ((forall a. m a -> m a) -> m (b, s)) -> m (b, s)
forall a b. (a -> b) -> a -> b
$ \restore :: forall a. m a -> m a
restore ->
StateT s m b -> s -> m (b, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Lazy.runStateT ((forall a. StateT s m a -> StateT s m a) -> StateT s m b
act ((m (a, s) -> m (a, s)) -> StateT s m a -> StateT s m a
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
Lazy.mapStateT m (a, s) -> m (a, s)
forall a. m a -> m a
restore)) s
s
instance (MonadAsyncException m) =>
MonadAsyncException (Strict.StateT s m) where
mask :: ((forall a. StateT s m a -> StateT s m a) -> StateT s m b)
-> StateT s m b
mask act :: (forall a. StateT s m a -> StateT s m a) -> StateT s m b
act = (s -> m (b, s)) -> StateT s m b
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT ((s -> m (b, s)) -> StateT s m b)
-> (s -> m (b, s)) -> StateT s m b
forall a b. (a -> b) -> a -> b
$ \s :: s
s -> ((forall a. m a -> m a) -> m (b, s)) -> m (b, s)
forall (m :: * -> *) b.
MonadAsyncException m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m (b, s)) -> m (b, s))
-> ((forall a. m a -> m a) -> m (b, s)) -> m (b, s)
forall a b. (a -> b) -> a -> b
$ \restore :: forall a. m a -> m a
restore ->
StateT s m b -> s -> m (b, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Strict.runStateT ((forall a. StateT s m a -> StateT s m a) -> StateT s m b
act ((m (a, s) -> m (a, s)) -> StateT s m a -> StateT s m a
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
Strict.mapStateT m (a, s) -> m (a, s)
forall a. m a -> m a
restore)) s
s
instance (Monoid w, MonadAsyncException m) =>
MonadAsyncException (Lazy.WriterT w m) where
mask :: ((forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b)
-> WriterT w m b
mask act :: (forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b
act = m (b, w) -> WriterT w m b
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT (m (b, w) -> WriterT w m b) -> m (b, w) -> WriterT w m b
forall a b. (a -> b) -> a -> b
$ ((forall a. m a -> m a) -> m (b, w)) -> m (b, w)
forall (m :: * -> *) b.
MonadAsyncException m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m (b, w)) -> m (b, w))
-> ((forall a. m a -> m a) -> m (b, w)) -> m (b, w)
forall a b. (a -> b) -> a -> b
$ \restore :: forall a. m a -> m a
restore ->
WriterT w m b -> m (b, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Lazy.runWriterT (WriterT w m b -> m (b, w)) -> WriterT w m b -> m (b, w)
forall a b. (a -> b) -> a -> b
$ (forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b
act ((m (a, w) -> m (a, w)) -> WriterT w m a -> WriterT w m a
forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
Lazy.mapWriterT m (a, w) -> m (a, w)
forall a. m a -> m a
restore)
instance (Monoid w, MonadAsyncException m) =>
MonadAsyncException (Strict.WriterT w m) where
mask :: ((forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b)
-> WriterT w m b
mask act :: (forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b
act = m (b, w) -> WriterT w m b
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT (m (b, w) -> WriterT w m b) -> m (b, w) -> WriterT w m b
forall a b. (a -> b) -> a -> b
$ ((forall a. m a -> m a) -> m (b, w)) -> m (b, w)
forall (m :: * -> *) b.
MonadAsyncException m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m (b, w)) -> m (b, w))
-> ((forall a. m a -> m a) -> m (b, w)) -> m (b, w)
forall a b. (a -> b) -> a -> b
$ \restore :: forall a. m a -> m a
restore ->
WriterT w m b -> m (b, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Strict.runWriterT (WriterT w m b -> m (b, w)) -> WriterT w m b -> m (b, w)
forall a b. (a -> b) -> a -> b
$ (forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b
act ((m (a, w) -> m (a, w)) -> WriterT w m a -> WriterT w m a
forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
Strict.mapWriterT m (a, w) -> m (a, w)
forall a. m a -> m a
restore)