{-# LANGUAGE CPP #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif

#ifndef MIN_VERSION_transformers
#define MIN_VERSION_transformers(x,y,z) 1
#endif

#if !(MIN_VERSION_transformers(0,6,0))
{-# OPTIONS_GHC -fno-warn-deprecations #-}
#endif
--------------------------------------------------------------------

-- |

-- Copyright   :  (C) Edward Kmett 2013-2015, (c) Google Inc. 2012

-- License     :  BSD-style (see the file LICENSE)

-- Maintainer  :  Edward Kmett <ekmett@gmail.com>

-- Stability   :  experimental

-- Portability :  non-portable

--

-- This module supports monads that can throw extensible exceptions. The

-- exceptions are the very same from "Control.Exception", and the operations

-- offered very similar, but here they are not limited to 'IO'.

--

-- This code is in the style of both transformers and mtl, and is compatible

-- with them, though doesn't mimic the module structure or offer the complete

-- range of features in those packages.

--

-- This is very similar to 'ErrorT' and 'MonadError', but based on features of

-- "Control.Exception". In particular, it handles the complex case of

-- asynchronous exceptions by including 'mask' in the typeclass. Note that the

-- extensible exceptions feature relies on the RankNTypes language extension.

--------------------------------------------------------------------


module Control.Monad.Catch (
    -- * Typeclass

    -- $mtl

    MonadThrow(..)
  , MonadCatch(..)
  , MonadMask(..)
  , ExitCase(..)

    -- * Utilities

    -- $utilities

  , mask_
  , uninterruptibleMask_
  , catchAll
  , catchIOError
  , catchJust
  , catchIf
  , Handler(..), catches
  , handle
  , handleAll
  , handleIOError
  , handleJust
  , handleIf
  , try
  , tryJust
  , onException
  , onError
  , bracket
  , bracket_
  , finally
  , bracketOnError
    -- * Re-exports from Control.Exception

  , Exception(..)
  , SomeException(..)
  ) where

import Control.Exception (Exception(..), SomeException(..))
import qualified Control.Exception as ControlException
import Control.Monad (liftM)
import qualified Control.Monad.STM as STM
import qualified Control.Monad.Trans.RWS.Lazy as LazyRWS
import qualified Control.Monad.Trans.RWS.Strict as StrictRWS
import qualified Control.Monad.Trans.State.Lazy as LazyS
import qualified Control.Monad.Trans.State.Strict as StrictS
import qualified Control.Monad.Trans.Writer.Lazy as LazyW
import qualified Control.Monad.Trans.Writer.Strict as StrictW
import Control.Monad.ST (ST)
import Control.Monad.STM (STM)
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
import Control.Monad.Trans.Except (ExceptT(..), runExceptT)
import Control.Monad.Trans.Cont (ContT)
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Reader (ReaderT(..), runReaderT)

import Language.Haskell.TH.Syntax (Q)

#if MIN_VERSION_base(4,4,0)
import Control.Monad.ST.Unsafe (unsafeIOToST)
#else
import Control.Monad.ST (unsafeIOToST)
#endif

#if __GLASGOW_HASKELL__ < 706
import Prelude hiding (catch, foldr)
import Data.Foldable
import Data.Monoid
#elif __GLASGOW_HASKELL__ < 710
import Prelude hiding (foldr)
import Data.Foldable
import Data.Monoid
#endif

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif

#if __GLASGOW_HASKELL__ >= 800
import GHC.Stack (HasCallStack, withFrozenCallStack)
#endif

#if !(MIN_VERSION_transformers(0,6,0))
import Control.Monad.Trans.Error (ErrorT(..), Error, runErrorT)
import Control.Monad.Trans.List (ListT(..), runListT)
#endif

-- We use the following bit of CPP to enable the use of HasCallStack

-- constraints without breaking the build for pre-8.0 GHCs, which did not

-- provide GHC.Stack. We are careful to always write constraints like this:

--

--   HAS_CALL_STACK => MonadThrow m => ...

--

-- Instead of like this:

--

--   (HAS_CALL_STACK, MonadThrow e) => ...

--

-- The latter is equivalent to (() :: Constraint, MonadThrow e) => ..., which

-- requires ConstraintKinds. More importantly, it's slightly less efficient,

-- since it requires passing an empty constraint tuple dictionary around.

--

-- Note that we do /not/ depend on the call-stack compatibility library to

-- provide HasCallStack on older GHCs. We tried this at one point, but we

-- discovered that downstream libraries failed to build because combining

-- call-stack with GeneralizedNewtypeDeriving on older GHCs would require the

-- use of ConstraintKinds/FlexibleContexts, which downstream libraries did not

-- enable. (See #91.) The CPP approach that we use now, while somewhat clunky,

-- avoids these issues by not requiring any additional language extensions for

-- downstream users.

#if __GLASGOW_HASKELL__ >= 800
# define HAS_CALL_STACK HasCallStack
#else
# define HAS_CALL_STACK ()

withFrozenCallStack :: a -> a
withFrozenCallStack a = a
#endif

------------------------------------------------------------------------------

-- $mtl

-- The mtl style typeclass

------------------------------------------------------------------------------


-- | A class for monads in which exceptions may be thrown.

--

-- Instances should obey the following law:

--

-- > throwM e >> x = throwM e

--

-- In other words, throwing an exception short-circuits the rest of the monadic

-- computation.

class Monad m => MonadThrow m where
  -- | Throw an exception. Note that this throws when this action is run in

  -- the monad @m@, not when it is applied. It is a generalization of

  -- "Control.Exception"'s 'ControlException.throwIO'.

  --

  -- Should satisfy the law:

  --

  -- > throwM e >> f = throwM e

  throwM :: HAS_CALL_STACK => Exception e => e -> m a

-- | A class for monads which allow exceptions to be caught, in particular

-- exceptions which were thrown by 'throwM'.

--

-- Instances should obey the following law:

--

-- > catch (throwM e) f = f e

--

-- Note that the ability to catch an exception does /not/ guarantee that we can

-- deal with all possible exit points from a computation. Some monads, such as

-- continuation-based stacks, allow for more than just a success/failure

-- strategy, and therefore @catch@ /cannot/ be used by those monads to properly

-- implement a function such as @finally@. For more information, see

-- 'MonadMask'.

class MonadThrow m => MonadCatch m where
  -- | Provide a handler for exceptions thrown during execution of the first

  -- action. Note that type of the type of the argument to the handler will

  -- constrain which exceptions are caught. See "Control.Exception"'s

  -- 'ControlException.catch'.

  catch :: HAS_CALL_STACK => Exception e => m a -> (e -> m a) -> m a

-- | A class for monads which provide for the ability to account for

-- all possible exit points from a computation, and to mask

-- asynchronous exceptions. Continuation-based monads are invalid

-- instances of this class.

--

-- Instances should ensure that, in the following code:

--

-- > fg = f `finally` g

--

-- The action @g@ is called regardless of what occurs within @f@, including

-- async exceptions. Some monads allow @f@ to abort the computation via other

-- effects than throwing an exception. For simplicity, we will consider aborting

-- and throwing an exception to be two forms of "throwing an error".

--

-- If @f@ and @g@ both throw an error, the error thrown by @fg@ depends on which

-- errors we're talking about. In a monad transformer stack, the deeper layers

-- override the effects of the inner layers; for example, @ExceptT e1 (Except

-- e2) a@ represents a value of type @Either e2 (Either e1 a)@, so throwing both

-- an @e1@ and an @e2@ will result in @Left e2@. If @f@ and @g@ both throw an

-- error from the same layer, instances should ensure that the error from @g@

-- wins.

--

-- Effects other than throwing an error are also overridden by the deeper layers.

-- For example, @StateT s Maybe a@ represents a value of type @s -> Maybe (a,

-- s)@, so if an error thrown from @f@ causes this function to return @Nothing@,

-- any changes to the state which @f@ also performed will be erased. As a

-- result, @g@ will see the state as it was before @f@. Once @g@ completes,

-- @f@'s error will be rethrown, so @g@' state changes will be erased as well.

-- This is the normal interaction between effects in a monad transformer stack.

--

-- By contrast, <https://hackage.haskell.org/package/lifted-base lifted-base>'s

-- version of 'finally' always discards all of @g@'s non-IO effects, and @g@

-- never sees any of @f@'s non-IO effects, regardless of the layer ordering and

-- regardless of whether @f@ throws an error. This is not the result of

-- interacting effects, but a consequence of @MonadBaseControl@'s approach.

class MonadCatch m => MonadMask m where
  -- | Runs an action with asynchronous exceptions disabled. The action is

  -- provided a method for restoring the async. environment to what it was

  -- at the 'mask' call. See "Control.Exception"'s 'ControlException.mask'.

  mask :: HAS_CALL_STACK => ((forall a. m a -> m a) -> m b) -> m b

  -- | Like 'mask', but the masked computation is not interruptible (see

  -- "Control.Exception"'s 'ControlException.uninterruptibleMask'. WARNING:

  -- Only use if you need to mask exceptions around an interruptible operation

  -- AND you can guarantee the interruptible operation will only block for a

  -- short period of time. Otherwise you render the program/thread unresponsive

  -- and/or unkillable.

  uninterruptibleMask :: HAS_CALL_STACK => ((forall a. m a -> m a) -> m b) -> m b

  -- | A generalized version of 'bracket' which uses 'ExitCase' to distinguish

  -- the different exit cases, and returns the values of both the 'use' and

  -- 'release' actions. In practice, this extra information is rarely needed,

  -- so it is often more convenient to use one of the simpler functions which

  -- are defined in terms of this one, such as 'bracket', 'finally', 'onError',

  -- and 'bracketOnError'.

  --

  -- This function exists because in order to thread their effects through the

  -- execution of 'bracket', monad transformers need values to be threaded from

  -- 'use' to 'release' and from 'release' to the output value.

  --

  -- /NOTE/ This method was added in version 0.9.0 of this

  -- library. Previously, implementation of functions like 'bracket'

  -- and 'finally' in this module were based on the 'mask' and

  -- 'uninterruptibleMask' functions only, disallowing some classes of

  -- tranformers from having @MonadMask@ instances (notably

  -- multi-exit-point transformers like 'ExceptT'). If you are a

  -- library author, you'll now need to provide an implementation for

  -- this method. The @StateT@ implementation demonstrates most of the

  -- subtleties:

  --

  -- @

  -- generalBracket acquire release use = StateT $ \s0 -> do

  --   ((b, _s2), (c, s3)) <- generalBracket

  --     (runStateT acquire s0)

  --     (\(resource, s1) exitCase -> case exitCase of

  --       ExitCaseSuccess (b, s2) -> runStateT (release resource (ExitCaseSuccess b)) s2

  --

  --       -- In the two other cases, the base monad overrides @use@'s state

  --       -- changes and the state reverts to @s1@.

  --       ExitCaseException e     -> runStateT (release resource (ExitCaseException e)) s1

  --       ExitCaseAbort           -> runStateT (release resource ExitCaseAbort) s1

  --     )

  --     (\(resource, s1) -> runStateT (use resource) s1)

  --   return ((b, c), s3)

  -- @

  --

  -- The @StateT s m@ implementation of @generalBracket@ delegates to the @m@

  -- implementation of @generalBracket@. The @acquire@, @use@, and @release@

  -- arguments given to @StateT@'s implementation produce actions of type

  -- @StateT s m a@, @StateT s m b@, and @StateT s m c@. In order to run those

  -- actions in the base monad, we need to call @runStateT@, from which we

  -- obtain actions of type @m (a, s)@, @m (b, s)@, and @m (c, s)@. Since each

  -- action produces the next state, it is important to feed the state produced

  -- by the previous action to the next action.

  --

  -- In the 'ExitCaseSuccess' case, the state starts at @s0@, flows through

  -- @acquire@ to become @s1@, flows through @use@ to become @s2@, and finally

  -- flows through @release@ to become @s3@. In the other two cases, @release@

  -- does not receive the value @s2@, so its action cannot see the state changes

  -- performed by @use@. This is fine, because in those two cases, an error was

  -- thrown in the base monad, so as per the usual interaction between effects

  -- in a monad transformer stack, those state changes get reverted. So we start

  -- from @s1@ instead.

  --

  -- Finally, the @m@ implementation of @generalBracket@ returns the pairs

  -- @(b, s)@ and @(c, s)@. For monad transformers other than @StateT@, this

  -- will be some other type representing the effects and values performed and

  -- returned by the @use@ and @release@ actions. The effect part of the @use@

  -- result, in this case @_s2@, usually needs to be discarded, since those

  -- effects have already been incorporated in the @release@ action.

  --

  -- The only effect which is intentionally not incorporated in the @release@

  -- action is the effect of throwing an error. In that case, the error must be

  -- re-thrown. One subtlety which is easy to miss is that in the case in which

  -- @use@ and @release@ both throw an error, the error from @release@ should

  -- take priority. Here is an implementation for @ExceptT@ which demonstrates

  -- how to do this.

  --

  -- @

  -- generalBracket acquire release use = ExceptT $ do

  --   (eb, ec) <- generalBracket

  --     (runExceptT acquire)

  --     (\eresource exitCase -> case eresource of

  --       Left e -> return (Left e) -- nothing to release, acquire didn't succeed

  --       Right resource -> case exitCase of

  --         ExitCaseSuccess (Right b) -> runExceptT (release resource (ExitCaseSuccess b))

  --         ExitCaseException e       -> runExceptT (release resource (ExitCaseException e))

  --         _                         -> runExceptT (release resource ExitCaseAbort))

  --     (either (return . Left) (runExceptT . 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)

  -- @

  --

  -- @since 0.9.0

  generalBracket
    :: HAS_CALL_STACK
    => m a
    -- ^ acquire some resource

    -> (a -> ExitCase b -> m c)
    -- ^ release the resource, observing the outcome of the inner action

    -> (a -> m b)
    -- ^ inner action to perform with the resource

    -> m (b, c)

-- | A 'MonadMask' computation may either succeed with a value, abort with an

-- exception, or abort for some other reason. For example, in @ExceptT e IO@

-- you can use 'throwM' to abort with an exception ('ExitCaseException') or

-- 'Control.Monad.Trans.Except.throwE' to abort with a value of type 'e'

-- ('ExitCaseAbort').

data ExitCase a
  = ExitCaseSuccess a
  | ExitCaseException SomeException
  | ExitCaseAbort
  deriving Int -> ExitCase a -> ShowS
forall a. Show a => Int -> ExitCase a -> ShowS
forall a. Show a => [ExitCase a] -> ShowS
forall a. Show a => ExitCase a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExitCase a] -> ShowS
$cshowList :: forall a. Show a => [ExitCase a] -> ShowS
show :: ExitCase a -> String
$cshow :: forall a. Show a => ExitCase a -> String
showsPrec :: Int -> ExitCase a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ExitCase a -> ShowS
Show

instance MonadThrow [] where
  throwM :: forall e a. (HasCallStack, Exception e) => e -> [a]
throwM e
_ = []
instance MonadThrow Maybe where
  throwM :: forall e a. (HasCallStack, Exception e) => e -> Maybe a
throwM e
_ = forall a. Maybe a
Nothing
instance MonadThrow Q where
  throwM :: forall e a. (HasCallStack, Exception e) => e -> Q a
throwM = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

instance MonadThrow IO where
  throwM :: forall e a. (HasCallStack, Exception e) => e -> IO a
throwM = forall e a. Exception e => e -> IO a
ControlException.throwIO
instance MonadCatch IO where
  catch :: forall e a.
(HasCallStack, Exception e) =>
IO a -> (e -> IO a) -> IO a
catch = forall e a. Exception e => IO a -> (e -> IO a) -> IO a
ControlException.catch
instance MonadMask IO where
  mask :: forall b.
HasCallStack =>
((forall a. IO a -> IO a) -> IO b) -> IO b
mask = forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
ControlException.mask
  uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. IO a -> IO a) -> IO b) -> IO b
uninterruptibleMask = forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
ControlException.uninterruptibleMask
  generalBracket :: forall a b c.
HasCallStack =>
IO a -> (a -> ExitCase b -> IO c) -> (a -> IO b) -> IO (b, c)
generalBracket IO a
acquire a -> ExitCase b -> IO c
release a -> IO b
use = forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
unmasked -> do
    a
resource <- IO a
acquire
    b
b <- forall a. IO a -> IO a
unmasked (a -> IO b
use a
resource) forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \SomeException
e -> do
      c
_ <- a -> ExitCase b -> IO c
release a
resource (forall a. SomeException -> ExitCase a
ExitCaseException SomeException
e)
      forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM SomeException
e
    c
c <- a -> ExitCase b -> IO c
release a
resource (forall a. a -> ExitCase a
ExitCaseSuccess b
b)
    forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, c
c)

instance MonadThrow (ST s) where
  throwM :: forall e a. (HasCallStack, Exception e) => e -> ST s a
throwM = forall a s. IO a -> ST s a
unsafeIOToST forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
ControlException.throwIO

instance MonadThrow STM where
  throwM :: forall e a. (HasCallStack, Exception e) => e -> STM a
throwM = forall e a. Exception e => e -> STM a
STM.throwSTM
instance MonadCatch STM where
  catch :: forall e a.
(HasCallStack, Exception e) =>
STM a -> (e -> STM a) -> STM a
catch = forall e a. Exception e => STM a -> (e -> STM a) -> STM a
STM.catchSTM

instance e ~ SomeException => MonadThrow (Either e) where
  throwM :: forall e a. (HasCallStack, Exception e) => e -> Either e a
throwM = forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> SomeException
toException
-- | @since 0.8.3

instance e ~ SomeException => MonadCatch (Either e) where
  catch :: forall e a.
(HasCallStack, Exception e) =>
Either e a -> (e -> Either e a) -> Either e a
catch (Left e
e) e -> Either e a
f =
    case forall e. Exception e => SomeException -> Maybe e
fromException e
e of
      Maybe e
Nothing -> forall a b. a -> Either a b
Left e
e
      Just e
e' -> e -> Either e a
f e
e'
  catch x :: Either e a
x@(Right a
_) e -> Either e a
_ = Either e a
x
-- | @since 0.8.3

instance e ~ SomeException => MonadMask (Either e) where
  mask :: forall b.
HasCallStack =>
((forall a. Either e a -> Either e a) -> Either e b) -> Either e b
mask (forall a. Either e a -> Either e a) -> Either e b
f = (forall a. Either e a -> Either e a) -> Either e b
f forall a. a -> a
id
  uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. Either e a -> Either e a) -> Either e b) -> Either e b
uninterruptibleMask (forall a. Either e a -> Either e a) -> Either e b
f = (forall a. Either e a -> Either e a) -> Either e b
f forall a. a -> a
id

  generalBracket :: forall a b c.
HasCallStack =>
Either e a
-> (a -> ExitCase b -> Either e c)
-> (a -> Either e b)
-> Either e (b, c)
generalBracket Either e a
acquire a -> ExitCase b -> Either e c
release a -> Either e b
use =
    case Either e a
acquire of
      Left e
e -> forall a b. a -> Either a b
Left e
e
      Right a
resource ->
        case a -> Either e b
use a
resource of
          Left e
e -> a -> ExitCase b -> Either e c
release a
resource (forall a. SomeException -> ExitCase a
ExitCaseException e
e) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a b. a -> Either a b
Left e
e
          Right b
b -> do
            c
c <- a -> ExitCase b -> Either e c
release a
resource (forall a. a -> ExitCase a
ExitCaseSuccess b
b)
            forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, c
c)

instance MonadThrow m => MonadThrow (IdentityT m) where
  throwM :: forall e a. (HasCallStack, Exception e) => e -> IdentityT m a
throwM e
e = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM e
e
instance MonadCatch m => MonadCatch (IdentityT m) where
  catch :: forall e a.
(HasCallStack, Exception e) =>
IdentityT m a -> (e -> IdentityT m a) -> IdentityT m a
catch (IdentityT m a
m) e -> IdentityT m a
f = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch m a
m (forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> IdentityT m a
f))
instance MonadMask m => MonadMask (IdentityT m) where
  mask :: forall b.
HasCallStack =>
((forall a. IdentityT m a -> IdentityT m a) -> IdentityT m b)
-> IdentityT m b
mask (forall a. IdentityT m a -> IdentityT m a) -> IdentityT m b
a = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT ((forall a. IdentityT m a -> IdentityT m a) -> IdentityT m b
a forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(m a -> m a) -> IdentityT m a -> IdentityT m a
q forall a. m a -> m a
u)
    where q :: (m a -> m a) -> IdentityT m a -> IdentityT m a
          q :: forall (m :: * -> *) a.
(m a -> m a) -> IdentityT m a -> IdentityT m a
q m a -> m a
u = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> m a
u forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT
  uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. IdentityT m a -> IdentityT m a) -> IdentityT m b)
-> IdentityT m b
uninterruptibleMask (forall a. IdentityT m a -> IdentityT m a) -> IdentityT m b
a =
    forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT ((forall a. IdentityT m a -> IdentityT m a) -> IdentityT m b
a forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(m a -> m a) -> IdentityT m a -> IdentityT m a
q forall a. m a -> m a
u)
      where q :: (m a -> m a) -> IdentityT m a -> IdentityT m a
            q :: forall (m :: * -> *) a.
(m a -> m a) -> IdentityT m a -> IdentityT m a
q m a -> m a
u = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> m a
u forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT

  generalBracket :: forall a b c.
HasCallStack =>
IdentityT m a
-> (a -> ExitCase b -> IdentityT m c)
-> (a -> IdentityT m b)
-> IdentityT m (b, c)
generalBracket IdentityT m a
acquire a -> ExitCase b -> IdentityT m c
release a -> IdentityT m b
use = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
      (forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT IdentityT m a
acquire)
      (\a
resource ExitCase b
exitCase -> forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT (a -> ExitCase b -> IdentityT m c
release a
resource ExitCase b
exitCase))
      (\a
resource -> forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT (a -> IdentityT m b
use a
resource))

instance MonadThrow m => MonadThrow (LazyS.StateT s m) where
  throwM :: forall e a. (HasCallStack, Exception e) => e -> StateT s m a
throwM e
e = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM e
e
instance MonadCatch m => MonadCatch (LazyS.StateT s m) where
  catch :: forall e a.
(HasCallStack, Exception e) =>
StateT s m a -> (e -> StateT s m a) -> StateT s m a
catch = forall e (m :: * -> *) a s.
Catch e m (a, s) -> Catch e (StateT s m) a
LazyS.liftCatch forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch
instance MonadMask m => MonadMask (LazyS.StateT s m) where
  mask :: forall b.
HasCallStack =>
((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
a = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
LazyS.StateT forall a b. (a -> b) -> a -> b
$ \s
s -> forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
LazyS.runStateT ((forall a. StateT s m a -> StateT s m a) -> StateT s m b
a forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a s.
(m (a, s) -> m (a, s)) -> StateT s m a -> StateT s m a
q forall a. m a -> m a
u) s
s
    where q :: (m (a, s) -> m (a, s)) -> LazyS.StateT s m a -> LazyS.StateT s m a
          q :: forall (m :: * -> *) a s.
(m (a, s) -> m (a, s)) -> StateT s m a -> StateT s m a
q m (a, s) -> m (a, s)
u (LazyS.StateT s -> m (a, s)
b) = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
LazyS.StateT (m (a, s) -> m (a, s)
u forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m (a, s)
b)
  uninterruptibleMask :: forall b.
HasCallStack =>
((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
a =
    forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
LazyS.StateT forall a b. (a -> b) -> a -> b
$ \s
s -> forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
LazyS.runStateT ((forall a. StateT s m a -> StateT s m a) -> StateT s m b
a forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a s.
(m (a, s) -> m (a, s)) -> StateT s m a -> StateT s m a
q forall a. m a -> m a
u) s
s
      where q :: (m (a, s) -> m (a, s)) -> LazyS.StateT s m a -> LazyS.StateT s m a
            q :: forall (m :: * -> *) a s.
(m (a, s) -> m (a, s)) -> StateT s m a -> StateT s m a
q m (a, s) -> m (a, s)
u (LazyS.StateT s -> m (a, s)
b) = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
LazyS.StateT (m (a, s) -> m (a, s)
u forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m (a, s)
b)

  generalBracket :: forall a b c.
HasCallStack =>
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 = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
LazyS.StateT forall a b. (a -> b) -> a -> b
$ \s
s0 -> do
    -- This implementation is given as an example in the documentation of

    -- 'generalBracket', so when changing it, remember to update the

    -- documentation's copy as well

    ((b
b, s
_s2), (c
c, s
s3)) <- forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
      (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
LazyS.runStateT StateT s m a
acquire s
s0)
      (\(a
resource, s
s1) ExitCase (b, s)
exitCase -> case ExitCase (b, s)
exitCase of
        ExitCaseSuccess (b
b, s
s2) -> forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
LazyS.runStateT (a -> ExitCase b -> StateT s m c
release a
resource (forall a. a -> ExitCase a
ExitCaseSuccess b
b)) s
s2
        -- In the two other cases, the base monad overrides @use@'s state

        -- changes and the state reverts to @s1@.

        ExitCaseException SomeException
e     -> forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
LazyS.runStateT (a -> ExitCase b -> StateT s m c
release a
resource (forall a. SomeException -> ExitCase a
ExitCaseException SomeException
e)) s
s1
        ExitCase (b, s)
ExitCaseAbort           -> forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
LazyS.runStateT (a -> ExitCase b -> StateT s m c
release a
resource forall a. ExitCase a
ExitCaseAbort) s
s1)
      (\(a
resource, s
s1) -> forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
LazyS.runStateT (a -> StateT s m b
use a
resource) s
s1)
    forall (m :: * -> *) a. Monad m => a -> m a
return ((b
b, c
c), s
s3)

instance MonadThrow m => MonadThrow (StrictS.StateT s m) where
  throwM :: forall e a. (HasCallStack, Exception e) => e -> StateT s m a
throwM e
e = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM e
e
instance MonadCatch m => MonadCatch (StrictS.StateT s m) where
  catch :: forall e a.
(HasCallStack, Exception e) =>
StateT s m a -> (e -> StateT s m a) -> StateT s m a
catch = forall e (m :: * -> *) a s.
Catch e m (a, s) -> Catch e (StateT s m) a
StrictS.liftCatch forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch
instance MonadMask m => MonadMask (StrictS.StateT s m) where
  mask :: forall b.
HasCallStack =>
((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
a = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StrictS.StateT forall a b. (a -> b) -> a -> b
$ \s
s -> forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
StrictS.runStateT ((forall a. StateT s m a -> StateT s m a) -> StateT s m b
a forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a s.
(m (a, s) -> m (a, s)) -> StateT s m a -> StateT s m a
q forall a. m a -> m a
u) s
s
    where q :: (m (a, s) -> m (a, s)) -> StrictS.StateT s m a -> StrictS.StateT s m a
          q :: forall (m :: * -> *) a s.
(m (a, s) -> m (a, s)) -> StateT s m a -> StateT s m a
q m (a, s) -> m (a, s)
u (StrictS.StateT s -> m (a, s)
b) = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StrictS.StateT (m (a, s) -> m (a, s)
u forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m (a, s)
b)
  uninterruptibleMask :: forall b.
HasCallStack =>
((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
a =
    forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StrictS.StateT forall a b. (a -> b) -> a -> b
$ \s
s -> forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
StrictS.runStateT ((forall a. StateT s m a -> StateT s m a) -> StateT s m b
a forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a s.
(m (a, s) -> m (a, s)) -> StateT s m a -> StateT s m a
q forall a. m a -> m a
u) s
s
      where q :: (m (a, s) -> m (a, s)) -> StrictS.StateT s m a -> StrictS.StateT s m a
            q :: forall (m :: * -> *) a s.
(m (a, s) -> m (a, s)) -> StateT s m a -> StateT s m a
q m (a, s) -> m (a, s)
u (StrictS.StateT s -> m (a, s)
b) = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StrictS.StateT (m (a, s) -> m (a, s)
u forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m (a, s)
b)

  generalBracket :: forall a b c.
HasCallStack =>
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 = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StrictS.StateT forall a b. (a -> b) -> a -> b
$ \s
s0 -> do
    ((b
b, s
_s2), (c
c, s
s3)) <- forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
      (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
StrictS.runStateT StateT s m a
acquire s
s0)
      (\(a
resource, s
s1) ExitCase (b, s)
exitCase -> case ExitCase (b, s)
exitCase of
        ExitCaseSuccess (b
b, s
s2) -> forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
StrictS.runStateT (a -> ExitCase b -> StateT s m c
release a
resource (forall a. a -> ExitCase a
ExitCaseSuccess b
b)) s
s2
        -- In the two other cases, the base monad overrides @use@'s state

        -- changes and the state reverts to @s1@.

        ExitCaseException SomeException
e     -> forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
StrictS.runStateT (a -> ExitCase b -> StateT s m c
release a
resource (forall a. SomeException -> ExitCase a
ExitCaseException SomeException
e)) s
s1
        ExitCase (b, s)
ExitCaseAbort           -> forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
StrictS.runStateT (a -> ExitCase b -> StateT s m c
release a
resource forall a. ExitCase a
ExitCaseAbort) s
s1)
      (\(a
resource, s
s1) -> forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
StrictS.runStateT (a -> StateT s m b
use a
resource) s
s1)
    forall (m :: * -> *) a. Monad m => a -> m a
return ((b
b, c
c), s
s3)

instance MonadThrow m => MonadThrow (ReaderT r m) where
  throwM :: forall e a. (HasCallStack, Exception e) => e -> ReaderT r m a
throwM e
e = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM e
e
instance MonadCatch m => MonadCatch (ReaderT r m) where
  catch :: forall e a.
(HasCallStack, Exception e) =>
ReaderT r m a -> (e -> ReaderT r m a) -> ReaderT r m a
catch (ReaderT r -> m a
m) e -> ReaderT r m a
c = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
r -> r -> m a
m r
r forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e
e -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (e -> ReaderT r m a
c e
e) r
r
instance MonadMask m => MonadMask (ReaderT r m) where
  mask :: forall b.
HasCallStack =>
((forall a. ReaderT r m a -> ReaderT r m a) -> ReaderT r m b)
-> ReaderT r m b
mask (forall a. ReaderT r m a -> ReaderT r m a) -> ReaderT r m b
a = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
e -> forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> 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
a forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a e.
(m a -> m a) -> ReaderT e m a -> ReaderT e m a
q forall a. m a -> m a
u) r
e
    where q :: (m a -> m a) -> ReaderT e m a -> ReaderT e m a
          q :: forall (m :: * -> *) a e.
(m a -> m a) -> ReaderT e m a -> ReaderT e m a
q m a -> m a
u (ReaderT e -> m a
b) = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (m a -> m a
u forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
b)
  uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. ReaderT r m a -> ReaderT r m a) -> ReaderT r m b)
-> ReaderT r m b
uninterruptibleMask (forall a. ReaderT r m a -> ReaderT r m a) -> ReaderT r m b
a =
    forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
e -> forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> 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
a forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a e.
(m a -> m a) -> ReaderT e m a -> ReaderT e m a
q forall a. m a -> m a
u) r
e
      where q :: (m a -> m a) -> ReaderT e m a -> ReaderT e m a
            q :: forall (m :: * -> *) a e.
(m a -> m a) -> ReaderT e m a -> ReaderT e m a
q m a -> m a
u (ReaderT e -> m a
b) = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (m a -> m a
u forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
b)

  generalBracket :: forall a b c.
HasCallStack =>
ReaderT r m a
-> (a -> ExitCase b -> ReaderT r m c)
-> (a -> ReaderT r m b)
-> ReaderT r m (b, c)
generalBracket ReaderT r m a
acquire a -> ExitCase b -> ReaderT r m c
release a -> ReaderT r m b
use = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
r ->
    forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
      (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
acquire r
r)
      (\a
resource ExitCase b
exitCase -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (a -> ExitCase b -> ReaderT r m c
release a
resource ExitCase b
exitCase) r
r)
      (\a
resource -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (a -> ReaderT r m b
use a
resource) r
r)

instance (MonadThrow m, Monoid w) => MonadThrow (StrictW.WriterT w m) where
  throwM :: forall e a. (HasCallStack, Exception e) => e -> WriterT w m a
throwM e
e = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM e
e
instance (MonadCatch m, Monoid w) => MonadCatch (StrictW.WriterT w m) where
  catch :: forall e a.
(HasCallStack, Exception e) =>
WriterT w m a -> (e -> WriterT w m a) -> WriterT w m a
catch (StrictW.WriterT m (a, w)
m) e -> WriterT w m a
h = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
StrictW.WriterT forall a b. (a -> b) -> a -> b
$ m (a, w)
m `catch ` \e
e -> forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
StrictW.runWriterT (e -> WriterT w m a
h e
e)
instance (MonadMask m, Monoid w) => MonadMask (StrictW.WriterT w m) where
  mask :: forall b.
HasCallStack =>
((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
a = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
StrictW.WriterT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
StrictW.runWriterT ((forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b
a forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a w.
(m (a, w) -> m (a, w)) -> WriterT w m a -> WriterT w m a
q forall a. m a -> m a
u)
    where q :: (m (a, w) -> m (a, w)) -> StrictW.WriterT w m a -> StrictW.WriterT w m a
          q :: forall (m :: * -> *) a w.
(m (a, w) -> m (a, w)) -> WriterT w m a -> WriterT w m a
q m (a, w) -> m (a, w)
u WriterT w m a
b = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
StrictW.WriterT forall a b. (a -> b) -> a -> b
$ m (a, w) -> m (a, w)
u (forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
StrictW.runWriterT WriterT w m a
b)
  uninterruptibleMask :: forall b.
HasCallStack =>
((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
a =
    forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
StrictW.WriterT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
StrictW.runWriterT ((forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b
a forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a w.
(m (a, w) -> m (a, w)) -> WriterT w m a -> WriterT w m a
q forall a. m a -> m a
u)
      where q :: (m (a, w) -> m (a, w)) -> StrictW.WriterT w m a -> StrictW.WriterT w m a
            q :: forall (m :: * -> *) a w.
(m (a, w) -> m (a, w)) -> WriterT w m a -> WriterT w m a
q m (a, w) -> m (a, w)
u WriterT w m a
b = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
StrictW.WriterT forall a b. (a -> b) -> a -> b
$ m (a, w) -> m (a, w)
u (forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
StrictW.runWriterT WriterT w m a
b)

  generalBracket :: forall a b c.
HasCallStack =>
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 = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
StrictW.WriterT forall a b. (a -> b) -> a -> b
$ do
    ((b
b, w
_w12), (c
c, w
w123)) <- forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
      (forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
StrictW.runWriterT WriterT w m a
acquire)
      (\(a
resource, w
w1) ExitCase (b, w)
exitCase -> case ExitCase (b, w)
exitCase of
        ExitCaseSuccess (b
b, w
w12) -> do
          (c
c, w
w3) <- forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
StrictW.runWriterT (a -> ExitCase b -> WriterT w m c
release a
resource (forall a. a -> ExitCase a
ExitCaseSuccess b
b))
          forall (m :: * -> *) a. Monad m => a -> m a
return (c
c, forall a. Monoid a => a -> a -> a
mappend w
w12 w
w3)
        -- In the two other cases, the base monad overrides @use@'s state

        -- changes and the state reverts to @w1@.

        ExitCaseException SomeException
e -> do
          (c
c, w
w3) <- forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
StrictW.runWriterT (a -> ExitCase b -> WriterT w m c
release a
resource (forall a. SomeException -> ExitCase a
ExitCaseException SomeException
e))
          forall (m :: * -> *) a. Monad m => a -> m a
return (c
c, forall a. Monoid a => a -> a -> a
mappend w
w1 w
w3)
        ExitCase (b, w)
ExitCaseAbort -> do
          (c
c, w
w3) <- forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
StrictW.runWriterT (a -> ExitCase b -> WriterT w m c
release a
resource forall a. ExitCase a
ExitCaseAbort)
          forall (m :: * -> *) a. Monad m => a -> m a
return (c
c, forall a. Monoid a => a -> a -> a
mappend w
w1 w
w3))
      (\(a
resource, w
w1) -> do
        (b
a, w
w2) <- forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
StrictW.runWriterT (a -> WriterT w m b
use a
resource)
        forall (m :: * -> *) a. Monad m => a -> m a
return (b
a, forall a. Monoid a => a -> a -> a
mappend w
w1 w
w2))
    forall (m :: * -> *) a. Monad m => a -> m a
return ((b
b, c
c), w
w123)

instance (MonadThrow m, Monoid w) => MonadThrow (LazyW.WriterT w m) where
  throwM :: forall e a. (HasCallStack, Exception e) => e -> WriterT w m a
throwM e
e = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM e
e
instance (MonadCatch m, Monoid w) => MonadCatch (LazyW.WriterT w m) where
  catch :: forall e a.
(HasCallStack, Exception e) =>
WriterT w m a -> (e -> WriterT w m a) -> WriterT w m a
catch (LazyW.WriterT m (a, w)
m) e -> WriterT w m a
h = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
LazyW.WriterT forall a b. (a -> b) -> a -> b
$ m (a, w)
m `catch ` \e
e -> forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
LazyW.runWriterT (e -> WriterT w m a
h e
e)
instance (MonadMask m, Monoid w) => MonadMask (LazyW.WriterT w m) where
  mask :: forall b.
HasCallStack =>
((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
a = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
LazyW.WriterT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
LazyW.runWriterT ((forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b
a forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a w.
(m (a, w) -> m (a, w)) -> WriterT w m a -> WriterT w m a
q forall a. m a -> m a
u)
    where q :: (m (a, w) -> m (a, w)) -> LazyW.WriterT w m a -> LazyW.WriterT w m a
          q :: forall (m :: * -> *) a w.
(m (a, w) -> m (a, w)) -> WriterT w m a -> WriterT w m a
q m (a, w) -> m (a, w)
u WriterT w m a
b = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
LazyW.WriterT forall a b. (a -> b) -> a -> b
$ m (a, w) -> m (a, w)
u (forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
LazyW.runWriterT WriterT w m a
b)
  uninterruptibleMask :: forall b.
HasCallStack =>
((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
a =
    forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
LazyW.WriterT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
LazyW.runWriterT ((forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b
a forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a w.
(m (a, w) -> m (a, w)) -> WriterT w m a -> WriterT w m a
q forall a. m a -> m a
u)
      where q :: (m (a, w) -> m (a, w)) -> LazyW.WriterT w m a -> LazyW.WriterT w m a
            q :: forall (m :: * -> *) a w.
(m (a, w) -> m (a, w)) -> WriterT w m a -> WriterT w m a
q m (a, w) -> m (a, w)
u WriterT w m a
b = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
LazyW.WriterT forall a b. (a -> b) -> a -> b
$ m (a, w) -> m (a, w)
u (forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
LazyW.runWriterT WriterT w m a
b)

  generalBracket :: forall a b c.
HasCallStack =>
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 = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
LazyW.WriterT forall a b. (a -> b) -> a -> b
$ do
    ((b
b, w
_w12), (c
c, w
w123)) <- forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
      (forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
LazyW.runWriterT WriterT w m a
acquire)
      (\(a
resource, w
w1) ExitCase (b, w)
exitCase -> case ExitCase (b, w)
exitCase of
        ExitCaseSuccess (b
b, w
w12) -> do
          (c
c, w
w3) <- forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
LazyW.runWriterT (a -> ExitCase b -> WriterT w m c
release a
resource (forall a. a -> ExitCase a
ExitCaseSuccess b
b))
          forall (m :: * -> *) a. Monad m => a -> m a
return (c
c, forall a. Monoid a => a -> a -> a
mappend w
w12 w
w3)
        -- In the two other cases, the base monad overrides @use@'s state

        -- changes and the state reverts to @w1@.

        ExitCaseException SomeException
e -> do
          (c
c, w
w3) <- forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
LazyW.runWriterT (a -> ExitCase b -> WriterT w m c
release a
resource (forall a. SomeException -> ExitCase a
ExitCaseException SomeException
e))
          forall (m :: * -> *) a. Monad m => a -> m a
return (c
c, forall a. Monoid a => a -> a -> a
mappend w
w1 w
w3)
        ExitCase (b, w)
ExitCaseAbort -> do
          (c
c, w
w3) <- forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
LazyW.runWriterT (a -> ExitCase b -> WriterT w m c
release a
resource forall a. ExitCase a
ExitCaseAbort)
          forall (m :: * -> *) a. Monad m => a -> m a
return (c
c, forall a. Monoid a => a -> a -> a
mappend w
w1 w
w3))
      (\(a
resource, w
w1) -> do
        (b
a, w
w2) <- forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
LazyW.runWriterT (a -> WriterT w m b
use a
resource)
        forall (m :: * -> *) a. Monad m => a -> m a
return (b
a, forall a. Monoid a => a -> a -> a
mappend w
w1 w
w2))
    forall (m :: * -> *) a. Monad m => a -> m a
return ((b
b, c
c), w
w123)

instance (MonadThrow m, Monoid w) => MonadThrow (LazyRWS.RWST r w s m) where
  throwM :: forall e a. (HasCallStack, Exception e) => e -> RWST r w s m a
throwM e
e = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM e
e
instance (MonadCatch m, Monoid w) => MonadCatch (LazyRWS.RWST r w s m) where
  catch :: forall e a.
(HasCallStack, Exception e) =>
RWST r w s m a -> (e -> RWST r w s m a) -> RWST r w s m a
catch (LazyRWS.RWST r -> s -> m (a, s, w)
m) e -> RWST r w s m a
h = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
LazyRWS.RWST forall a b. (a -> b) -> a -> b
$ \r
r s
s -> r -> s -> m (a, s, w)
m r
r s
s forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e
e -> forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
LazyRWS.runRWST (e -> RWST r w s m a
h e
e) r
r s
s
instance (MonadMask m, Monoid w) => MonadMask (LazyRWS.RWST r w s m) where
  mask :: forall b.
HasCallStack =>
((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
a = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
LazyRWS.RWST forall a b. (a -> b) -> a -> b
$ \r
r s
s -> forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
LazyRWS.runRWST ((forall a. RWST r w s m a -> RWST r w s m a) -> RWST r w s m b
a forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a s w r.
(m (a, s, w) -> m (a, s, w)) -> RWST r w s m a -> RWST r w s m a
q forall a. m a -> m a
u) r
r s
s
    where q :: (m (a, s, w) -> m (a, s, w)) -> LazyRWS.RWST r w s m a -> LazyRWS.RWST r w s m a
          q :: forall (m :: * -> *) a s w r.
(m (a, s, w) -> m (a, s, w)) -> RWST r w s m a -> RWST r w s m a
q m (a, s, w) -> m (a, s, w)
u (LazyRWS.RWST r -> s -> m (a, s, w)
b) = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
LazyRWS.RWST forall a b. (a -> b) -> a -> b
$ \ r
r s
s -> m (a, s, w) -> m (a, s, w)
u (r -> s -> m (a, s, w)
b r
r s
s)
  uninterruptibleMask :: forall b.
HasCallStack =>
((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
a =
    forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
LazyRWS.RWST forall a b. (a -> b) -> a -> b
$ \r
r s
s -> forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
LazyRWS.runRWST ((forall a. RWST r w s m a -> RWST r w s m a) -> RWST r w s m b
a forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a s w r.
(m (a, s, w) -> m (a, s, w)) -> RWST r w s m a -> RWST r w s m a
q forall a. m a -> m a
u) r
r s
s
      where q :: (m (a, s, w) -> m (a, s, w)) -> LazyRWS.RWST r w s m a -> LazyRWS.RWST r w s m a
            q :: forall (m :: * -> *) a s w r.
(m (a, s, w) -> m (a, s, w)) -> RWST r w s m a -> RWST r w s m a
q m (a, s, w) -> m (a, s, w)
u (LazyRWS.RWST r -> s -> m (a, s, w)
b) = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
LazyRWS.RWST forall a b. (a -> b) -> a -> b
$ \ r
r s
s -> m (a, s, w) -> m (a, s, w)
u (r -> s -> m (a, s, w)
b r
r s
s)

  generalBracket :: forall a b c.
HasCallStack =>
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 = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
LazyRWS.RWST forall a b. (a -> b) -> a -> b
$ \r
r s
s0 -> do
    ((b
b, s
_s2, w
_w12), (c
c, s
s3, w
w123)) <- forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
      (forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
LazyRWS.runRWST RWST r w s m a
acquire r
r s
s0)
      (\(a
resource, s
s1, w
w1) ExitCase (b, s, w)
exitCase -> case ExitCase (b, s, w)
exitCase of
        ExitCaseSuccess (b
b, s
s2, w
w12) -> do
          (c
c, s
s3, w
w3) <- forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
LazyRWS.runRWST (a -> ExitCase b -> RWST r w s m c
release a
resource (forall a. a -> ExitCase a
ExitCaseSuccess b
b)) r
r s
s2
          forall (m :: * -> *) a. Monad m => a -> m a
return (c
c, s
s3, forall a. Monoid a => a -> a -> a
mappend w
w12 w
w3)
        -- In the two other cases, the base monad overrides @use@'s state

        -- changes and the state reverts to @s1@ and @w1@.

        ExitCaseException SomeException
e -> do
          (c
c, s
s3, w
w3) <- forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
LazyRWS.runRWST (a -> ExitCase b -> RWST r w s m c
release a
resource (forall a. SomeException -> ExitCase a
ExitCaseException SomeException
e)) r
r s
s1
          forall (m :: * -> *) a. Monad m => a -> m a
return (c
c, s
s3, forall a. Monoid a => a -> a -> a
mappend w
w1 w
w3)
        ExitCase (b, s, w)
ExitCaseAbort -> do
          (c
c, s
s3, w
w3) <- forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
LazyRWS.runRWST (a -> ExitCase b -> RWST r w s m c
release a
resource forall a. ExitCase a
ExitCaseAbort) r
r s
s1
          forall (m :: * -> *) a. Monad m => a -> m a
return (c
c, s
s3, forall a. Monoid a => a -> a -> a
mappend w
w1 w
w3))
      (\(a
resource, s
s1, w
w1) -> do
        (b
a, s
s2, w
w2) <- forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
LazyRWS.runRWST (a -> RWST r w s m b
use a
resource) r
r s
s1
        forall (m :: * -> *) a. Monad m => a -> m a
return (b
a, s
s2, forall a. Monoid a => a -> a -> a
mappend w
w1 w
w2))
    forall (m :: * -> *) a. Monad m => a -> m a
return ((b
b, c
c), s
s3, w
w123)

instance (MonadThrow m, Monoid w) => MonadThrow (StrictRWS.RWST r w s m) where
  throwM :: forall e a. (HasCallStack, Exception e) => e -> RWST r w s m a
throwM e
e = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM e
e
instance (MonadCatch m, Monoid w) => MonadCatch (StrictRWS.RWST r w s m) where
  catch :: forall e a.
(HasCallStack, Exception e) =>
RWST r w s m a -> (e -> RWST r w s m a) -> RWST r w s m a
catch (StrictRWS.RWST r -> s -> m (a, s, w)
m) e -> RWST r w s m a
h = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
StrictRWS.RWST forall a b. (a -> b) -> a -> b
$ \r
r s
s -> r -> s -> m (a, s, w)
m r
r s
s forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e
e -> forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
StrictRWS.runRWST (e -> RWST r w s m a
h e
e) r
r s
s
instance (MonadMask m, Monoid w) => MonadMask (StrictRWS.RWST r w s m) where
  mask :: forall b.
HasCallStack =>
((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
a = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
StrictRWS.RWST forall a b. (a -> b) -> a -> b
$ \r
r s
s -> forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
StrictRWS.runRWST ((forall a. RWST r w s m a -> RWST r w s m a) -> RWST r w s m b
a forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a s w r.
(m (a, s, w) -> m (a, s, w)) -> RWST r w s m a -> RWST r w s m a
q forall a. m a -> m a
u) r
r s
s
    where q :: (m (a, s, w) -> m (a, s, w)) -> StrictRWS.RWST r w s m a -> StrictRWS.RWST r w s m a
          q :: forall (m :: * -> *) a s w r.
(m (a, s, w) -> m (a, s, w)) -> RWST r w s m a -> RWST r w s m a
q m (a, s, w) -> m (a, s, w)
u (StrictRWS.RWST r -> s -> m (a, s, w)
b) = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
StrictRWS.RWST forall a b. (a -> b) -> a -> b
$ \ r
r s
s -> m (a, s, w) -> m (a, s, w)
u (r -> s -> m (a, s, w)
b r
r s
s)
  uninterruptibleMask :: forall b.
HasCallStack =>
((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
a =
    forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
StrictRWS.RWST forall a b. (a -> b) -> a -> b
$ \r
r s
s -> forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
StrictRWS.runRWST ((forall a. RWST r w s m a -> RWST r w s m a) -> RWST r w s m b
a forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a s w r.
(m (a, s, w) -> m (a, s, w)) -> RWST r w s m a -> RWST r w s m a
q forall a. m a -> m a
u) r
r s
s
      where q :: (m (a, s, w) -> m (a, s, w)) -> StrictRWS.RWST r w s m a -> StrictRWS.RWST r w s m a
            q :: forall (m :: * -> *) a s w r.
(m (a, s, w) -> m (a, s, w)) -> RWST r w s m a -> RWST r w s m a
q m (a, s, w) -> m (a, s, w)
u (StrictRWS.RWST r -> s -> m (a, s, w)
b) = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
StrictRWS.RWST forall a b. (a -> b) -> a -> b
$ \ r
r s
s -> m (a, s, w) -> m (a, s, w)
u (r -> s -> m (a, s, w)
b r
r s
s)

  generalBracket :: forall a b c.
HasCallStack =>
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 = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
StrictRWS.RWST forall a b. (a -> b) -> a -> b
$ \r
r s
s0 -> do
    ((b
b, s
_s2, w
_w12), (c
c, s
s3, w
w123)) <- forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
      (forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
StrictRWS.runRWST RWST r w s m a
acquire r
r s
s0)
      (\(a
resource, s
s1, w
w1) ExitCase (b, s, w)
exitCase -> case ExitCase (b, s, w)
exitCase of
        ExitCaseSuccess (b
b, s
s2, w
w12) -> do
          (c
c, s
s3, w
w3) <- forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
StrictRWS.runRWST (a -> ExitCase b -> RWST r w s m c
release a
resource (forall a. a -> ExitCase a
ExitCaseSuccess b
b)) r
r s
s2
          forall (m :: * -> *) a. Monad m => a -> m a
return (c
c, s
s3, forall a. Monoid a => a -> a -> a
mappend w
w12 w
w3)
        -- In the two other cases, the base monad overrides @use@'s state

        -- changes and the state reverts to @s1@ and @w1@.

        ExitCaseException SomeException
e -> do
          (c
c, s
s3, w
w3) <- forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
StrictRWS.runRWST (a -> ExitCase b -> RWST r w s m c
release a
resource (forall a. SomeException -> ExitCase a
ExitCaseException SomeException
e)) r
r s
s1
          forall (m :: * -> *) a. Monad m => a -> m a
return (c
c, s
s3, forall a. Monoid a => a -> a -> a
mappend w
w1 w
w3)
        ExitCase (b, s, w)
ExitCaseAbort -> do
          (c
c, s
s3, w
w3) <- forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
StrictRWS.runRWST (a -> ExitCase b -> RWST r w s m c
release a
resource forall a. ExitCase a
ExitCaseAbort) r
r s
s1
          forall (m :: * -> *) a. Monad m => a -> m a
return (c
c, s
s3, forall a. Monoid a => a -> a -> a
mappend w
w1 w
w3))
      (\(a
resource, s
s1, w
w1) -> do
        (b
a, s
s2, w
w2) <- forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
StrictRWS.runRWST (a -> RWST r w s m b
use a
resource) r
r s
s1
        forall (m :: * -> *) a. Monad m => a -> m a
return (b
a, s
s2, forall a. Monoid a => a -> a -> a
mappend w
w1 w
w2))
    forall (m :: * -> *) a. Monad m => a -> m a
return ((b
b, c
c), s
s3, w
w123)

-- | Throws exceptions into the base monad.

instance MonadThrow m => MonadThrow (MaybeT m) where
  throwM :: forall e a. (HasCallStack, Exception e) => e -> MaybeT m a
throwM = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM
-- | Catches exceptions from the base monad.

instance MonadCatch m => MonadCatch (MaybeT m) where
  catch :: forall e a.
(HasCallStack, Exception e) =>
MaybeT m a -> (e -> MaybeT m a) -> MaybeT m a
catch (MaybeT m (Maybe a)
m) e -> MaybeT m a
f = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch m (Maybe a)
m (forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> MaybeT m a
f)
-- | @since 0.10.0

instance MonadMask m => MonadMask (MaybeT m) where
  mask :: forall b.
HasCallStack =>
((forall a. MaybeT m a -> MaybeT m a) -> MaybeT m b) -> MaybeT m b
mask (forall a. MaybeT m a -> MaybeT m a) -> MaybeT m b
f = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ (forall a. MaybeT m a -> MaybeT m a) -> MaybeT m b
f (forall (m :: * -> *) a.
(m (Maybe a) -> m (Maybe a)) -> MaybeT m a -> MaybeT m a
q forall a. m a -> m a
u)
    where
      q :: (m (Maybe a) -> m (Maybe a))
        -> MaybeT m a -> MaybeT m a
      q :: forall (m :: * -> *) a.
(m (Maybe a) -> m (Maybe a)) -> MaybeT m a -> MaybeT m a
q m (Maybe a) -> m (Maybe a)
u (MaybeT m (Maybe a)
b) = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe a) -> m (Maybe a)
u m (Maybe a)
b)
  uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. MaybeT m a -> MaybeT m a) -> MaybeT m b) -> MaybeT m b
uninterruptibleMask (forall a. MaybeT m a -> MaybeT m a) -> MaybeT m b
f = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ (forall a. MaybeT m a -> MaybeT m a) -> MaybeT m b
f (forall (m :: * -> *) a.
(m (Maybe a) -> m (Maybe a)) -> MaybeT m a -> MaybeT m a
q forall a. m a -> m a
u)
    where
      q :: (m (Maybe a) -> m (Maybe a))
        -> MaybeT m a -> MaybeT m a
      q :: forall (m :: * -> *) a.
(m (Maybe a) -> m (Maybe a)) -> MaybeT m a -> MaybeT m a
q m (Maybe a) -> m (Maybe a)
u (MaybeT m (Maybe a)
b) = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe a) -> m (Maybe a)
u m (Maybe a)
b)

  generalBracket :: forall a b c.
HasCallStack =>
MaybeT m a
-> (a -> ExitCase b -> MaybeT m c)
-> (a -> MaybeT m b)
-> MaybeT m (b, c)
generalBracket MaybeT m a
acquire a -> ExitCase b -> MaybeT m c
release a -> MaybeT m b
use = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ do
    (Maybe b
eb, Maybe c
ec) <- forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
      (forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT MaybeT m a
acquire)
      (\Maybe a
resourceMay ExitCase (Maybe b)
exitCase -> case Maybe a
resourceMay of
        Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing -- nothing to release, acquire didn't succeed

        Just a
resource -> case ExitCase (Maybe b)
exitCase of
          ExitCaseSuccess (Just b
b) -> forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (a -> ExitCase b -> MaybeT m c
release a
resource (forall a. a -> ExitCase a
ExitCaseSuccess b
b))
          ExitCaseException SomeException
e      -> forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (a -> ExitCase b -> MaybeT m c
release a
resource (forall a. SomeException -> ExitCase a
ExitCaseException SomeException
e))
          ExitCase (Maybe b)
_                        -> forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (a -> ExitCase b -> MaybeT m c
release a
resource forall a. ExitCase a
ExitCaseAbort))
      (\Maybe a
resourceMay -> case Maybe a
resourceMay of
        Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        Just a
resource -> forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (a -> MaybeT m b
use a
resource))
    -- The order in which we perform those two 'Maybe' effects doesn't matter,

    -- since the error message is the same regardless.

    forall (m :: * -> *) a. Monad m => a -> m a
return ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe b
eb forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe c
ec)

-- | Throws exceptions into the base monad.

instance MonadThrow m => MonadThrow (ExceptT e m) where
  throwM :: forall e a. (HasCallStack, Exception e) => e -> ExceptT e m a
throwM = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM
-- | Catches exceptions from the base monad.

instance MonadCatch m => MonadCatch (ExceptT e m) where
  catch :: forall e a.
(HasCallStack, 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 = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch m (Either e a)
m (forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ExceptT e m a
f)
-- | @since 0.9.0

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

  generalBracket :: forall a b c.
HasCallStack =>
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 = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ do
    -- This implementation is given as an example in the documentation of

    -- 'generalBracket', so when changing it, remember to update the

    -- documentation's copy as well

    (Either e b
eb, Either e c
ec) <- forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
      (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 -> forall (m :: * -> *) a. Monad m => a -> m a
return (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) -> forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (a -> ExitCase b -> ExceptT e m c
release a
resource (forall a. a -> ExitCase a
ExitCaseSuccess b
b))
          ExitCaseException SomeException
e       -> forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (a -> ExitCase b -> ExceptT e m c
release a
resource (forall a. SomeException -> ExitCase a
ExitCaseException SomeException
e))
          ExitCase (Either e b)
_                         -> forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (a -> ExitCase b -> ExceptT e m c
release a
resource forall a. ExitCase a
ExitCaseAbort))
      (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) (forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ExceptT e m b
use))
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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
c <- Either e c
ec
      b
b <- Either e b
eb
      forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, c
c)

instance MonadThrow m => MonadThrow (ContT r m) where
  throwM :: forall e a. (HasCallStack, Exception e) => e -> ContT r m a
throwM = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM
-- I don't believe any valid of MonadCatch exists for ContT.

-- instance MonadCatch m => MonadCatch (ContT r m) where


#if !(MIN_VERSION_transformers(0,6,0))
-- | Throws exceptions into the base monad.

instance (Error e, MonadThrow m) => MonadThrow (ErrorT e m) where
  throwM :: forall e a. (HasCallStack, Exception e) => e -> ErrorT e m a
throwM = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM
-- | Catches exceptions from the base monad.

instance (Error e, MonadCatch m) => MonadCatch (ErrorT e m) where
  catch :: forall e a.
(HasCallStack, Exception e) =>
ErrorT e m a -> (e -> ErrorT e m a) -> ErrorT e m a
catch (ErrorT m (Either e a)
m) e -> ErrorT e m a
f = forall e (m :: * -> *) a. m (Either e a) -> ErrorT e m a
ErrorT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch m (Either e a)
m (forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
runErrorT forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ErrorT e m a
f)
instance (Error e, MonadMask m) => MonadMask (ErrorT e m) where
  mask :: forall b.
HasCallStack =>
((forall a. ErrorT e m a -> ErrorT e m a) -> ErrorT e m b)
-> ErrorT e m b
mask (forall a. ErrorT e m a -> ErrorT e m a) -> ErrorT e m b
f = forall e (m :: * -> *) a. m (Either e a) -> ErrorT e m a
ErrorT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
runErrorT forall a b. (a -> b) -> a -> b
$ (forall a. ErrorT e m a -> ErrorT e m a) -> ErrorT e m b
f (forall (m :: * -> *) e a.
(m (Either e a) -> m (Either e a)) -> ErrorT e m a -> ErrorT e m a
q forall a. m a -> m a
u)
    where
      q :: (m (Either e a) -> m (Either e a))
        -> ErrorT e m a -> ErrorT e m a
      q :: forall (m :: * -> *) e a.
(m (Either e a) -> m (Either e a)) -> ErrorT e m a -> ErrorT e m a
q m (Either e a) -> m (Either e a)
u (ErrorT m (Either e a)
b) = forall e (m :: * -> *) a. m (Either e a) -> ErrorT e m a
ErrorT (m (Either e a) -> m (Either e a)
u m (Either e a)
b)
  uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. ErrorT e m a -> ErrorT e m a) -> ErrorT e m b)
-> ErrorT e m b
uninterruptibleMask (forall a. ErrorT e m a -> ErrorT e m a) -> ErrorT e m b
f = forall e (m :: * -> *) a. m (Either e a) -> ErrorT e m a
ErrorT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
runErrorT forall a b. (a -> b) -> a -> b
$ (forall a. ErrorT e m a -> ErrorT e m a) -> ErrorT e m b
f (forall (m :: * -> *) e a.
(m (Either e a) -> m (Either e a)) -> ErrorT e m a -> ErrorT e m a
q forall a. m a -> m a
u)
    where
      q :: (m (Either e a) -> m (Either e a))
        -> ErrorT e m a -> ErrorT e m a
      q :: forall (m :: * -> *) e a.
(m (Either e a) -> m (Either e a)) -> ErrorT e m a -> ErrorT e m a
q m (Either e a) -> m (Either e a)
u (ErrorT m (Either e a)
b) = forall e (m :: * -> *) a. m (Either e a) -> ErrorT e m a
ErrorT (m (Either e a) -> m (Either e a)
u m (Either e a)
b)

  generalBracket :: forall a b c.
HasCallStack =>
ErrorT e m a
-> (a -> ExitCase b -> ErrorT e m c)
-> (a -> ErrorT e m b)
-> ErrorT e m (b, c)
generalBracket ErrorT e m a
acquire a -> ExitCase b -> ErrorT e m c
release a -> ErrorT e m b
use = forall e (m :: * -> *) a. m (Either e a) -> ErrorT e m a
ErrorT forall a b. (a -> b) -> a -> b
$ do
    (Either e b
eb, Either e c
ec) <- forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
      (forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
runErrorT ErrorT e m a
acquire)
      (\Either e a
eresource ExitCase (Either e b)
exitCase -> case Either e a
eresource of
        Left e
e -> forall (m :: * -> *) a. Monad m => a -> m a
return (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) -> forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
runErrorT (a -> ExitCase b -> ErrorT e m c
release a
resource (forall a. a -> ExitCase a
ExitCaseSuccess b
b))
          ExitCaseException SomeException
e       -> forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
runErrorT (a -> ExitCase b -> ErrorT e m c
release a
resource (forall a. SomeException -> ExitCase a
ExitCaseException SomeException
e))
          ExitCase (Either e b)
_                         -> forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
runErrorT (a -> ExitCase b -> ErrorT e m c
release a
resource forall a. ExitCase a
ExitCaseAbort))
      (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) (forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
runErrorT forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ErrorT e m b
use))
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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
c <- Either e c
ec
      b
b <- Either e b
eb
      forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, c
c)

-- Transformers which are only instances of MonadThrow and MonadCatch, not MonadMask

instance MonadThrow m => MonadThrow (ListT m) where
  throwM :: forall e a. (HasCallStack, Exception e) => e -> ListT m a
throwM = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM
instance MonadCatch m => MonadCatch (ListT m) where
  catch :: forall e a.
(HasCallStack, Exception e) =>
ListT m a -> (e -> ListT m a) -> ListT m a
catch (ListT m [a]
m) e -> ListT m a
f = forall (m :: * -> *) a. m [a] -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch m [a]
m (forall (m :: * -> *) a. ListT m a -> m [a]
runListT forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ListT m a
f)
#endif

------------------------------------------------------------------------------

-- $utilities

-- These functions follow those from "Control.Exception", except that they are

-- based on methods from the 'MonadCatch' typeclass. See

-- "Control.Exception" for API usage.

------------------------------------------------------------------------------


-- | Like 'mask', but does not pass a @restore@ action to the argument.

mask_ :: HAS_CALL_STACK => MonadMask m => m a -> m a
mask_ :: forall (m :: * -> *) a. (HasCallStack, MonadMask m) => m a -> m a
mask_ m a
io = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (\(m Any -> m Any) -> m a
f -> forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
mask (\forall a. m a -> m a
x -> (m Any -> m Any) -> m a
f forall a. m a -> m a
x)) (\m Any -> m Any
_ -> m a
io)

-- | Like 'uninterruptibleMask', but does not pass a @restore@ action to the

-- argument.

uninterruptibleMask_ :: HAS_CALL_STACK => MonadMask m => m a -> m a
uninterruptibleMask_ :: forall (m :: * -> *) a. (HasCallStack, MonadMask m) => m a -> m a
uninterruptibleMask_ m a
io = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack (\(m Any -> m Any) -> m a
f -> forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask (\forall a. m a -> m a
x -> (m Any -> m Any) -> m a
f forall a. m a -> m a
x)) (\m Any -> m Any
_ -> m a
io)

-- | Catches all exceptions, and somewhat defeats the purpose of the extensible

-- exception system. Use sparingly.

--

-- /NOTE/ This catches all /exceptions/, but if the monad supports other ways of

-- aborting the computation, those other kinds of errors will not be caught.

catchAll :: HAS_CALL_STACK => MonadCatch m => m a -> (SomeException -> m a) -> m a
catchAll :: forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
catchAll = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch

-- | Catch all 'IOError' (eqv. 'IOException') exceptions. Still somewhat too

-- general, but better than using 'catchAll'. See 'catchIf' for an easy way

-- of catching specific 'IOError's based on the predicates in "System.IO.Error".

catchIOError :: HAS_CALL_STACK => MonadCatch m => m a -> (IOError -> m a) -> m a
catchIOError :: forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (IOError -> m a) -> m a
catchIOError = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch

-- | Catch exceptions only if they pass some predicate. Often useful with the

-- predicates for testing 'IOError' values in "System.IO.Error".

catchIf :: HAS_CALL_STACK => (MonadCatch m, Exception e) =>
    (e -> Bool) -> m a -> (e -> m a) -> m a
catchIf :: forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
(e -> Bool) -> m a -> (e -> m a) -> m a
catchIf e -> Bool
f m a
a e -> m a
b = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch m a
a (\e
e -> if e -> Bool
f e
e then e -> m a
b e
e else forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM e
e)

-- | A more generalized way of determining which exceptions to catch at

-- run time.

catchJust :: HAS_CALL_STACK => (MonadCatch m, Exception e) =>
    (e -> Maybe b) -> m a -> (b -> m a) -> m a
catchJust :: forall (m :: * -> *) e b a.
(HasCallStack, MonadCatch m, Exception e) =>
(e -> Maybe b) -> m a -> (b -> m a) -> m a
catchJust e -> Maybe b
f m a
a b -> m a
b = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch m a
a (\e
e -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM e
e) b -> m a
b forall a b. (a -> b) -> a -> b
$ e -> Maybe b
f e
e)

-- | Flipped 'catch'. See "Control.Exception"'s 'ControlException.handle'.

handle :: HAS_CALL_STACK => (MonadCatch m, Exception e) => (e -> m a) -> m a -> m a
handle :: forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch)
{-# INLINE handle #-}

-- | Flipped 'catchIOError'

handleIOError :: HAS_CALL_STACK => MonadCatch m => (IOError -> m a) -> m a -> m a
handleIOError :: forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
(IOError -> m a) -> m a -> m a
handleIOError = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle

-- | Flipped 'catchAll'

handleAll :: HAS_CALL_STACK => MonadCatch m => (SomeException -> m a) -> m a -> m a
handleAll :: forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
(SomeException -> m a) -> m a -> m a
handleAll = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle

-- | Flipped 'catchIf'

handleIf :: HAS_CALL_STACK => (MonadCatch m, Exception e) => (e -> Bool) -> (e -> m a) -> m a -> m a
handleIf :: forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
(e -> Bool) -> (e -> m a) -> m a -> m a
handleIf e -> Bool
f = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
(e -> Bool) -> m a -> (e -> m a) -> m a
catchIf e -> Bool
f)

-- | Flipped 'catchJust'. See "Control.Exception"'s 'ControlException.handleJust'.

handleJust :: HAS_CALL_STACK => (MonadCatch m, Exception e) => (e -> Maybe b) -> (b -> m a) -> m a -> m a
handleJust :: forall (m :: * -> *) e b a.
(HasCallStack, MonadCatch m, Exception e) =>
(e -> Maybe b) -> (b -> m a) -> m a -> m a
handleJust e -> Maybe b
f = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall (m :: * -> *) e b a.
(HasCallStack, MonadCatch m, Exception e) =>
(e -> Maybe b) -> m a -> (b -> m a) -> m a
catchJust e -> Maybe b
f)
{-# INLINE handleJust #-}

-- | Similar to 'catch', but returns an 'Either' result. See "Control.Exception"'s

-- 'Control.Exception.try'.

try :: HAS_CALL_STACK => (MonadCatch m, Exception e) => m a -> m (Either e a)
try :: forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try m a
a = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch (forall a b. b -> Either a b
Right forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m a
a) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)

-- | A variant of 'try' that takes an exception predicate to select

-- which exceptions are caught. See "Control.Exception"'s 'ControlException.tryJust'

tryJust :: HAS_CALL_STACK => (MonadCatch m, Exception e) =>
    (e -> Maybe b) -> m a -> m (Either b a)
tryJust :: forall (m :: * -> *) e b a.
(HasCallStack, MonadCatch m, Exception e) =>
(e -> Maybe b) -> m a -> m (Either b a)
tryJust e -> Maybe b
f m a
a = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch (forall a b. b -> Either a b
Right forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m a
a) (\e
e -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM e
e) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) (e -> Maybe b
f e
e))

-- | Generalized version of 'ControlException.Handler'

data Handler m a = forall e . ControlException.Exception e => Handler (e -> m a)

instance Monad m => Functor (Handler m) where
  fmap :: forall a b. (a -> b) -> Handler m a -> Handler m b
fmap a -> b
f (Handler e -> m a
h) = forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
h)

-- | Catches different sorts of exceptions. See "Control.Exception"'s 'ControlException.catches'

catches :: HAS_CALL_STACK => (Foldable f, MonadCatch m) => m a -> f (Handler m a) -> m a
catches :: forall (f :: * -> *) (m :: * -> *) a.
(HasCallStack, Foldable f, MonadCatch m) =>
m a -> f (Handler m a) -> m a
catches m a
a f (Handler m a)
hs = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch m a
a SomeException -> m a
handler
  where
    handler :: SomeException -> m a
handler SomeException
e = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Handler m a -> m a -> m a
probe (forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM SomeException
e) f (Handler m a)
hs
      where
        probe :: Handler m a -> m a -> m a
probe (Handler e -> m a
h) m a
xs = forall b a. b -> (a -> b) -> Maybe a -> b
maybe m a
xs e -> m a
h (forall e. Exception e => SomeException -> Maybe e
ControlException.fromException SomeException
e)

-- | Run an action only if an exception is thrown in the main action. The

-- exception is not caught, simply rethrown.

--

-- /NOTE/ The action is only run if an /exception/ is thrown. If the monad

-- supports other ways of aborting the computation, the action won't run if

-- those other kinds of errors are thrown. See 'onError'.

onException :: HAS_CALL_STACK => MonadCatch m => m a -> m b -> m a
onException :: forall (m :: * -> *) a b.
(HasCallStack, MonadCatch m) =>
m a -> m b -> m a
onException m a
action m b
handler = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
catchAll m a
action (\SomeException
e -> m b
handler forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM SomeException
e)

-- | Run an action only if an error is thrown in the main action. Unlike

-- 'onException', this works with every kind of error, not just exceptions. For

-- example, if @f@ is an 'ExceptT' computation which aborts with a 'Left', the

-- computation @onError f g@ will execute @g@, while @onException f g@ will not.

--

-- This distinction is only meaningful for monads which have multiple exit

-- points, such as 'Except' and 'MaybeT'. For monads that only have a single

-- exit point, there is no difference between 'onException' and 'onError',

-- except that 'onError' has a more constrained type.

--

-- @since 0.10.0

onError :: HAS_CALL_STACK => MonadMask m => m a -> m b -> m a
onError :: forall (m :: * -> *) a b.
(HasCallStack, MonadMask m) =>
m a -> m b -> m a
onError m a
action m b
handler = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracketOnError (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (forall a b. a -> b -> a
const m b
handler) (forall a b. a -> b -> a
const m a
action)

-- | Generalized abstracted pattern of safe resource acquisition and release

-- in the face of errors. The first action \"acquires\" some value, which

-- is \"released\" by the second action at the end. The third action \"uses\"

-- the value and its result is the result of the 'bracket'.

--

-- If an error is thrown during the use, the release still happens before the

-- error is rethrown.

--

-- Note that this is essentially a type-specialized version of

-- 'generalBracket'. This function has a more common signature (matching the

-- signature from "Control.Exception"), and is often more convenient to use. By

-- contrast, 'generalBracket' is more expressive, allowing us to implement

-- other functions like 'bracketOnError'.

bracket :: HAS_CALL_STACK => MonadMask m => m a -> (a -> m c) -> (a -> m b) -> m b
bracket :: forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket m a
acquire a -> m c
release = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
  m a
acquire
  (\a
a ExitCase b
_exitCase -> a -> m c
release a
a)

-- | Version of 'bracket' without any value being passed to the second and

-- third actions.

bracket_ :: HAS_CALL_STACK => MonadMask m => m a -> m c -> m b -> m b
bracket_ :: forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> m c -> m b -> m b
bracket_ m a
before m c
after m b
action = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket m a
before (forall a b. a -> b -> a
const m c
after) (forall a b. a -> b -> a
const m b
action)

-- | Perform an action with a finalizer action that is run, even if an

-- error occurs.

finally :: HAS_CALL_STACK => MonadMask m => m a -> m b -> m a
finally :: forall (m :: * -> *) a b.
(HasCallStack, MonadMask m) =>
m a -> m b -> m a
finally m a
action m b
finalizer = forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> m c -> m b -> m b
bracket_ (forall (m :: * -> *) a. Monad m => a -> m a
return ()) m b
finalizer m a
action

-- | Like 'bracket', but only performs the final action if an error is

-- thrown by the in-between computation.

bracketOnError :: HAS_CALL_STACK => MonadMask m => m a -> (a -> m c) -> (a -> m b) -> m b
bracketOnError :: forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracketOnError m a
acquire a -> m c
release = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
  m a
acquire
  (\a
a ExitCase b
exitCase -> case ExitCase b
exitCase of
    ExitCaseSuccess b
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    ExitCase b
_ -> do
      c
_ <- a -> m c
release a
a
      forall (m :: * -> *) a. Monad m => a -> m a
return ())