{-# LANGUAGE UnicodeSyntax #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}

-- | Guarding monadic computations with cleanup actions.
module Control.Monad.Finally
  ( MonadFinally(..)
  , chainCleanups
  , finallyMany
  , onEscape
  , onEscapeMany
  , bracket_
  , bracketOnEscape
  ) where

#if !MIN_VERSION_base(4,8,0)
import Prelude hiding (mapM, forM)
#endif
import Data.Functor.Identity
import Data.Monoid (Monoid(..))
import Data.Traversable (mapM, forM)
import Control.Applicative (Applicative(..), (<$>), (<$))
import Control.Monad (join)
import Control.Monad.Trans.Maybe
#if !MIN_VERSION_transformers(0,6,0)
import Control.Monad.Trans.Error
#endif
import Control.Monad.Trans.Except
import Control.Monad.Trans.Reader
import qualified Control.Monad.Trans.State.Lazy as L
import qualified Control.Monad.Trans.State.Strict as S
import qualified Control.Monad.Trans.Writer.Lazy as LW
import qualified Control.Monad.Trans.Writer.Strict as SW
import qualified Control.Monad.Trans.RWS.Lazy as L
import qualified Control.Monad.Trans.RWS.Strict as S
import Control.Monad.Trans.Accum
import Control.Monad.Trans.Abort
import Control.Monad.Trans.Finish
import qualified Control.Exception as E

-- | Class of monads that support guarding computations with cleanup actions.
class (Applicative μ, Monad μ) ⇒ MonadFinally μ where
#if __GLASGOW_HASKELL__ >= 707
  {-# MINIMAL finally' | bracket' #-}
#endif
  -- | @'finally'' m f@ runs computation @m@ and then
  --
  -- 1. runs @f ('Just' x)@ if @m@ produced a result @x@. The result of that is
  -- returned alongside with @x@.
  -- 2. runs @f 'Nothing'@ otherwise.
  finally' ∷ μ α → (Maybe α → μ β) → μ (α, β)
  finally' μ α
m Maybe α -> μ β
f = forall (μ :: * -> *) r α β.
MonadFinally μ =>
μ r -> (r -> Maybe α -> μ β) -> (r -> μ α) -> μ (α, β)
bracket' (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (forall a b. a -> b -> a
const Maybe α -> μ β
f) (forall a b. a -> b -> a
const μ α
m)
  -- | A simplified version of 'finally'' in which the cleanup action
  -- does not care about the result of the main computation. The default
  -- implementation is
  --
  -- @
  --     'finally' m = 'fmap' 'fst' . 'finally'' m . 'const'
  -- @
  finally  ∷ μ α → μ β → μ α
  finally μ α
m = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (μ :: * -> *) α β.
MonadFinally μ =>
μ α -> (Maybe α -> μ β) -> μ (α, β)
finally' μ α
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
  -- | Safely acquire a resource and use it in a computation, releasing it
  -- even when the computation does not produce a result.
  bracket' ∷ μ r                 -- ^ Acquire resource
           → (r → Maybe α → μ β) -- ^ Release resource
           → (r → μ α)           -- ^ Main computation
           → μ (α, β)
  bracket' μ r
acquire r -> Maybe α -> μ β
release r -> μ α
m = do
    r
r ← μ r
acquire
    forall (μ :: * -> *) α β.
MonadFinally μ =>
μ α -> (Maybe α -> μ β) -> μ (α, β)
finally' (r -> μ α
m r
r) (r -> Maybe α -> μ β
release r
r)
  -- | A simplified version of 'bracket'' in which the releasing action
  -- does not care about the result of the main computation. The default
  -- implementation is
  --
  -- @
  --     'bracket' acquire release =
  --       'fmap' 'fst' . 'bracket'' acquire ('const' . release)
  -- @
  bracket ∷ μ r → (r → μ β) → (r → μ α) → μ α
  bracket μ r
acquire r -> μ β
release = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (μ :: * -> *) r α β.
MonadFinally μ =>
μ r -> (r -> Maybe α -> μ β) -> (r -> μ α) -> μ (α, β)
bracket' μ r
acquire (forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> μ β
release)

instance MonadFinally Identity where
  finally' :: forall α β.
Identity α -> (Maybe α -> Identity β) -> Identity (α, β)
finally' Identity α
m Maybe α -> Identity β
f = do
    α
mr ← Identity α
m
    forall (m :: * -> *) a. Monad m => a -> m a
return (α
mr, forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ Maybe α -> Identity β
f forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just α
mr)

instance MonadFinally IO where
  finally' :: forall α β. IO α -> (Maybe α -> IO β) -> IO (α, β)
finally' IO α
m Maybe α -> IO β
f = forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
E.mask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore → do
    α
mr ← forall a. IO a -> IO a
restore IO α
m forall α β. IO α -> IO β -> IO α
`E.onException` Maybe α -> IO β
f forall a. Maybe a
Nothing
    β
fr ← Maybe α -> IO β
f forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just α
mr
    forall (m :: * -> *) a. Monad m => a -> m a
return (α
mr, β
fr)
  bracket' :: forall r α β.
IO r -> (r -> Maybe α -> IO β) -> (r -> IO α) -> IO (α, β)
bracket' IO r
acquire r -> Maybe α -> IO β
release r -> IO α
m = forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
E.mask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore → do
    r
ar ← IO r
acquire
    α
mr ← forall a. IO a -> IO a
restore (r -> IO α
m r
ar) forall α β. IO α -> IO β -> IO α
`E.onException` r -> Maybe α -> IO β
release r
ar forall a. Maybe a
Nothing
    β
rr ← r -> Maybe α -> IO β
release r
ar forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just α
mr
    forall (m :: * -> *) a. Monad m => a -> m a
return (α
mr, β
rr)

instance MonadFinally μ ⇒ MonadFinally (MaybeT μ) where
  finally' :: forall α β.
MaybeT μ α -> (Maybe α -> MaybeT μ β) -> MaybeT μ (α, β)
finally' MaybeT μ α
m Maybe α -> MaybeT μ β
f = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ do
    (Maybe α
mr, Maybe β
fr) ← forall (μ :: * -> *) α β.
MonadFinally μ =>
μ α -> (Maybe α -> μ β) -> μ (α, β)
finally' (forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT MaybeT μ α
m) (forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe α -> MaybeT μ β
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => m (m a) -> m a
join)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe α
mr forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe β
fr
  bracket' :: forall r α β.
MaybeT μ r
-> (r -> Maybe α -> MaybeT μ β)
-> (r -> MaybeT μ α)
-> MaybeT μ (α, β)
bracket' MaybeT μ r
acquire r -> Maybe α -> MaybeT μ β
release r -> MaybeT μ α
m = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ do
    (Maybe α
mr, Maybe β
rr) ← forall (μ :: * -> *) r α β.
MonadFinally μ =>
μ r -> (r -> Maybe α -> μ β) -> (r -> μ α) -> μ (α, β)
bracket' (forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT MaybeT μ r
acquire)
                        (\case
                           Just r
ar → forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> Maybe α -> MaybeT μ β
release r
ar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
                           Maybe r
Nothing → forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing))
                        (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> MaybeT μ α
m))
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe α
mr forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe β
rr

justRight ∷ Maybe (Either e α) → Maybe α
justRight :: forall e α. Maybe (Either e α) -> Maybe α
justRight (Just (Right α
a)) = forall a. a -> Maybe a
Just α
a
justRight Maybe (Either e α)
_                = forall a. Maybe a
Nothing

instance MonadFinally μ ⇒ MonadFinally (AbortT e μ) where
  finally' :: forall α β.
AbortT e μ α -> (Maybe α -> AbortT e μ β) -> AbortT e μ (α, β)
finally' AbortT e μ α
m Maybe α -> AbortT e μ β
f = forall e (μ :: * -> *) α. μ (Either e α) -> AbortT e μ α
AbortT forall a b. (a -> b) -> a -> b
$ do
    (Either e α
mr, Either e β
fr) ← forall (μ :: * -> *) α β.
MonadFinally μ =>
μ α -> (Maybe α -> μ β) -> μ (α, β)
finally' (forall e (μ :: * -> *) α. AbortT e μ α -> μ (Either e α)
runAbortT AbortT e μ α
m) (forall e (μ :: * -> *) α. AbortT e μ α -> μ (Either e α)
runAbortT forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe α -> AbortT e μ β
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e α. Maybe (Either e α) -> Maybe α
justRight)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either e α
mr forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either e β
fr
  bracket' :: forall r α β.
AbortT e μ r
-> (r -> Maybe α -> AbortT e μ β)
-> (r -> AbortT e μ α)
-> AbortT e μ (α, β)
bracket' AbortT e μ r
acquire r -> Maybe α -> AbortT e μ β
release r -> AbortT e μ α
m = forall e (μ :: * -> *) α. μ (Either e α) -> AbortT e μ α
AbortT forall a b. (a -> b) -> a -> b
$ do
    (Either e α
mr, Either e β
rr) ← forall (μ :: * -> *) r α β.
MonadFinally μ =>
μ r -> (r -> Maybe α -> μ β) -> (r -> μ α) -> μ (α, β)
bracket' (forall e (μ :: * -> *) α. AbortT e μ α -> μ (Either e α)
runAbortT AbortT e μ r
acquire)
                        (\case
                          Right r
ar → forall e (μ :: * -> *) α. AbortT e μ α -> μ (Either e α)
runAbortT forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> Maybe α -> AbortT e μ β
release r
ar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e α. Maybe (Either e α) -> Maybe α
justRight
                          Left e
e → forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left e
e)))
                        (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall e (μ :: * -> *) α. AbortT e μ α -> μ (Either e α)
runAbortT forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> AbortT e μ α
m))
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either e α
mr forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either e β
rr

instance MonadFinally μ ⇒ MonadFinally (FinishT β μ) where
  finally' :: forall α β.
FinishT β μ α -> (Maybe α -> FinishT β μ β) -> FinishT β μ (α, β)
finally' FinishT β μ α
m Maybe α -> FinishT β μ β
f = forall f (μ :: * -> *) α. μ (Either f α) -> FinishT f μ α
FinishT forall a b. (a -> b) -> a -> b
$ do
    (Either β α
mr, Either β β
fr) ← forall (μ :: * -> *) α β.
MonadFinally μ =>
μ α -> (Maybe α -> μ β) -> μ (α, β)
finally' (forall f (μ :: * -> *) α. FinishT f μ α -> μ (Either f α)
runFinishT FinishT β μ α
m) (forall f (μ :: * -> *) α. FinishT f μ α -> μ (Either f α)
runFinishT forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe α -> FinishT β μ β
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e α. Maybe (Either e α) -> Maybe α
justRight)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either β α
mr forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either β β
fr
  bracket' :: forall r α β.
FinishT β μ r
-> (r -> Maybe α -> FinishT β μ β)
-> (r -> FinishT β μ α)
-> FinishT β μ (α, β)
bracket' FinishT β μ r
acquire r -> Maybe α -> FinishT β μ β
release r -> FinishT β μ α
m = forall f (μ :: * -> *) α. μ (Either f α) -> FinishT f μ α
FinishT forall a b. (a -> b) -> a -> b
$ do
    (Either β α
mr, Either β β
rr) ← forall (μ :: * -> *) r α β.
MonadFinally μ =>
μ r -> (r -> Maybe α -> μ β) -> (r -> μ α) -> μ (α, β)
bracket' (forall f (μ :: * -> *) α. FinishT f μ α -> μ (Either f α)
runFinishT FinishT β μ r
acquire)
                        (\case
                          Right r
ar → forall f (μ :: * -> *) α. FinishT f μ α -> μ (Either f α)
runFinishT forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> Maybe α -> FinishT β μ β
release r
ar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e α. Maybe (Either e α) -> Maybe α
justRight
                          Left β
e → forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left β
e)))
                        (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall f (μ :: * -> *) α. FinishT f μ α -> μ (Either f α)
runFinishT forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> FinishT β μ α
m))
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either β α
mr forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either β β
rr

#if !MIN_VERSION_transformers(0,6,0)
instance (MonadFinally μ, Error e) ⇒ MonadFinally (ErrorT e μ) where
  finally' :: forall α β.
ErrorT e μ α -> (Maybe α -> ErrorT e μ β) -> ErrorT e μ (α, β)
finally' ErrorT e μ α
m Maybe α -> ErrorT e μ β
f = forall e (m :: * -> *) a. m (Either e a) -> ErrorT e m a
ErrorT forall a b. (a -> b) -> a -> b
$ do
    (Either e α
mr, Either e β
fr) ← forall (μ :: * -> *) α β.
MonadFinally μ =>
μ α -> (Maybe α -> μ β) -> μ (α, β)
finally' (forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
runErrorT ErrorT e μ α
m) (forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
runErrorT forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe α -> ErrorT e μ β
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e α. Maybe (Either e α) -> Maybe α
justRight)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either e α
mr forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either e β
fr
  bracket' :: forall r α β.
ErrorT e μ r
-> (r -> Maybe α -> ErrorT e μ β)
-> (r -> ErrorT e μ α)
-> ErrorT e μ (α, β)
bracket' ErrorT e μ r
acquire r -> Maybe α -> ErrorT e μ β
release r -> ErrorT e μ α
m = forall e (m :: * -> *) a. m (Either e a) -> ErrorT e m a
ErrorT forall a b. (a -> b) -> a -> b
$ do
    (Either e α
mr, Either e β
rr) ← forall (μ :: * -> *) r α β.
MonadFinally μ =>
μ r -> (r -> Maybe α -> μ β) -> (r -> μ α) -> μ (α, β)
bracket' (forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
runErrorT ErrorT e μ r
acquire)
                        (\case
                          Right r
ar → forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
runErrorT forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> Maybe α -> ErrorT e μ β
release r
ar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e α. Maybe (Either e α) -> Maybe α
justRight
                          Left e
e → forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left e
e)))
                        (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
runErrorT forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> ErrorT e μ α
m))
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either e α
mr forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either e β
rr
#endif

instance MonadFinally μ ⇒ MonadFinally (ExceptT e μ) where
  finally' :: forall α β.
ExceptT e μ α -> (Maybe α -> ExceptT e μ β) -> ExceptT e μ (α, β)
finally' ExceptT e μ α
m Maybe α -> ExceptT e μ β
f = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ do
    (Either e α
mr, Either e β
fr) ← forall (μ :: * -> *) α β.
MonadFinally μ =>
μ α -> (Maybe α -> μ β) -> μ (α, β)
finally' (forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e μ α
m) (forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe α -> ExceptT e μ β
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e α. Maybe (Either e α) -> Maybe α
justRight)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either e α
mr forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either e β
fr
  bracket' :: forall r α β.
ExceptT e μ r
-> (r -> Maybe α -> ExceptT e μ β)
-> (r -> ExceptT e μ α)
-> ExceptT e μ (α, β)
bracket' ExceptT e μ r
acquire r -> Maybe α -> ExceptT e μ β
release r -> ExceptT e μ α
m = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ do
    (Either e α
mr, Either e β
rr) ← forall (μ :: * -> *) r α β.
MonadFinally μ =>
μ r -> (r -> Maybe α -> μ β) -> (r -> μ α) -> μ (α, β)
bracket' (forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e μ r
acquire)
                        (\case
                          Right r
ar → forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> Maybe α -> ExceptT e μ β
release r
ar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e α. Maybe (Either e α) -> Maybe α
justRight
                          Left e
e → forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left e
e)))
                        (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> ExceptT e μ α
m))
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either e α
mr forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either e β
rr

instance MonadFinally μ ⇒ MonadFinally (ReaderT r μ) where
  finally' :: forall α β.
ReaderT r μ α -> (Maybe α -> ReaderT r μ β) -> ReaderT r μ (α, β)
finally' ReaderT r μ α
m Maybe α -> ReaderT r μ β
f = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
r →
    forall (μ :: * -> *) α β.
MonadFinally μ =>
μ α -> (Maybe α -> μ β) -> μ (α, β)
finally' (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r μ α
m r
r) ((forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` r
r) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe α -> ReaderT r μ β
f)
  bracket' :: forall r α β.
ReaderT r μ r
-> (r -> Maybe α -> ReaderT r μ β)
-> (r -> ReaderT r μ α)
-> ReaderT r μ (α, β)
bracket' ReaderT r μ r
acquire r -> Maybe α -> ReaderT r μ β
release r -> ReaderT r μ α
m = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
r →
    forall (μ :: * -> *) r α β.
MonadFinally μ =>
μ r -> (r -> Maybe α -> μ β) -> (r -> μ α) -> μ (α, β)
bracket' (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r μ r
acquire r
r)
             (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` r
r) forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> Maybe α -> ReaderT r μ β
release)
             ((forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` r
r) forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> ReaderT r μ α
m)

instance MonadFinally μ ⇒ MonadFinally (L.StateT s μ) where
  finally' :: forall α β.
StateT s μ α -> (Maybe α -> StateT s μ β) -> StateT s μ (α, β)
finally' StateT s μ α
m Maybe α -> StateT s μ β
f = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
L.StateT forall a b. (a -> b) -> a -> b
$ \s
s → do
    ~(~(α
mr, s
_), ~(β
fr, s
s'')) ← forall (μ :: * -> *) α β.
MonadFinally μ =>
μ α -> (Maybe α -> μ β) -> μ (α, β)
finally' (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
L.runStateT StateT s μ α
m s
s) forall a b. (a -> b) -> a -> b
$ \case
      Just ~(α
a, s
s') → forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
L.runStateT (Maybe α -> StateT s μ β
f forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just α
a) s
s'
      Maybe (α, s)
Nothing       → forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
L.runStateT (Maybe α -> StateT s μ β
f forall a. Maybe a
Nothing) s
s
    forall (m :: * -> *) a. Monad m => a -> m a
return ((α
mr, β
fr), s
s'')
  bracket' :: forall r α β.
StateT s μ r
-> (r -> Maybe α -> StateT s μ β)
-> (r -> StateT s μ α)
-> StateT s μ (α, β)
bracket' StateT s μ r
acquire r -> Maybe α -> StateT s μ β
release r -> StateT s μ α
m = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
L.StateT forall a b. (a -> b) -> a -> b
$ \s
s → do
    ~(~(α
mr, s
_), ~(β
fr, s
s'')) ←
      forall (μ :: * -> *) r α β.
MonadFinally μ =>
μ r -> (r -> Maybe α -> μ β) -> (r -> μ α) -> μ (α, β)
bracket' (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
L.runStateT StateT s μ r
acquire s
s)
               (\ ~(r
ar, s
s') → \case
                  Just ~(α
mr, s
s'') → forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
L.runStateT (r -> Maybe α -> StateT s μ β
release r
ar (forall a. a -> Maybe a
Just α
mr)) s
s''
                  Maybe (α, s)
Nothing         → forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
L.runStateT (r -> Maybe α -> StateT s μ β
release r
ar forall a. Maybe a
Nothing) s
s')
               (\ ~(r
ar, s
s') → forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
L.runStateT (r -> StateT s μ α
m r
ar) s
s')
    forall (m :: * -> *) a. Monad m => a -> m a
return ((α
mr, β
fr), s
s'')

instance MonadFinally μ ⇒ MonadFinally (S.StateT s μ) where
  finally' :: forall α β.
StateT s μ α -> (Maybe α -> StateT s μ β) -> StateT s μ (α, β)
finally' StateT s μ α
m Maybe α -> StateT s μ β
f = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
S.StateT forall a b. (a -> b) -> a -> b
$ \s
s → do
    ((α
mr, s
_), (β
fr, s
s''')) ← forall (μ :: * -> *) α β.
MonadFinally μ =>
μ α -> (Maybe α -> μ β) -> μ (α, β)
finally' (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
S.runStateT StateT s μ α
m s
s) forall a b. (a -> b) -> a -> b
$ \case
      Just (α
a, s
s') → forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
S.runStateT (Maybe α -> StateT s μ β
f forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just α
a) s
s'
      Maybe (α, s)
Nothing      → forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
S.runStateT (Maybe α -> StateT s μ β
f forall a. Maybe a
Nothing) s
s
    forall (m :: * -> *) a. Monad m => a -> m a
return ((α
mr, β
fr), s
s''')
  bracket' :: forall r α β.
StateT s μ r
-> (r -> Maybe α -> StateT s μ β)
-> (r -> StateT s μ α)
-> StateT s μ (α, β)
bracket' StateT s μ r
acquire r -> Maybe α -> StateT s μ β
release r -> StateT s μ α
m = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
S.StateT forall a b. (a -> b) -> a -> b
$ \s
s → do
    ((α
mr, s
_), (β
fr, s
s''')) ←
      forall (μ :: * -> *) r α β.
MonadFinally μ =>
μ r -> (r -> Maybe α -> μ β) -> (r -> μ α) -> μ (α, β)
bracket' (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
S.runStateT StateT s μ r
acquire s
s)
               (\(r
ar, s
s') → \case
                  Just ~(α
mr, s
s'') → forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
S.runStateT (r -> Maybe α -> StateT s μ β
release r
ar (forall a. a -> Maybe a
Just α
mr)) s
s''
                  Maybe (α, s)
Nothing         → forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
S.runStateT (r -> Maybe α -> StateT s μ β
release r
ar forall a. Maybe a
Nothing) s
s')
               (\(r
ar, s
s') → forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
S.runStateT (r -> StateT s μ α
m r
ar) s
s')
    forall (m :: * -> *) a. Monad m => a -> m a
return ((α
mr, β
fr), s
s''')

instance (MonadFinally μ, Monoid w) ⇒ MonadFinally (LW.WriterT w μ) where
  finally' :: forall α β.
WriterT w μ α -> (Maybe α -> WriterT w μ β) -> WriterT w μ (α, β)
finally' WriterT w μ α
m Maybe α -> WriterT w μ β
f = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
LW.WriterT forall a b. (a -> b) -> a -> b
$ do
    ~(~(α
mr, w
w), ~(β
fr, w
w')) ← forall (μ :: * -> *) α β.
MonadFinally μ =>
μ α -> (Maybe α -> μ β) -> μ (α, β)
finally' (forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
LW.runWriterT WriterT w μ α
m) forall a b. (a -> b) -> a -> b
$
      forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
LW.runWriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe α -> WriterT w μ β
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst
    forall (m :: * -> *) a. Monad m => a -> m a
return ((α
mr, β
fr), w
w forall a. Monoid a => a -> a -> a
`mappend` w
w')
  bracket' :: forall r α β.
WriterT w μ r
-> (r -> Maybe α -> WriterT w μ β)
-> (r -> WriterT w μ α)
-> WriterT w μ (α, β)
bracket' WriterT w μ r
acquire r -> Maybe α -> WriterT w μ β
release r -> WriterT w μ α
m = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
LW.WriterT forall a b. (a -> b) -> a -> b
$ do
    ~(~(α
mr, w
w), ~(β
fr, w
w')) ←
      forall (μ :: * -> *) r α β.
MonadFinally μ =>
μ r -> (r -> Maybe α -> μ β) -> (r -> μ α) -> μ (α, β)
bracket' (forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
LW.runWriterT WriterT w μ r
acquire)
               (\ ~(r
ar, w
_) → \case
                  Just ~(α
mr, w
_) → forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
LW.runWriterT (r -> Maybe α -> WriterT w μ β
release r
ar (forall a. a -> Maybe a
Just α
mr))
                  Maybe (α, w)
Nothing → forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
LW.runWriterT (r -> Maybe α -> WriterT w μ β
release r
ar forall a. Maybe a
Nothing))
               (\ ~(r
ar, w
aw) → forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
LW.runWriterT (forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
LW.tell w
aw forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> r -> WriterT w μ α
m r
ar))
    forall (m :: * -> *) a. Monad m => a -> m a
return ((α
mr, β
fr), w
w forall a. Monoid a => a -> a -> a
`mappend` w
w')

instance (MonadFinally μ, Monoid w) ⇒ MonadFinally (SW.WriterT w μ) where
  finally' :: forall α β.
WriterT w μ α -> (Maybe α -> WriterT w μ β) -> WriterT w μ (α, β)
finally' WriterT w μ α
m Maybe α -> WriterT w μ β
f = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
SW.WriterT forall a b. (a -> b) -> a -> b
$ do
    ((α
mr, w
w), (β
fr, w
w')) ← forall (μ :: * -> *) α β.
MonadFinally μ =>
μ α -> (Maybe α -> μ β) -> μ (α, β)
finally' (forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
SW.runWriterT WriterT w μ α
m) forall a b. (a -> b) -> a -> b
$ \Maybe (α, w)
mbr → case Maybe (α, w)
mbr of
      Just (α
a, w
_) → forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
SW.runWriterT forall a b. (a -> b) -> a -> b
$ Maybe α -> WriterT w μ β
f forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just α
a
      Maybe (α, w)
Nothing     → forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
SW.runWriterT forall a b. (a -> b) -> a -> b
$ Maybe α -> WriterT w μ β
f forall a. Maybe a
Nothing
    forall (m :: * -> *) a. Monad m => a -> m a
return ((α
mr, β
fr), w
w forall a. Monoid a => a -> a -> a
`mappend` w
w')
  bracket' :: forall r α β.
WriterT w μ r
-> (r -> Maybe α -> WriterT w μ β)
-> (r -> WriterT w μ α)
-> WriterT w μ (α, β)
bracket' WriterT w μ r
acquire r -> Maybe α -> WriterT w μ β
release r -> WriterT w μ α
m = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
SW.WriterT forall a b. (a -> b) -> a -> b
$ do
    ((α
mr, w
w), (β
fr, w
w')) ←
      forall (μ :: * -> *) r α β.
MonadFinally μ =>
μ r -> (r -> Maybe α -> μ β) -> (r -> μ α) -> μ (α, β)
bracket' (forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
SW.runWriterT WriterT w μ r
acquire)
               (\(r
ar, w
_) → \case
                  Just (α
mr, w
_) → forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
SW.runWriterT (r -> Maybe α -> WriterT w μ β
release r
ar (forall a. a -> Maybe a
Just α
mr))
                  Maybe (α, w)
Nothing → forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
SW.runWriterT (r -> Maybe α -> WriterT w μ β
release r
ar forall a. Maybe a
Nothing))
               (\(r
ar, w
aw) → forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
SW.runWriterT (forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
SW.tell w
aw forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> r -> WriterT w μ α
m r
ar))
    forall (m :: * -> *) a. Monad m => a -> m a
return ((α
mr, β
fr), w
w forall a. Monoid a => a -> a -> a
`mappend` w
w')

instance (MonadFinally μ, Monoid w) ⇒ MonadFinally (L.RWST r w s μ) where
  finally' :: forall α β.
RWST r w s μ α
-> (Maybe α -> RWST r w s μ β) -> RWST r w s μ (α, β)
finally' RWST r w s μ α
m Maybe α -> RWST r w s μ β
f = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
L.RWST forall a b. (a -> b) -> a -> b
$ \r
r s
s → do
    ~(~(α
mr, s
_, w
w), ~(β
fr, s
s'', w
w')) ← forall (μ :: * -> *) α β.
MonadFinally μ =>
μ α -> (Maybe α -> μ β) -> μ (α, β)
finally' (forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
L.runRWST RWST r w s μ α
m r
r s
s) forall a b. (a -> b) -> a -> b
$ \case
      Just ~(α
mr, s
s', w
_) → forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
L.runRWST (Maybe α -> RWST r w s μ β
f forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just α
mr) r
r s
s'
      Maybe (α, s, w)
Nothing → forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
L.runRWST (Maybe α -> RWST r w s μ β
f forall a. Maybe a
Nothing) r
r s
s
    forall (m :: * -> *) a. Monad m => a -> m a
return ((α
mr, β
fr), s
s'', w
w forall a. Monoid a => a -> a -> a
`mappend` w
w')
  bracket' :: forall r α β.
RWST r w s μ r
-> (r -> Maybe α -> RWST r w s μ β)
-> (r -> RWST r w s μ α)
-> RWST r w s μ (α, β)
bracket' RWST r w s μ r
acquire r -> Maybe α -> RWST r w s μ β
release r -> RWST r w s μ α
m = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
L.RWST forall a b. (a -> b) -> a -> b
$ \r
r s
s → do
    ~(~(α
mr, s
_, w
w), ~(β
fr, s
s''', w
w')) ←
      forall (μ :: * -> *) r α β.
MonadFinally μ =>
μ r -> (r -> Maybe α -> μ β) -> (r -> μ α) -> μ (α, β)
bracket' (forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
L.runRWST RWST r w s μ r
acquire r
r s
s)
               (\ ~(r
ar, s
s', w
_) → \case 
                  Just ~(α
mr, s
s'', w
_) → forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
L.runRWST (r -> Maybe α -> RWST r w s μ β
release r
ar forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just α
mr) r
r s
s''
                  Maybe (α, s, w)
Nothing → forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
L.runRWST (r -> Maybe α -> RWST r w s μ β
release r
ar forall a. Maybe a
Nothing) r
r s
s')
               (\ ~(r
ar, s
s', w
aw) → forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
L.runRWST (forall (m :: * -> *) w r s. Monad m => w -> RWST r w s m ()
L.tell w
aw forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> r -> RWST r w s μ α
m r
ar) r
r s
s')
    forall (m :: * -> *) a. Monad m => a -> m a
return ((α
mr, β
fr), s
s''', w
w forall a. Monoid a => a -> a -> a
`mappend` w
w')

instance (MonadFinally μ, Monoid w) ⇒ MonadFinally (S.RWST r w s μ) where
  finally' :: forall α β.
RWST r w s μ α
-> (Maybe α -> RWST r w s μ β) -> RWST r w s μ (α, β)
finally' RWST r w s μ α
m Maybe α -> RWST r w s μ β
f = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
S.RWST forall a b. (a -> b) -> a -> b
$ \r
r s
s → do
    ((α
mr, s
_, w
w), (β
fr, s
s'', w
w')) ← forall (μ :: * -> *) α β.
MonadFinally μ =>
μ α -> (Maybe α -> μ β) -> μ (α, β)
finally' (forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
S.runRWST RWST r w s μ α
m r
r s
s) forall a b. (a -> b) -> a -> b
$ \case
      Just (α
a, s
s', w
_) → forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
S.runRWST (Maybe α -> RWST r w s μ β
f forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just α
a) r
r s
s'
      Maybe (α, s, w)
Nothing         → forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
S.runRWST (Maybe α -> RWST r w s μ β
f forall a. Maybe a
Nothing) r
r s
s
    forall (m :: * -> *) a. Monad m => a -> m a
return ((α
mr, β
fr), s
s'', w
w forall a. Monoid a => a -> a -> a
`mappend` w
w')
  bracket' :: forall r α β.
RWST r w s μ r
-> (r -> Maybe α -> RWST r w s μ β)
-> (r -> RWST r w s μ α)
-> RWST r w s μ (α, β)
bracket' RWST r w s μ r
acquire r -> Maybe α -> RWST r w s μ β
release r -> RWST r w s μ α
m = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
S.RWST forall a b. (a -> b) -> a -> b
$ \r
r s
s → do
    ((α
mr, s
_, w
w), (β
fr, s
s''', w
w')) ←
      forall (μ :: * -> *) r α β.
MonadFinally μ =>
μ r -> (r -> Maybe α -> μ β) -> (r -> μ α) -> μ (α, β)
bracket' (forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
S.runRWST RWST r w s μ r
acquire r
r s
s)
               (\(r
ar, s
s', w
_) → \case 
                  Just (α
mr, s
s'', w
_) → forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
S.runRWST (r -> Maybe α -> RWST r w s μ β
release r
ar forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just α
mr) r
r s
s''
                  Maybe (α, s, w)
Nothing → forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
S.runRWST (r -> Maybe α -> RWST r w s μ β
release r
ar forall a. Maybe a
Nothing) r
r s
s')
               (\(r
ar, s
s', w
aw) → forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
S.runRWST (forall (m :: * -> *) w r s. Monad m => w -> RWST r w s m ()
S.tell w
aw forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> r -> RWST r w s μ α
m r
ar) r
r s
s')
    forall (m :: * -> *) a. Monad m => a -> m a
return ((α
mr, β
fr), s
s''', w
w forall a. Monoid a => a -> a -> a
`mappend` w
w')

instance (MonadFinally μ, Monoid w) ⇒ MonadFinally (AccumT w μ) where
  finally' :: forall α β.
AccumT w μ α -> (Maybe α -> AccumT w μ β) -> AccumT w μ (α, β)
finally' AccumT w μ α
m Maybe α -> AccumT w μ β
f = forall w (m :: * -> *) a. (w -> m (a, w)) -> AccumT w m a
AccumT forall a b. (a -> b) -> a -> b
$ \w
w → do
    ~(~(α
mr, w
_), ~(β
fr, w
w'')) ← forall (μ :: * -> *) α β.
MonadFinally μ =>
μ α -> (Maybe α -> μ β) -> μ (α, β)
finally' (forall w (m :: * -> *) a. AccumT w m a -> w -> m (a, w)
runAccumT AccumT w μ α
m w
w) forall a b. (a -> b) -> a -> b
$ \case
      Just ~(α
a, w
w') → forall w (m :: * -> *) a. AccumT w m a -> w -> m (a, w)
runAccumT (Maybe α -> AccumT w μ β
f forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just α
a) w
w'
      Maybe (α, w)
Nothing       → forall w (m :: * -> *) a. AccumT w m a -> w -> m (a, w)
runAccumT (Maybe α -> AccumT w μ β
f forall a. Maybe a
Nothing) w
w
    forall (m :: * -> *) a. Monad m => a -> m a
return ((α
mr, β
fr), w
w'')
  bracket' :: forall r α β.
AccumT w μ r
-> (r -> Maybe α -> AccumT w μ β)
-> (r -> AccumT w μ α)
-> AccumT w μ (α, β)
bracket' AccumT w μ r
acquire r -> Maybe α -> AccumT w μ β
release r -> AccumT w μ α
m = forall w (m :: * -> *) a. (w -> m (a, w)) -> AccumT w m a
AccumT forall a b. (a -> b) -> a -> b
$ \w
w → do
    ~(~(α
mr, w
_), ~(β
fr, w
w''')) ←
      forall (μ :: * -> *) r α β.
MonadFinally μ =>
μ r -> (r -> Maybe α -> μ β) -> (r -> μ α) -> μ (α, β)
bracket' (forall w (m :: * -> *) a. AccumT w m a -> w -> m (a, w)
runAccumT AccumT w μ r
acquire w
w)
               (\ ~(r
ar, w
w') → \case
                  Just ~(α
mr, w
w'') → forall w (m :: * -> *) a. AccumT w m a -> w -> m (a, w)
runAccumT (r -> Maybe α -> AccumT w μ β
release r
ar (forall a. a -> Maybe a
Just α
mr)) w
w''
                  Maybe (α, w)
Nothing → forall w (m :: * -> *) a. AccumT w m a -> w -> m (a, w)
runAccumT (r -> Maybe α -> AccumT w μ β
release r
ar forall a. Maybe a
Nothing) w
w')
               (\ ~(r
ar, w
w') → forall w (m :: * -> *) a. AccumT w m a -> w -> m (a, w)
runAccumT (r -> AccumT w μ α
m r
ar) w
w')
    forall (m :: * -> *) a. Monad m => a -> m a
return ((α
mr, β
fr), w
w''')

-- | Run the provided list of cleanup actions sequentually, attempting to run
-- the next action even if the previous one did not produce a result.
chainCleanups ∷ MonadFinally μ ⇒ [μ α] → μ ()
chainCleanups :: forall (μ :: * -> *) α. MonadFinally μ => [μ α] -> μ ()
chainCleanups []       = forall (m :: * -> *) a. Monad m => a -> m a
return ()
chainCleanups (μ α
m : [μ α]
ms) = forall (μ :: * -> *) α β. MonadFinally μ => μ α -> μ β -> μ α
finally (() forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ μ α
m) forall a b. (a -> b) -> a -> b
$ forall (μ :: * -> *) α. MonadFinally μ => [μ α] -> μ ()
chainCleanups [μ α]
ms

-- | A variant of 'finally' that combines multiple cleanup actions with
-- 'chainCleanups'.
finallyMany ∷ MonadFinally μ ⇒ μ α → [μ β] → μ α
finallyMany :: forall (μ :: * -> *) α β. MonadFinally μ => μ α -> [μ β] -> μ α
finallyMany μ α
m = forall (μ :: * -> *) α β. MonadFinally μ => μ α -> μ β -> μ α
finally μ α
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (μ :: * -> *) α. MonadFinally μ => [μ α] -> μ ()
chainCleanups
{-# INLINE finallyMany #-}

-- | @'onEscape' m c@ runs computation @m@ and then, if it did not produce
-- a result, runs computation @c@.
onEscape ∷ MonadFinally μ ⇒ μ α → μ β → μ α
onEscape :: forall (μ :: * -> *) α β. MonadFinally μ => μ α -> μ β -> μ α
onEscape μ α
m μ β
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall (μ :: * -> *) α β.
MonadFinally μ =>
μ α -> (Maybe α -> μ β) -> μ (α, β)
finally' μ α
m forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ μ β
f) (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ())
{-# INLINE onEscape #-}

-- | A variant of `onEscape` that combines multiple cleanup actions with
-- 'chainCleanups'.
onEscapeMany ∷ MonadFinally μ ⇒ μ α → [μ β] → μ α
onEscapeMany :: forall (μ :: * -> *) α β. MonadFinally μ => μ α -> [μ β] -> μ α
onEscapeMany μ α
m = forall (μ :: * -> *) α β. MonadFinally μ => μ α -> μ β -> μ α
onEscape μ α
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (μ :: * -> *) α. MonadFinally μ => [μ α] -> μ ()
chainCleanups

-- | A variant of 'bracket' where acquired value is not needed (e.g. using
-- a static resource).
bracket_ ∷ MonadFinally μ
         ⇒ μ r -- ^ Acquire resource
         → μ β -- ^ Release resource
         → μ α -- ^ Main computation
         → μ α
bracket_ :: forall (μ :: * -> *) r β α.
MonadFinally μ =>
μ r -> μ β -> μ α -> μ α
bracket_ μ r
acquire μ β
release = forall (μ :: * -> *) r β α.
MonadFinally μ =>
μ r -> (r -> μ β) -> (r -> μ α) -> μ α
bracket μ r
acquire (forall a b. a -> b -> a
const μ β
release) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
{-# INLINE bracket_ #-}

-- | A variant of 'bracket' that releases the acquired resource only when
-- the main computation does not produce a value.
bracketOnEscape ∷ MonadFinally μ
                ⇒ μ r       -- ^ Acquire resource
                → (r → μ β) -- ^ Release resource
                → (r → μ α) -- ^ Main computation
                → μ α
bracketOnEscape :: forall (μ :: * -> *) r β α.
MonadFinally μ =>
μ r -> (r -> μ β) -> (r -> μ α) -> μ α
bracketOnEscape μ r
acquire r -> μ β
release = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (μ :: * -> *) r α β.
MonadFinally μ =>
μ r -> (r -> Maybe α -> μ β) -> (r -> μ α) -> μ (α, β)
bracket' μ r
acquire forall {a}. r -> Maybe a -> μ (Maybe β)
release'
  where release' :: r -> Maybe a -> μ (Maybe β)
release' r
_  (Just a
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        release' r
ar Maybe a
Nothing  = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> r -> μ β
release r
ar