{-# LANGUAGE CPP        #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Control.Monad.Class.MonadThrow.Trans () where

import Control.Monad.Except (ExceptT (..), runExceptT)
import Control.Monad.RWS.Lazy qualified as Lazy
import Control.Monad.RWS.Strict qualified as Strict
import Control.Monad.State.Lazy qualified as Lazy
import Control.Monad.State.Strict qualified as Strict
import Control.Monad.Trans (lift)
import Control.Monad.Writer.Lazy qualified as Lazy
import Control.Monad.Writer.Strict qualified as Strict

import Control.Monad.Class.MonadThrow

--
-- ExceptT Instances
--
-- These all follow the @exceptions@ package to the letter
--

instance MonadCatch m => MonadThrow (ExceptT e m) where
  throwIO :: forall e a. Exception e => e -> ExceptT e m a
throwIO = m a -> ExceptT e m a
forall (m :: * -> *) a. Monad m => 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 e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO
#if __GLASGOW_HASKELL__ >= 910
  annotateIO :: forall e a.
ExceptionAnnotation e =>
e -> ExceptT e m a -> ExceptT e m a
annotateIO e
ann (ExceptT m (Either e a)
io) = m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (e -> m (Either e a) -> m (Either e a)
forall e a. ExceptionAnnotation e => e -> m a -> m a
forall (m :: * -> *) e a.
(MonadThrow m, ExceptionAnnotation e) =>
e -> m a -> m a
annotateIO e
ann m (Either e a)
io)
#endif


instance MonadCatch m => MonadCatch (ExceptT e m) where
  catch :: forall e a.
Exception e =>
ExceptT e m a -> (e -> ExceptT e m a) -> ExceptT e m a
catch (ExceptT m (Either e a)
m) e -> ExceptT e m a
f = m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e a) -> ExceptT e m a)
-> m (Either e a) -> ExceptT e m a
forall a b. (a -> b) -> a -> b
$ m (Either e a) -> (e -> m (Either e a)) -> m (Either e a)
forall e a. Exception e => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch m (Either e a)
m (ExceptT e m a -> m (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT e m a -> m (Either e a))
-> (e -> ExceptT e m a) -> e -> m (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ExceptT e m a
f)

  generalBracket :: forall a b c.
ExceptT e m a
-> (a -> ExitCase b -> ExceptT e m c)
-> (a -> ExceptT e m b)
-> ExceptT e m (b, c)
generalBracket ExceptT e m a
acquire a -> ExitCase b -> ExceptT e m c
release a -> ExceptT e m b
use = m (Either e (b, c)) -> ExceptT e m (b, c)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e (b, c)) -> ExceptT e m (b, c))
-> m (Either e (b, c)) -> ExceptT e m (b, c)
forall a b. (a -> b) -> a -> b
$ do
    (eb, ec) <- m (Either e a)
-> (Either e a -> ExitCase (Either e b) -> m (Either e c))
-> (Either e a -> m (Either e b))
-> m (Either e b, Either e c)
forall a b c.
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
forall (m :: * -> *) a b c.
MonadCatch m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
      (ExceptT e m a -> m (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e m a
acquire)
      (\Either e a
eresource ExitCase (Either e b)
exitCase -> case Either e a
eresource of
        Left e
e -> Either e c -> m (Either e c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (e -> Either e c
forall a b. a -> Either a b
Left e
e) -- nothing to release, acquire didn't succeed
        Right a
resource -> case ExitCase (Either e b)
exitCase of
          ExitCaseSuccess (Right b
b) -> ExceptT e m c -> m (Either e c)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (a -> ExitCase b -> ExceptT e m c
release a
resource (b -> ExitCase b
forall a. a -> ExitCase a
ExitCaseSuccess b
b))
          ExitCaseException SomeException
e       -> ExceptT e m c -> m (Either e c)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (a -> ExitCase b -> ExceptT e m c
release a
resource (SomeException -> ExitCase b
forall a. SomeException -> ExitCase a
ExitCaseException SomeException
e))
          ExitCase (Either e b)
_                         -> ExceptT e m c -> m (Either e c)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (a -> ExitCase b -> ExceptT e m c
release a
resource ExitCase b
forall a. ExitCase a
ExitCaseAbort))
      ((e -> m (Either e b))
-> (a -> m (Either e b)) -> Either e a -> m (Either e b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either e b -> m (Either e b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e b -> m (Either e b))
-> (e -> Either e b) -> e -> m (Either e b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either e b
forall a b. a -> Either a b
Left) (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))
-> (a -> ExceptT e m b) -> a -> m (Either e b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ExceptT e m b
use))
    return $ do
      -- The order in which we perform those two 'Either' effects determines
      -- which error will win if they are both 'Left's. We want the error from
      -- 'release' to win.
      c <- ec
      b <- eb
      return (b, c)

instance MonadMask m => MonadMask (ExceptT e m) where
  mask :: forall b.
((forall a. ExceptT e m a -> ExceptT e m a) -> ExceptT e m b)
-> ExceptT e m b
mask (forall a. ExceptT e m a -> ExceptT e m a) -> ExceptT e m b
f = 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 b. ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask 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
$ \forall a. m a -> m a
u -> 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
f ((m (Either e a) -> m (Either e a))
-> ExceptT e m a -> ExceptT e m a
forall (m :: * -> *) e a.
(m (Either e a) -> m (Either e a))
-> ExceptT e m a -> ExceptT e m a
q m (Either e a) -> m (Either e a)
forall a. m a -> m a
u)
    where
      q :: (m (Either e a) -> m (Either e a))
        -> ExceptT e m a -> ExceptT e m a
      q :: forall (m :: * -> *) e a.
(m (Either e a) -> m (Either e a))
-> ExceptT e m a -> ExceptT e m a
q m (Either e a) -> m (Either e a)
u (ExceptT m (Either e a)
b) = m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e a) -> m (Either e a)
u m (Either e a)
b)
  uninterruptibleMask :: forall b.
((forall a. ExceptT e m a -> ExceptT e m a) -> ExceptT e m b)
-> ExceptT e m b
uninterruptibleMask (forall a. ExceptT e m a -> ExceptT e m a) -> ExceptT e m b
f = 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 b. ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask (((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
$ \forall a. m a -> m a
u -> 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
f ((m (Either e a) -> m (Either e a))
-> ExceptT e m a -> ExceptT e m a
forall (m :: * -> *) e a.
(m (Either e a) -> m (Either e a))
-> ExceptT e m a -> ExceptT e m a
q m (Either e a) -> m (Either e a)
forall a. m a -> m a
u)
    where
      q :: (m (Either e a) -> m (Either e a))
        -> ExceptT e m a -> ExceptT e m a
      q :: forall (m :: * -> *) e a.
(m (Either e a) -> m (Either e a))
-> ExceptT e m a -> ExceptT e m a
q m (Either e a) -> m (Either e a)
u (ExceptT m (Either e a)
b) = m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e a) -> m (Either e a)
u m (Either e a)
b)

--
-- Lazy.WriterT instances
--

-- | @since 1.0.0.0
instance (Monoid w, MonadCatch m) => MonadThrow (Lazy.WriterT w m) where
  throwIO :: forall e a. Exception e => e -> WriterT w m a
throwIO = m a -> WriterT w m a
forall (m :: * -> *) a. Monad m => 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 e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO

#if __GLASGOW_HASKELL__ >= 910
  annotateIO :: forall e a.
ExceptionAnnotation e =>
e -> WriterT w m a -> WriterT w m a
annotateIO e
ann (Lazy.WriterT m (a, w)
io) = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT (e -> m (a, w) -> m (a, w)
forall e a. ExceptionAnnotation e => e -> m a -> m a
forall (m :: * -> *) e a.
(MonadThrow m, ExceptionAnnotation e) =>
e -> m a -> m a
annotateIO e
ann m (a, w)
io)
#endif

-- | @since 1.0.0.0
instance (Monoid w, MonadCatch m) => MonadCatch (Lazy.WriterT w m) where
  catch :: forall e a.
Exception e =>
WriterT w m a -> (e -> WriterT w m a) -> WriterT w m a
catch (Lazy.WriterT m (a, w)
m) e -> WriterT w m a
f = 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
$ m (a, w) -> (e -> m (a, w)) -> m (a, w)
forall e a. Exception e => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch m (a, w)
m (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 (a, w))
-> (e -> WriterT w m a) -> e -> m (a, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> WriterT w m a
f)

  generalBracket :: forall a b c.
WriterT w m a
-> (a -> ExitCase b -> WriterT w m c)
-> (a -> WriterT w m b)
-> WriterT w m (b, c)
generalBracket WriterT w m a
acquire a -> ExitCase b -> WriterT w m c
release a -> WriterT w m b
use = m ((b, c), w) -> WriterT w m (b, c)
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT (m ((b, c), w) -> WriterT w m (b, c))
-> m ((b, c), w) -> WriterT w m (b, c)
forall a b. (a -> b) -> a -> b
$ (((b, w), (c, w)) -> ((b, c), w))
-> m ((b, w), (c, w)) -> m ((b, c), w)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b, w), (c, w)) -> ((b, c), w)
forall {a} {b} {b} {b}. ((a, b), (b, b)) -> ((a, b), b)
f (m ((b, w), (c, w)) -> m ((b, c), w))
-> m ((b, w), (c, w)) -> m ((b, c), w)
forall a b. (a -> b) -> a -> b
$
      m (a, w)
-> ((a, w) -> ExitCase (b, w) -> m (c, w))
-> ((a, w) -> m (b, w))
-> m ((b, w), (c, w))
forall a b c.
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
forall (m :: * -> *) a b c.
MonadCatch m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
        (WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Lazy.runWriterT WriterT w m a
acquire)
        (\(a
resource, w
w) ExitCase (b, w)
e ->
          case ExitCase (b, w)
e of
            ExitCaseSuccess (b
b, w
w') ->
              w -> (c, w) -> (c, w)
forall {b} {a}. Semigroup b => b -> (a, b) -> (a, b)
g w
w' ((c, w) -> (c, w)) -> m (c, w) -> m (c, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterT w m c -> m (c, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Lazy.runWriterT (a -> ExitCase b -> WriterT w m c
release a
resource (b -> ExitCase b
forall a. a -> ExitCase a
ExitCaseSuccess b
b))
            ExitCaseException SomeException
err ->
              w -> (c, w) -> (c, w)
forall {b} {a}. Semigroup b => b -> (a, b) -> (a, b)
g w
w  ((c, w) -> (c, w)) -> m (c, w) -> m (c, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterT w m c -> m (c, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Lazy.runWriterT (a -> ExitCase b -> WriterT w m c
release a
resource (SomeException -> ExitCase b
forall a. SomeException -> ExitCase a
ExitCaseException SomeException
err))
            ExitCase (b, w)
ExitCaseAbort ->
              w -> (c, w) -> (c, w)
forall {b} {a}. Semigroup b => b -> (a, b) -> (a, b)
g w
w  ((c, w) -> (c, w)) -> m (c, w) -> m (c, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterT w m c -> m (c, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Lazy.runWriterT (a -> ExitCase b -> WriterT w m c
release a
resource ExitCase b
forall a. ExitCase a
ExitCaseAbort))
        (\(a
resource, w
w)   -> w -> (b, w) -> (b, w)
forall {b} {a}. Semigroup b => b -> (a, b) -> (a, b)
g w
w ((b, w) -> (b, w)) -> m (b, w) -> m (b, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterT w m b -> m (b, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Lazy.runWriterT (a -> WriterT w m b
use a
resource))
    where f :: ((a, b), (b, b)) -> ((a, b), b)
f ((a
x,b
_),(b
y,b
w)) = ((a
x,b
y),b
w)
          g :: b -> (a, b) -> (a, b)
g b
w (a
a,b
w') = (a
a,b
wb -> b -> b
forall a. Semigroup a => a -> a -> a
<>b
w')

-- | @since 1.0.0.0
instance (Monoid w, MonadMask m) => MonadMask (Lazy.WriterT w m) where
  mask :: forall b.
((forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b)
-> WriterT w m b
mask (forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b
f = 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 b. ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask 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
$ \forall a. m a -> m a
u -> 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
f ((forall a. m a -> m a) -> WriterT w m a -> WriterT w m a
forall (m :: * -> *) w a.
(forall x. m x -> m x) -> WriterT w m a -> WriterT w m a
q m x -> m x
forall a. m a -> m a
u)
    where
      q :: (forall x. m x -> m x)
        -> Lazy.WriterT w m a -> Lazy.WriterT w m a
      q :: forall (m :: * -> *) w a.
(forall x. m x -> m x) -> WriterT w m a -> WriterT w m a
q forall x. m x -> m x
u (Lazy.WriterT m (a, w)
b) = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT (m (a, w) -> m (a, w)
forall x. m x -> m x
u m (a, w)
b)
  uninterruptibleMask :: forall b.
((forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b)
-> WriterT w m b
uninterruptibleMask (forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b
f = 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 b. ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask (((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
$ \forall a. m a -> m a
u -> 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
f ((forall a. m a -> m a) -> WriterT w m a -> WriterT w m a
forall (m :: * -> *) w a.
(forall x. m x -> m x) -> WriterT w m a -> WriterT w m a
q m x -> m x
forall a. m a -> m a
u)
    where
      q :: (forall x. m x -> m x)
        -> Lazy.WriterT w m a -> Lazy.WriterT w m a
      q :: forall (m :: * -> *) w a.
(forall x. m x -> m x) -> WriterT w m a -> WriterT w m a
q forall x. m x -> m x
u (Lazy.WriterT m (a, w)
b) = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT (m (a, w) -> m (a, w)
forall x. m x -> m x
u m (a, w)
b)

--
-- Strict.WriterT instances
--

-- | @since 1.0.0.0
instance (Monoid w, MonadCatch m) => MonadThrow (Strict.WriterT w m) where
  throwIO :: forall e a. Exception e => e -> WriterT w m a
throwIO = m a -> WriterT w m a
forall (m :: * -> *) a. Monad m => 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 e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO
#if __GLASGOW_HASKELL__ >= 910
  annotateIO :: forall e a.
ExceptionAnnotation e =>
e -> WriterT w m a -> WriterT w m a
annotateIO e
ann (Strict.WriterT m (a, w)
io) = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT (e -> m (a, w) -> m (a, w)
forall e a. ExceptionAnnotation e => e -> m a -> m a
forall (m :: * -> *) e a.
(MonadThrow m, ExceptionAnnotation e) =>
e -> m a -> m a
annotateIO e
ann m (a, w)
io)
#endif

-- | @since 1.0.0.0
instance (Monoid w, MonadCatch m) => MonadCatch (Strict.WriterT w m) where
  catch :: forall e a.
Exception e =>
WriterT w m a -> (e -> WriterT w m a) -> WriterT w m a
catch (Strict.WriterT m (a, w)
m) e -> WriterT w m a
f = 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
$ m (a, w) -> (e -> m (a, w)) -> m (a, w)
forall e a. Exception e => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch m (a, w)
m (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 (a, w))
-> (e -> WriterT w m a) -> e -> m (a, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> WriterT w m a
f)

  generalBracket :: forall a b c.
WriterT w m a
-> (a -> ExitCase b -> WriterT w m c)
-> (a -> WriterT w m b)
-> WriterT w m (b, c)
generalBracket WriterT w m a
acquire a -> ExitCase b -> WriterT w m c
release a -> WriterT w m b
use = m ((b, c), w) -> WriterT w m (b, c)
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT (m ((b, c), w) -> WriterT w m (b, c))
-> m ((b, c), w) -> WriterT w m (b, c)
forall a b. (a -> b) -> a -> b
$ (((b, w), (c, w)) -> ((b, c), w))
-> m ((b, w), (c, w)) -> m ((b, c), w)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b, w), (c, w)) -> ((b, c), w)
forall {a} {b} {b} {b}. ((a, b), (b, b)) -> ((a, b), b)
f (m ((b, w), (c, w)) -> m ((b, c), w))
-> m ((b, w), (c, w)) -> m ((b, c), w)
forall a b. (a -> b) -> a -> b
$
      m (a, w)
-> ((a, w) -> ExitCase (b, w) -> m (c, w))
-> ((a, w) -> m (b, w))
-> m ((b, w), (c, w))
forall a b c.
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
forall (m :: * -> *) a b c.
MonadCatch m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
        (WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Strict.runWriterT WriterT w m a
acquire)
        (\(a
resource, w
w) ExitCase (b, w)
e ->
          case ExitCase (b, w)
e of
            ExitCaseSuccess (b
b, w
w') ->
              w -> (c, w) -> (c, w)
forall {b} {a}. Semigroup b => b -> (a, b) -> (a, b)
g w
w' ((c, w) -> (c, w)) -> m (c, w) -> m (c, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterT w m c -> m (c, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Strict.runWriterT (a -> ExitCase b -> WriterT w m c
release a
resource (b -> ExitCase b
forall a. a -> ExitCase a
ExitCaseSuccess b
b))
            ExitCaseException SomeException
err ->
              w -> (c, w) -> (c, w)
forall {b} {a}. Semigroup b => b -> (a, b) -> (a, b)
g w
w  ((c, w) -> (c, w)) -> m (c, w) -> m (c, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterT w m c -> m (c, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Strict.runWriterT (a -> ExitCase b -> WriterT w m c
release a
resource (SomeException -> ExitCase b
forall a. SomeException -> ExitCase a
ExitCaseException SomeException
err))
            ExitCase (b, w)
ExitCaseAbort ->
              w -> (c, w) -> (c, w)
forall {b} {a}. Semigroup b => b -> (a, b) -> (a, b)
g w
w  ((c, w) -> (c, w)) -> m (c, w) -> m (c, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterT w m c -> m (c, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Strict.runWriterT (a -> ExitCase b -> WriterT w m c
release a
resource ExitCase b
forall a. ExitCase a
ExitCaseAbort))
        (\(a
resource, w
w)   -> w -> (b, w) -> (b, w)
forall {b} {a}. Semigroup b => b -> (a, b) -> (a, b)
g w
w ((b, w) -> (b, w)) -> m (b, w) -> m (b, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterT w m b -> m (b, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Strict.runWriterT (a -> WriterT w m b
use a
resource))
    where f :: ((a, b), (b, b)) -> ((a, b), b)
f ((a
x,b
_),(b
y,b
w)) = ((a
x,b
y),b
w)
          g :: b -> (a, b) -> (a, b)
g b
w (a
a,b
w') = (a
a,b
wb -> b -> b
forall a. Semigroup a => a -> a -> a
<>b
w')

-- | @since 1.0.0.0
instance (Monoid w, MonadMask m) => MonadMask (Strict.WriterT w m) where
  mask :: forall b.
((forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b)
-> WriterT w m b
mask (forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b
f = 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 b. ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask 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
$ \forall a. m a -> m a
u -> 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
f ((forall a. m a -> m a) -> WriterT w m a -> WriterT w m a
forall (m :: * -> *) w a.
(forall x. m x -> m x) -> WriterT w m a -> WriterT w m a
q m x -> m x
forall a. m a -> m a
u)
    where
      q :: (forall x. m x -> m x)
        -> Strict.WriterT w m a -> Strict.WriterT w m a
      q :: forall (m :: * -> *) w a.
(forall x. m x -> m x) -> WriterT w m a -> WriterT w m a
q forall x. m x -> m x
u (Strict.WriterT m (a, w)
b) = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT (m (a, w) -> m (a, w)
forall x. m x -> m x
u m (a, w)
b)
  uninterruptibleMask :: forall b.
((forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b)
-> WriterT w m b
uninterruptibleMask (forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b
f = 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 b. ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask (((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
$ \forall a. m a -> m a
u -> 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
f ((forall a. m a -> m a) -> WriterT w m a -> WriterT w m a
forall (m :: * -> *) w a.
(forall x. m x -> m x) -> WriterT w m a -> WriterT w m a
q m x -> m x
forall a. m a -> m a
u)
    where
      q :: (forall x. m x -> m x)
        -> Strict.WriterT w m a -> Strict.WriterT w m a
      q :: forall (m :: * -> *) w a.
(forall x. m x -> m x) -> WriterT w m a -> WriterT w m a
q forall x. m x -> m x
u (Strict.WriterT m (a, w)
b) = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT (m (a, w) -> m (a, w)
forall x. m x -> m x
u m (a, w)
b)


--
-- Lazy.RWST Instances
--

-- | @since 1.0.0.0
instance (Monoid w, MonadCatch m) => MonadThrow (Lazy.RWST r w s m) where
  throwIO :: forall e a. Exception e => e -> RWST r w s m a
throwIO = m a -> RWST r w s m a
forall (m :: * -> *) a. Monad m => 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 e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO
#if __GLASGOW_HASKELL__ >= 910
  annotateIO :: forall e a.
ExceptionAnnotation e =>
e -> RWST r w s m a -> RWST r w s m a
annotateIO e
ann (Lazy.RWST r -> s -> m (a, s, w)
io) = (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
r s
s -> e -> m (a, s, w) -> m (a, s, w)
forall e a. ExceptionAnnotation e => e -> m a -> m a
forall (m :: * -> *) e a.
(MonadThrow m, ExceptionAnnotation e) =>
e -> m a -> m a
annotateIO e
ann (r -> s -> m (a, s, w)
io r
r s
s))
#endif

-- | @since 1.0.0.0
instance (Monoid w, MonadCatch m) => MonadCatch (Lazy.RWST r w s m) where
  catch :: forall e a.
Exception e =>
RWST r w s m a -> (e -> RWST r w s m a) -> RWST r w s m a
catch (Lazy.RWST r -> s -> m (a, s, w)
m) e -> RWST r w s m a
f = (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 s
s -> m (a, s, w) -> (e -> m (a, s, w)) -> m (a, s, w)
forall e a. Exception e => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (r -> s -> m (a, s, w)
m r
r s
s) (\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
f e
e) r
r s
s)

  -- | general bracket ignores the state produced by the release callback
  generalBracket :: forall a b c.
RWST r w s m a
-> (a -> ExitCase b -> RWST r w s m c)
-> (a -> RWST r w s m b)
-> RWST r w s m (b, c)
generalBracket RWST r w s m a
acquire a -> ExitCase b -> RWST r w s m c
release a -> RWST r w s m b
use = (r -> s -> m ((b, c), s, w)) -> RWST r w s m (b, c)
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST ((r -> s -> m ((b, c), s, w)) -> RWST r w s m (b, c))
-> (r -> s -> m ((b, c), s, w)) -> RWST r w s m (b, c)
forall a b. (a -> b) -> a -> b
$ \r
r s
s ->
      ((b, s, w), (c, s, w)) -> ((b, c), s, w)
forall {a} {b} {c} {b} {b} {c}.
((a, b, c), (b, b, c)) -> ((a, b), b, c)
f (((b, s, w), (c, s, w)) -> ((b, c), s, w))
-> m ((b, s, w), (c, s, w)) -> m ((b, c), s, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (a, s, w)
-> ((a, s, w) -> ExitCase (b, s, w) -> m (c, s, w))
-> ((a, s, w) -> m (b, s, w))
-> m ((b, s, w), (c, s, w))
forall a b c.
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
forall (m :: * -> *) a b c.
MonadCatch m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
              (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
acquire r
r s
s)
              (\(a
resource, s
s', w
w') ExitCase (b, s, w)
e ->
                case ExitCase (b, s, w)
e of
                  ExitCaseSuccess (b
b, s
s'', w
w'') ->
                    w -> (c, s, w) -> (c, s, w)
forall {c} {a} {b}. Semigroup c => c -> (a, b, c) -> (a, b, c)
g w
w'' ((c, s, w) -> (c, s, w)) -> m (c, s, w) -> m (c, s, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST r w s m c -> r -> s -> m (c, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Lazy.runRWST (a -> ExitCase b -> RWST r w s m c
release a
resource (b -> ExitCase b
forall a. a -> ExitCase a
ExitCaseSuccess b
b)) r
r s
s''
                  ExitCaseException SomeException
err ->
                    w -> (c, s, w) -> (c, s, w)
forall {c} {a} {b}. Semigroup c => c -> (a, b, c) -> (a, b, c)
g w
w'  ((c, s, w) -> (c, s, w)) -> m (c, s, w) -> m (c, s, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST r w s m c -> r -> s -> m (c, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Lazy.runRWST (a -> ExitCase b -> RWST r w s m c
release a
resource (SomeException -> ExitCase b
forall a. SomeException -> ExitCase a
ExitCaseException SomeException
err)) r
r s
s'
                  ExitCase (b, s, w)
ExitCaseAbort ->
                    w -> (c, s, w) -> (c, s, w)
forall {c} {a} {b}. Semigroup c => c -> (a, b, c) -> (a, b, c)
g w
w'  ((c, s, w) -> (c, s, w)) -> m (c, s, w) -> m (c, s, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST r w s m c -> r -> s -> m (c, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Lazy.runRWST (a -> ExitCase b -> RWST r w s m c
release a
resource  ExitCase b
forall a. ExitCase a
ExitCaseAbort) r
r s
s')
              (\(a
a, s
s', w
w')   -> w -> (b, s, w) -> (b, s, w)
forall {c} {a} {b}. Semigroup c => c -> (a, b, c) -> (a, b, c)
g w
w' ((b, s, w) -> (b, s, w)) -> m (b, s, w) -> m (b, s, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 (a -> RWST r w s m b
use a
a) r
r s
s')
    where
      f :: ((a, b, c), (b, b, c)) -> ((a, b), b, c)
f ((a
x,b
_,c
_),(b
y,b
s,c
w)) = ((a
x,b
y),b
s,c
w)
      g :: c -> (a, b, c) -> (a, b, c)
g c
w (a
x,b
s,c
w') = (a
x,b
s,c
wc -> c -> c
forall a. Semigroup a => a -> a -> a
<>c
w')

-- | @since 1.0.0.0
instance (Monoid w, MonadMask m) => MonadMask (Lazy.RWST r w s m) where
  mask :: forall b.
((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 (forall a. RWST r w s m a -> RWST r w s m a) -> RWST r w s m b
f = (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 s
s -> ((forall a. m a -> m a) -> m (b, s, w)) -> m (b, s, w)
forall b. ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask 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
$ \forall a. m a -> m a
u -> 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
f ((forall a. m a -> m a) -> RWST r w s m a -> RWST r w s m a
forall (m :: * -> *) r w s a.
(forall x. m x -> m x) -> RWST r w s m a -> RWST r w s m a
q m x -> m x
forall a. m a -> m a
u)) r
r s
s
    where
      q :: (forall x. m x -> m x)
        -> Lazy.RWST r w s m a -> Lazy.RWST r w s m a
      q :: forall (m :: * -> *) r w s a.
(forall x. m x -> m x) -> RWST r w s m a -> RWST r w s m a
q forall x. m x -> m x
u (Lazy.RWST r -> s -> m (a, s, w)
b) = (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 s
s -> m (a, s, w) -> m (a, s, w)
forall x. m x -> m x
u (r -> s -> m (a, s, w)
b r
r s
s)
  uninterruptibleMask :: forall b.
((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
uninterruptibleMask (forall a. RWST r w s m a -> RWST r w s m a) -> RWST r w s m b
f = (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 s
s -> ((forall a. m a -> m a) -> m (b, s, w)) -> m (b, s, w)
forall b. ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask (((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
$ \forall a. m a -> m a
u -> 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
f ((forall a. m a -> m a) -> RWST r w s m a -> RWST r w s m a
forall (m :: * -> *) r w s a.
(forall x. m x -> m x) -> RWST r w s m a -> RWST r w s m a
q m x -> m x
forall a. m a -> m a
u)) r
r s
s
    where
      q :: (forall x. m x -> m x)
        -> Lazy.RWST r w s m a -> Lazy.RWST r w s m a
      q :: forall (m :: * -> *) r w s a.
(forall x. m x -> m x) -> RWST r w s m a -> RWST r w s m a
q forall x. m x -> m x
u (Lazy.RWST r -> s -> m (a, s, w)
b) = (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 s
s -> m (a, s, w) -> m (a, s, w)
forall x. m x -> m x
u (r -> s -> m (a, s, w)
b r
r s
s)


--
-- Strict.RWST Instances
--

-- | @since 1.0.0.0
instance (Monoid w, MonadCatch m) => MonadThrow (Strict.RWST r w s m) where
  throwIO :: forall e a. Exception e => e -> RWST r w s m a
throwIO = m a -> RWST r w s m a
forall (m :: * -> *) a. Monad m => 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 e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO
#if __GLASGOW_HASKELL__ >= 910
  annotateIO :: forall e a.
ExceptionAnnotation e =>
e -> RWST r w s m a -> RWST r w s m a
annotateIO e
ann (Strict.RWST r -> s -> m (a, s, w)
io) = (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
r s
s -> e -> m (a, s, w) -> m (a, s, w)
forall e a. ExceptionAnnotation e => e -> m a -> m a
forall (m :: * -> *) e a.
(MonadThrow m, ExceptionAnnotation e) =>
e -> m a -> m a
annotateIO e
ann (r -> s -> m (a, s, w)
io r
r s
s))
#endif

-- | @since 1.0.0.0
instance (Monoid w, MonadCatch m) => MonadCatch (Strict.RWST r w s m) where
  catch :: forall e a.
Exception e =>
RWST r w s m a -> (e -> RWST r w s m a) -> RWST r w s m a
catch (Strict.RWST r -> s -> m (a, s, w)
m) e -> RWST r w s m a
f = (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 s
s -> m (a, s, w) -> (e -> m (a, s, w)) -> m (a, s, w)
forall e a. Exception e => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (r -> s -> m (a, s, w)
m r
r s
s) (\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
f e
e) r
r s
s)

  -- | general bracket ignores the state produced by the release callback
  generalBracket :: forall a b c.
RWST r w s m a
-> (a -> ExitCase b -> RWST r w s m c)
-> (a -> RWST r w s m b)
-> RWST r w s m (b, c)
generalBracket RWST r w s m a
acquire a -> ExitCase b -> RWST r w s m c
release a -> RWST r w s m b
use = (r -> s -> m ((b, c), s, w)) -> RWST r w s m (b, c)
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST ((r -> s -> m ((b, c), s, w)) -> RWST r w s m (b, c))
-> (r -> s -> m ((b, c), s, w)) -> RWST r w s m (b, c)
forall a b. (a -> b) -> a -> b
$ \r
r s
s ->
      ((b, s, w), (c, s, w)) -> ((b, c), s, w)
forall {a} {b} {c} {b} {b} {c}.
((a, b, c), (b, b, c)) -> ((a, b), b, c)
f (((b, s, w), (c, s, w)) -> ((b, c), s, w))
-> m ((b, s, w), (c, s, w)) -> m ((b, c), s, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (a, s, w)
-> ((a, s, w) -> ExitCase (b, s, w) -> m (c, s, w))
-> ((a, s, w) -> m (b, s, w))
-> m ((b, s, w), (c, s, w))
forall a b c.
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
forall (m :: * -> *) a b c.
MonadCatch m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
              (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
acquire r
r s
s)
              (\(a
resource, s
s', w
w') ExitCase (b, s, w)
e ->
                case ExitCase (b, s, w)
e of
                  ExitCaseSuccess (b
b, s
s'', w
w'') ->
                    w -> (c, s, w) -> (c, s, w)
forall {c} {a} {b}. Semigroup c => c -> (a, b, c) -> (a, b, c)
g w
w'' ((c, s, w) -> (c, s, w)) -> m (c, s, w) -> m (c, s, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST r w s m c -> r -> s -> m (c, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Strict.runRWST (a -> ExitCase b -> RWST r w s m c
release a
resource (b -> ExitCase b
forall a. a -> ExitCase a
ExitCaseSuccess b
b)) r
r s
s''
                  ExitCaseException SomeException
err ->
                    w -> (c, s, w) -> (c, s, w)
forall {c} {a} {b}. Semigroup c => c -> (a, b, c) -> (a, b, c)
g w
w'  ((c, s, w) -> (c, s, w)) -> m (c, s, w) -> m (c, s, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST r w s m c -> r -> s -> m (c, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Strict.runRWST (a -> ExitCase b -> RWST r w s m c
release a
resource (SomeException -> ExitCase b
forall a. SomeException -> ExitCase a
ExitCaseException SomeException
err)) r
r s
s'
                  ExitCase (b, s, w)
ExitCaseAbort ->
                    w -> (c, s, w) -> (c, s, w)
forall {c} {a} {b}. Semigroup c => c -> (a, b, c) -> (a, b, c)
g w
w'  ((c, s, w) -> (c, s, w)) -> m (c, s, w) -> m (c, s, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST r w s m c -> r -> s -> m (c, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Strict.runRWST (a -> ExitCase b -> RWST r w s m c
release a
resource  ExitCase b
forall a. ExitCase a
ExitCaseAbort) r
r s
s')
              (\(a
a, s
s', w
w')   -> w -> (b, s, w) -> (b, s, w)
forall {c} {a} {b}. Semigroup c => c -> (a, b, c) -> (a, b, c)
g w
w' ((b, s, w) -> (b, s, w)) -> m (b, s, w) -> m (b, s, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 (a -> RWST r w s m b
use a
a) r
r s
s')
    where
      f :: ((a, b, c), (b, b, c)) -> ((a, b), b, c)
f ((a
x,b
_,c
_),(b
y,b
s,c
w)) = ((a
x,b
y),b
s,c
w)
      g :: c -> (a, b, c) -> (a, b, c)
g c
w (a
x,b
s,c
w') = (a
x,b
s,c
wc -> c -> c
forall a. Semigroup a => a -> a -> a
<>c
w')

-- | @since 1.0.0.0
instance (Monoid w, MonadMask m) => MonadMask (Strict.RWST r w s m) where
  mask :: forall b.
((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 (forall a. RWST r w s m a -> RWST r w s m a) -> RWST r w s m b
f = (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 s
s -> ((forall a. m a -> m a) -> m (b, s, w)) -> m (b, s, w)
forall b. ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask 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
$ \forall a. m a -> m a
u -> 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
f ((forall a. m a -> m a) -> RWST r w s m a -> RWST r w s m a
forall (m :: * -> *) r w s a.
(forall x. m x -> m x) -> RWST r w s m a -> RWST r w s m a
q m x -> m x
forall a. m a -> m a
u)) r
r s
s
    where
      q :: (forall x. m x -> m x)
        -> Strict.RWST r w s m a -> Strict.RWST r w s m a
      q :: forall (m :: * -> *) r w s a.
(forall x. m x -> m x) -> RWST r w s m a -> RWST r w s m a
q forall x. m x -> m x
u (Strict.RWST r -> s -> m (a, s, w)
b) = (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 s
s -> m (a, s, w) -> m (a, s, w)
forall x. m x -> m x
u (r -> s -> m (a, s, w)
b r
r s
s)
  uninterruptibleMask :: forall b.
((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
uninterruptibleMask (forall a. RWST r w s m a -> RWST r w s m a) -> RWST r w s m b
f = (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 s
s -> ((forall a. m a -> m a) -> m (b, s, w)) -> m (b, s, w)
forall b. ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask (((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
$ \forall a. m a -> m a
u -> 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
f ((forall a. m a -> m a) -> RWST r w s m a -> RWST r w s m a
forall (m :: * -> *) r w s a.
(forall x. m x -> m x) -> RWST r w s m a -> RWST r w s m a
q m x -> m x
forall a. m a -> m a
u)) r
r s
s
    where
      q :: (forall x. m x -> m x)
        -> Strict.RWST r w s m a -> Strict.RWST r w s m a
      q :: forall (m :: * -> *) r w s a.
(forall x. m x -> m x) -> RWST r w s m a -> RWST r w s m a
q forall x. m x -> m x
u (Strict.RWST r -> s -> m (a, s, w)
b) = (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 s
s -> m (a, s, w) -> m (a, s, w)
forall x. m x -> m x
u (r -> s -> m (a, s, w)
b r
r s
s)


--
-- Lazy.StateT instances
--

-- | @since 1.0.0.0
instance MonadCatch m => MonadThrow (Lazy.StateT s m) where
  throwIO :: forall e a. Exception e => e -> StateT s m a
throwIO = m a -> StateT s m a
forall (m :: * -> *) a. Monad m => 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 e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO
#if __GLASGOW_HASKELL__ >= 910
  annotateIO :: forall e a.
ExceptionAnnotation e =>
e -> StateT s m a -> StateT s m a
annotateIO e
ann (Lazy.StateT s -> m (a, s)
io) = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT (\s
s -> e -> m (a, s) -> m (a, s)
forall e a. ExceptionAnnotation e => e -> m a -> m a
forall (m :: * -> *) e a.
(MonadThrow m, ExceptionAnnotation e) =>
e -> m a -> m a
annotateIO e
ann (s -> m (a, s)
io s
s))
#endif

-- | @since 1.0.0.0
instance MonadCatch m => MonadCatch (Lazy.StateT s m) where
  catch :: forall e a.
Exception e =>
StateT s m a -> (e -> StateT s m a) -> StateT s m a
catch (Lazy.StateT s -> m (a, s)
m) e -> StateT s m a
f = (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 -> m (a, s) -> (e -> m (a, s)) -> m (a, s)
forall e a. Exception e => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (s -> m (a, s)
m s
s) (\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
f e
e) s
s)

  -- | general bracket ignores the state produced by the release callback
  generalBracket :: forall a b c.
StateT s m a
-> (a -> ExitCase b -> StateT s m c)
-> (a -> StateT s m b)
-> StateT s m (b, c)
generalBracket StateT s m a
acquire a -> ExitCase b -> StateT s m c
release a -> StateT s m b
use = (s -> m ((b, c), s)) -> StateT s m (b, c)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT ((s -> m ((b, c), s)) -> StateT s m (b, c))
-> (s -> m ((b, c), s)) -> StateT s m (b, c)
forall a b. (a -> b) -> a -> b
$ \s
s -> (((b, s), (c, s)) -> ((b, c), s))
-> m ((b, s), (c, s)) -> m ((b, c), s)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b, s), (c, s)) -> ((b, c), s)
forall {a} {b} {b} {b}. ((a, b), (b, b)) -> ((a, b), b)
f (m ((b, s), (c, s)) -> m ((b, c), s))
-> m ((b, s), (c, s)) -> m ((b, c), s)
forall a b. (a -> b) -> a -> b
$
      m (a, s)
-> ((a, s) -> ExitCase (b, s) -> m (c, s))
-> ((a, s) -> m (b, s))
-> m ((b, s), (c, s))
forall a b c.
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
forall (m :: * -> *) a b c.
MonadCatch m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
        (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
acquire s
s)
        (\(a
resource, s
s') ExitCase (b, s)
e ->
          case ExitCase (b, s)
e of
            ExitCaseSuccess (b
b, s
s'') ->
              StateT s m c -> s -> m (c, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Lazy.runStateT (a -> ExitCase b -> StateT s m c
release a
resource (b -> ExitCase b
forall a. a -> ExitCase a
ExitCaseSuccess b
b)) s
s''
            ExitCaseException SomeException
err ->
              StateT s m c -> s -> m (c, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Lazy.runStateT (a -> ExitCase b -> StateT s m c
release a
resource (SomeException -> ExitCase b
forall a. SomeException -> ExitCase a
ExitCaseException SomeException
err)) s
s'
            ExitCase (b, s)
ExitCaseAbort ->
              StateT s m c -> s -> m (c, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Lazy.runStateT (a -> ExitCase b -> StateT s m c
release a
resource ExitCase b
forall a. ExitCase a
ExitCaseAbort) s
s')
        (\(a
a, s
s')   -> StateT s m b -> s -> m (b, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Lazy.runStateT (a -> StateT s m b
use a
a) s
s')
    where f :: ((a, b), (b, b)) -> ((a, b), b)
f ((a
x,b
_),(b
y,b
s)) = ((a
x,b
y),b
s)

-- | @since 1.0.0.0
instance MonadMask m => MonadMask (Lazy.StateT s m) where
  mask :: forall b.
((forall a. StateT s m a -> StateT s m a) -> StateT s m b)
-> StateT s m b
mask (forall a. StateT s m a -> StateT s m a) -> StateT s m b
f = (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 -> ((forall a. m a -> m a) -> m (b, s)) -> m (b, s)
forall b. ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask 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
$ \forall a. m a -> m a
u -> 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
f ((forall a. m a -> m a) -> StateT s m a -> StateT s m a
forall (m :: * -> *) s a.
(forall x. m x -> m x) -> StateT s m a -> StateT s m a
q m x -> m x
forall a. m a -> m a
u)) s
s
    where
      q :: (forall x. m x -> m x)
        -> Lazy.StateT s m a -> Lazy.StateT s m a
      q :: forall (m :: * -> *) s a.
(forall x. m x -> m x) -> StateT s m a -> StateT s m a
q forall x. m x -> m x
u (Lazy.StateT s -> m (a, s)
b) = (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 -> m (a, s) -> m (a, s)
forall x. m x -> m x
u (s -> m (a, s)
b s
s)
  uninterruptibleMask :: forall b.
((forall a. StateT s m a -> StateT s m a) -> StateT s m b)
-> StateT s m b
uninterruptibleMask (forall a. StateT s m a -> StateT s m a) -> StateT s m b
f = (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 -> ((forall a. m a -> m a) -> m (b, s)) -> m (b, s)
forall b. ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask (((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
$ \forall a. m a -> m a
u -> 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
f ((forall a. m a -> m a) -> StateT s m a -> StateT s m a
forall (m :: * -> *) s a.
(forall x. m x -> m x) -> StateT s m a -> StateT s m a
q m x -> m x
forall a. m a -> m a
u)) s
s
    where
      q :: (forall x. m x -> m x)
        -> Lazy.StateT s m a -> Lazy.StateT s m a
      q :: forall (m :: * -> *) s a.
(forall x. m x -> m x) -> StateT s m a -> StateT s m a
q forall x. m x -> m x
u (Lazy.StateT s -> m (a, s)
b) = (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 -> m (a, s) -> m (a, s)
forall x. m x -> m x
u (s -> m (a, s)
b s
s)


--
-- Strict.StateT instances
--

-- | @since 1.0.0.0
instance MonadCatch m => MonadThrow (Strict.StateT s m) where
  throwIO :: forall e a. Exception e => e -> StateT s m a
throwIO = m a -> StateT s m a
forall (m :: * -> *) a. Monad m => 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 e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO
#if __GLASGOW_HASKELL__ >= 910
  annotateIO :: forall e a.
ExceptionAnnotation e =>
e -> StateT s m a -> StateT s m a
annotateIO e
ann (Strict.StateT s -> m (a, s)
io) = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT (\s
s -> e -> m (a, s) -> m (a, s)
forall e a. ExceptionAnnotation e => e -> m a -> m a
forall (m :: * -> *) e a.
(MonadThrow m, ExceptionAnnotation e) =>
e -> m a -> m a
annotateIO e
ann (s -> m (a, s)
io s
s))
#endif

-- | @since 1.0.0.0
instance MonadCatch m => MonadCatch (Strict.StateT s m) where
  catch :: forall e a.
Exception e =>
StateT s m a -> (e -> StateT s m a) -> StateT s m a
catch (Strict.StateT s -> m (a, s)
m) e -> StateT s m a
f = (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 -> m (a, s) -> (e -> m (a, s)) -> m (a, s)
forall e a. Exception e => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (s -> m (a, s)
m s
s) (\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
f e
e) s
s)

  -- | general bracket ignores the state produced by the release callback
  generalBracket :: forall a b c.
StateT s m a
-> (a -> ExitCase b -> StateT s m c)
-> (a -> StateT s m b)
-> StateT s m (b, c)
generalBracket StateT s m a
acquire a -> ExitCase b -> StateT s m c
release a -> StateT s m b
use = (s -> m ((b, c), s)) -> StateT s m (b, c)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT ((s -> m ((b, c), s)) -> StateT s m (b, c))
-> (s -> m ((b, c), s)) -> StateT s m (b, c)
forall a b. (a -> b) -> a -> b
$ \s
s -> (((b, s), (c, s)) -> ((b, c), s))
-> m ((b, s), (c, s)) -> m ((b, c), s)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b, s), (c, s)) -> ((b, c), s)
forall {a} {b} {b} {b}. ((a, b), (b, b)) -> ((a, b), b)
f (m ((b, s), (c, s)) -> m ((b, c), s))
-> m ((b, s), (c, s)) -> m ((b, c), s)
forall a b. (a -> b) -> a -> b
$
      m (a, s)
-> ((a, s) -> ExitCase (b, s) -> m (c, s))
-> ((a, s) -> m (b, s))
-> m ((b, s), (c, s))
forall a b c.
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
forall (m :: * -> *) a b c.
MonadCatch m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
        (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
acquire s
s)
        (\(a
resource, s
s') ExitCase (b, s)
e ->
          case ExitCase (b, s)
e of
            ExitCaseSuccess (b
b, s
s'') ->
              StateT s m c -> s -> m (c, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Strict.runStateT (a -> ExitCase b -> StateT s m c
release a
resource (b -> ExitCase b
forall a. a -> ExitCase a
ExitCaseSuccess b
b)) s
s''
            ExitCaseException SomeException
err ->
              StateT s m c -> s -> m (c, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Strict.runStateT (a -> ExitCase b -> StateT s m c
release a
resource (SomeException -> ExitCase b
forall a. SomeException -> ExitCase a
ExitCaseException SomeException
err)) s
s'
            ExitCase (b, s)
ExitCaseAbort ->
              StateT s m c -> s -> m (c, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Strict.runStateT (a -> ExitCase b -> StateT s m c
release a
resource ExitCase b
forall a. ExitCase a
ExitCaseAbort) s
s')
        (\(a
a, s
s')   -> StateT s m b -> s -> m (b, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Strict.runStateT (a -> StateT s m b
use a
a) s
s')
    where f :: ((a, b), (b, b)) -> ((a, b), b)
f ((a
x,b
_),(b
y,b
s)) = ((a
x,b
y),b
s)

-- | @since 1.0.0.0
instance MonadMask m => MonadMask (Strict.StateT s m) where
  mask :: forall b.
((forall a. StateT s m a -> StateT s m a) -> StateT s m b)
-> StateT s m b
mask (forall a. StateT s m a -> StateT s m a) -> StateT s m b
f = (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 -> ((forall a. m a -> m a) -> m (b, s)) -> m (b, s)
forall b. ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask 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
$ \forall a. m a -> m a
u -> 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
f ((forall a. m a -> m a) -> StateT s m a -> StateT s m a
forall (m :: * -> *) s a.
(forall x. m x -> m x) -> StateT s m a -> StateT s m a
q m x -> m x
forall a. m a -> m a
u)) s
s
    where
      q :: (forall x. m x -> m x)
        -> Strict.StateT s m a -> Strict.StateT s m a
      q :: forall (m :: * -> *) s a.
(forall x. m x -> m x) -> StateT s m a -> StateT s m a
q forall x. m x -> m x
u (Strict.StateT s -> m (a, s)
b) = (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 -> m (a, s) -> m (a, s)
forall x. m x -> m x
u (s -> m (a, s)
b s
s)
  uninterruptibleMask :: forall b.
((forall a. StateT s m a -> StateT s m a) -> StateT s m b)
-> StateT s m b
uninterruptibleMask (forall a. StateT s m a -> StateT s m a) -> StateT s m b
f = (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 -> ((forall a. m a -> m a) -> m (b, s)) -> m (b, s)
forall b. ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask (((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
$ \forall a. m a -> m a
u -> 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
f ((forall a. m a -> m a) -> StateT s m a -> StateT s m a
forall (m :: * -> *) s a.
(forall x. m x -> m x) -> StateT s m a -> StateT s m a
q m x -> m x
forall a. m a -> m a
u)) s
s
    where
      q :: (forall x. m x -> m x)
        -> Strict.StateT s m a -> Strict.StateT s m a
      q :: forall (m :: * -> *) s a.
(forall x. m x -> m x) -> StateT s m a -> StateT s m a
q forall x. m x -> m x
u (Strict.StateT s -> m (a, s)
b) = (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 -> m (a, s) -> m (a, s)
forall x. m x -> m x
u (s -> m (a, s)
b s
s)