{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}

-- | The 'CleanupT' transformer for adding async exceptions to a stack

module Control.Monad.Trans.Cleanup.Types
  ( CleanupT (..)
  , CleanupIO
  ) where

import           Control.Applicative
import           Control.Monad

import           Control.Monad.Base
import           Control.Monad.Catch        as Catch
import           Control.Monad.Cleanup
import           Control.Monad.Fix
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Class

import           Data.Functor.Contravariant
import           Data.WorldPeace

-- | Adds 'SomeException' to an exception stack,
--   and thus /aware/ of async exceptions
newtype CleanupT m a = CleanupT { CleanupT m a -> m a
runCleanupT :: m a }

type CleanupIO a = CleanupT IO a

instance Eq (m a) => Eq (CleanupT m a) where
  CleanupT m a
a == :: CleanupT m a -> CleanupT m a -> Bool
== CleanupT m a
b = m a
a m a -> m a -> Bool
forall a. Eq a => a -> a -> Bool
== m a
b

instance Show (m a) => Show (CleanupT m a) where
  show :: CleanupT m a -> String
show (CleanupT m a
x) = String
"CleanupT (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> m a -> String
forall a. Show a => a -> String
show m a
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"

instance Functor m => Functor (CleanupT m) where
  fmap :: (a -> b) -> CleanupT m a -> CleanupT m b
fmap a -> b
f (CleanupT m a
action) = m b -> CleanupT m b
forall (m :: * -> *) a. m a -> CleanupT m a
CleanupT ((a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f m a
action)

instance Contravariant f => Contravariant (CleanupT f) where
  contramap :: (a -> b) -> CleanupT f b -> CleanupT f a
contramap a -> b
f = f a -> CleanupT f a
forall (m :: * -> *) a. m a -> CleanupT m a
CleanupT (f a -> CleanupT f a)
-> (CleanupT f b -> f a) -> CleanupT f b -> CleanupT f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> f b -> f a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> b
f (f b -> f a) -> (CleanupT f b -> f b) -> CleanupT f b -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CleanupT f b -> f b
forall (m :: * -> *) a. CleanupT m a -> m a
runCleanupT

instance Foldable t => Foldable (CleanupT t) where
  foldMap :: (a -> m) -> CleanupT t a -> m
foldMap a -> m
f (CleanupT t a
a) = (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f t a
a
  foldr :: (a -> b -> b) -> b -> CleanupT t a -> b
foldr a -> b -> b
f b
z (CleanupT t a
a) = (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
z t a
a

instance Traversable t => Traversable (CleanupT t) where
  traverse :: (a -> f b) -> CleanupT t a -> f (CleanupT t b)
traverse a -> f b
f (CleanupT t a
a) = t b -> CleanupT t b
forall (m :: * -> *) a. m a -> CleanupT m a
CleanupT (t b -> CleanupT t b) -> f (t b) -> f (CleanupT t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> t a -> f (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f t a
a

instance Applicative f => Applicative (CleanupT f) where
  pure :: a -> CleanupT f a
pure = f a -> CleanupT f a
forall (m :: * -> *) a. m a -> CleanupT m a
CleanupT (f a -> CleanupT f a) -> (a -> f a) -> a -> CleanupT f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  CleanupT f (a -> b)
f <*> :: CleanupT f (a -> b) -> CleanupT f a -> CleanupT f b
<*> CleanupT f a
x = f b -> CleanupT f b
forall (m :: * -> *) a. m a -> CleanupT m a
CleanupT (f (a -> b)
f f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
x)

instance Alternative f => Alternative (CleanupT f) where
  empty :: CleanupT f a
empty = f a -> CleanupT f a
forall (m :: * -> *) a. m a -> CleanupT m a
CleanupT f a
forall (f :: * -> *) a. Alternative f => f a
empty
  CleanupT f a
a <|> :: CleanupT f a -> CleanupT f a -> CleanupT f a
<|> CleanupT f a
b  = f a -> CleanupT f a
forall (m :: * -> *) a. m a -> CleanupT m a
CleanupT (f a
a f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f a
b)

instance Monad m => Monad (CleanupT m) where
  CleanupT m a
x >>= :: CleanupT m a -> (a -> CleanupT m b) -> CleanupT m b
>>= a -> CleanupT m b
f = m b -> CleanupT m b
forall (m :: * -> *) a. m a -> CleanupT m a
CleanupT (CleanupT m b -> m b
forall (m :: * -> *) a. CleanupT m a -> m a
runCleanupT (CleanupT m b -> m b) -> (a -> CleanupT m b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> CleanupT m b
f (a -> m b) -> m a -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m a
x)

instance MonadTrans CleanupT where
  lift :: m a -> CleanupT m a
lift = m a -> CleanupT m a
forall (m :: * -> *) a. m a -> CleanupT m a
CleanupT

instance MonadIO m => MonadIO (CleanupT m) where
  liftIO :: IO a -> CleanupT m a
liftIO = m a -> CleanupT m a
forall (m :: * -> *) a. m a -> CleanupT m a
CleanupT (m a -> CleanupT m a) -> (IO a -> m a) -> IO a -> CleanupT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance MonadPlus m => MonadPlus (CleanupT m) where
  mzero :: CleanupT m a
mzero = m a -> CleanupT m a
forall (m :: * -> *) a. m a -> CleanupT m a
CleanupT m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  mplus :: CleanupT m a -> CleanupT m a -> CleanupT m a
mplus (CleanupT m a
a) (CleanupT m a
b) = m a -> CleanupT m a
forall (m :: * -> *) a. m a -> CleanupT m a
CleanupT (m a -> m a -> m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus m a
a m a
b)

instance MonadFix m => MonadFix (CleanupT m) where
  mfix :: (a -> CleanupT m a) -> CleanupT m a
mfix a -> CleanupT m a
f = m a -> CleanupT m a
forall (m :: * -> *) a. m a -> CleanupT m a
CleanupT ((a -> m a) -> m a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (CleanupT m a -> m a
forall (m :: * -> *) a. CleanupT m a -> m a
runCleanupT (CleanupT m a -> m a) -> (a -> CleanupT m a) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> CleanupT m a
f))

instance MonadThrow m => MonadThrow (CleanupT m) where
  throwM :: e -> CleanupT m a
throwM = m a -> CleanupT m a
forall (m :: * -> *) a. m a -> CleanupT m a
CleanupT (m a -> CleanupT m a) -> (e -> m a) -> e -> CleanupT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM

instance MonadCatch m => MonadCatch (CleanupT m) where
  catch :: CleanupT m a -> (e -> CleanupT m a) -> CleanupT m a
catch (CleanupT m a
action) e -> CleanupT m a
handler =
    m a -> CleanupT m a
forall (m :: * -> *) a. m a -> CleanupT m a
CleanupT (m a -> CleanupT m a) -> m a -> CleanupT m a
forall a b. (a -> b) -> a -> b
$ m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch m a
action (CleanupT m a -> m a
forall (m :: * -> *) a. CleanupT m a -> m a
runCleanupT (CleanupT m a -> m a) -> (e -> CleanupT m a) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> CleanupT m a
handler)

instance MonadMask m => MonadMask (CleanupT m) where
   mask :: ((forall a. CleanupT m a -> CleanupT m a) -> CleanupT m b)
-> CleanupT m b
mask (forall a. CleanupT m a -> CleanupT m a) -> CleanupT m b
action = m b -> CleanupT m b
forall (m :: * -> *) a. m a -> CleanupT m a
CleanupT (m b -> CleanupT m b) -> m b -> CleanupT m b
forall a b. (a -> b) -> a -> b
$ ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask (\forall a. m a -> m a
u -> CleanupT m b -> m b
forall (m :: * -> *) a. CleanupT m a -> m a
runCleanupT ((forall a. CleanupT m a -> CleanupT m a) -> CleanupT m b
action ((forall a. CleanupT m a -> CleanupT m a) -> CleanupT m b)
-> (forall a. CleanupT m a -> CleanupT m a) -> CleanupT m b
forall a b. (a -> b) -> a -> b
$ (m a -> m a) -> CleanupT m a -> CleanupT m a
forall a. (m a -> m a) -> CleanupT m a -> CleanupT m a
q m a -> m a
forall a. m a -> m a
u))
    where
      q :: (m a -> m a) -> CleanupT m a -> CleanupT m a
      q :: (m a -> m a) -> CleanupT m a -> CleanupT m a
q m a -> m a
u = m a -> CleanupT m a
forall (m :: * -> *) a. m a -> CleanupT m a
CleanupT (m a -> CleanupT m a)
-> (CleanupT m a -> m a) -> CleanupT m a -> CleanupT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> m a
u (m a -> m a) -> (CleanupT m a -> m a) -> CleanupT m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CleanupT m a -> m a
forall (m :: * -> *) a. CleanupT m a -> m a
runCleanupT

   uninterruptibleMask :: ((forall a. CleanupT m a -> CleanupT m a) -> CleanupT m b)
-> CleanupT m b
uninterruptibleMask (forall a. CleanupT m a -> CleanupT m a) -> CleanupT m b
a =
    m b -> CleanupT m b
forall (m :: * -> *) a. m a -> CleanupT m a
CleanupT (m b -> CleanupT m b) -> m b -> CleanupT m b
forall a b. (a -> b) -> a -> b
$ ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask (\forall a. m a -> m a
u -> CleanupT m b -> m b
forall (m :: * -> *) a. CleanupT m a -> m a
runCleanupT ((forall a. CleanupT m a -> CleanupT m a) -> CleanupT m b
a ((forall a. CleanupT m a -> CleanupT m a) -> CleanupT m b)
-> (forall a. CleanupT m a -> CleanupT m a) -> CleanupT m b
forall a b. (a -> b) -> a -> b
$ (m a -> m a) -> CleanupT m a -> CleanupT m a
forall a. (m a -> m a) -> CleanupT m a -> CleanupT m a
q m a -> m a
forall a. m a -> m a
u))
      where
        q :: (m a -> m a) -> CleanupT m a -> CleanupT m a
        q :: (m a -> m a) -> CleanupT m a -> CleanupT m a
q m a -> m a
u = m a -> CleanupT m a
forall (m :: * -> *) a. m a -> CleanupT m a
CleanupT (m a -> CleanupT m a)
-> (CleanupT m a -> m a) -> CleanupT m a -> CleanupT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> m a
u (m a -> m a) -> (CleanupT m a -> m a) -> CleanupT m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CleanupT m a -> m a
forall (m :: * -> *) a. CleanupT m a -> m a
runCleanupT

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

instance
  ( Contains (Errors m) (Errors m)
  , MonadRaise m
  , MonadThrow m
  )
  => MonadRaise (CleanupT m) where
  type Errors (CleanupT m) = SomeException ': Errors m

  raise :: err -> CleanupT m a
raise err
err = (OpenUnion (Errors m) -> CleanupT m a)
-> (SomeException -> CleanupT m a)
-> OpenUnion (SomeException : Errors m)
-> CleanupT m a
forall (as :: [*]) c a.
(OpenUnion as -> c) -> (a -> c) -> OpenUnion (a : as) -> c
openUnion OpenUnion (Errors m) -> CleanupT m a
forall (err :: [*]) a.
Contains err (Errors m) =>
OpenUnion err -> CleanupT m a
raiser SomeException -> CleanupT m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM OpenUnion (SomeException : Errors m)
errsUnion
    where
      errsUnion :: OpenUnion (SomeException ': Errors m)
      errsUnion :: OpenUnion (SomeException : Errors m)
errsUnion = err -> OpenUnion (SomeException : Errors m)
forall err errs. Subset err errs => err -> errs
include err
err

      raiser :: Contains err (Errors m) => OpenUnion err -> CleanupT m a
      raiser :: OpenUnion err -> CleanupT m a
raiser = m a -> CleanupT m a
forall (m :: * -> *) a. m a -> CleanupT m a
CleanupT (m a -> CleanupT m a)
-> (OpenUnion err -> m a) -> OpenUnion err -> CleanupT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpenUnion err -> m a
forall (m :: * -> *) err a.
(MonadRaise m, Subset err (ErrorCase m)) =>
err -> m a
raise

instance MonadBase m m => MonadBase m (CleanupT m) where
  liftBase :: m α -> CleanupT m α
liftBase = m α -> CleanupT m α
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) α.
(MonadTrans t, MonadBase b m) =>
b α -> t m α
liftBaseDefault

instance
  ( MonadRescue m
  , MonadCatch  m
  , CheckErrors m
  , Errors m `Contains` (SomeException ': Errors m)
  )
  => MonadRescue (CleanupT m) where
    attempt :: CleanupT m a -> CleanupT m (Either (ErrorCase (CleanupT m)) a)
attempt (CleanupT m a
action) =
      m (Either (OpenUnion (SomeException : Errors m)) a)
-> CleanupT m (Either (OpenUnion (SomeException : Errors m)) a)
forall (m :: * -> *) a. m a -> CleanupT m a
CleanupT (m (Either (OpenUnion (SomeException : Errors m)) a)
 -> CleanupT m (Either (OpenUnion (SomeException : Errors m)) a))
-> m (Either (OpenUnion (SomeException : Errors m)) a)
-> CleanupT m (Either (OpenUnion (SomeException : Errors m)) a)
forall a b. (a -> b) -> a -> b
$
        m (Either SomeException (Either (OpenUnion (Errors m)) a))
inner m (Either SomeException (Either (OpenUnion (Errors m)) a))
-> (Either SomeException (Either (OpenUnion (Errors m)) a)
    -> m (Either (OpenUnion (SomeException : Errors m)) a))
-> m (Either (OpenUnion (SomeException : Errors m)) a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Left SomeException
err          -> Either (OpenUnion (SomeException : Errors m)) a
-> m (Either (OpenUnion (SomeException : Errors m)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (OpenUnion (SomeException : Errors m)) a
 -> m (Either (OpenUnion (SomeException : Errors m)) a))
-> (OpenUnion (SomeException : Errors m)
    -> Either (OpenUnion (SomeException : Errors m)) a)
-> OpenUnion (SomeException : Errors m)
-> m (Either (OpenUnion (SomeException : Errors m)) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpenUnion (SomeException : Errors m)
-> Either (OpenUnion (SomeException : Errors m)) a
forall a b. a -> Either a b
Left (OpenUnion (SomeException : Errors m)
 -> m (Either (OpenUnion (SomeException : Errors m)) a))
-> OpenUnion (SomeException : Errors m)
-> m (Either (OpenUnion (SomeException : Errors m)) a)
forall a b. (a -> b) -> a -> b
$ SomeException -> OpenUnion (SomeException : Errors m)
forall err errs. Subset err errs => err -> errs
include SomeException
err
          Right (Left  OpenUnion (Errors m)
err) -> Either (OpenUnion (SomeException : Errors m)) a
-> m (Either (OpenUnion (SomeException : Errors m)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (OpenUnion (SomeException : Errors m)) a
 -> m (Either (OpenUnion (SomeException : Errors m)) a))
-> (OpenUnion (SomeException : Errors m)
    -> Either (OpenUnion (SomeException : Errors m)) a)
-> OpenUnion (SomeException : Errors m)
-> m (Either (OpenUnion (SomeException : Errors m)) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpenUnion (SomeException : Errors m)
-> Either (OpenUnion (SomeException : Errors m)) a
forall a b. a -> Either a b
Left (OpenUnion (SomeException : Errors m)
 -> m (Either (OpenUnion (SomeException : Errors m)) a))
-> OpenUnion (SomeException : Errors m)
-> m (Either (OpenUnion (SomeException : Errors m)) a)
forall a b. (a -> b) -> a -> b
$ OpenUnion (Errors m) -> OpenUnion (SomeException : Errors m)
forall err errs. Subset err errs => err -> errs
include OpenUnion (Errors m)
err
          Right (Right a
val) -> Either (OpenUnion (SomeException : Errors m)) a
-> m (Either (OpenUnion (SomeException : Errors m)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (OpenUnion (SomeException : Errors m)) a
 -> m (Either (OpenUnion (SomeException : Errors m)) a))
-> Either (OpenUnion (SomeException : Errors m)) a
-> m (Either (OpenUnion (SomeException : Errors m)) a)
forall a b. (a -> b) -> a -> b
$ a -> Either (OpenUnion (SomeException : Errors m)) a
forall a b. b -> Either a b
Right a
val
      where
        inner :: m (Either SomeException (Either (OpenUnion (Errors m)) a))
inner =
          m a -> m (Either SomeException a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
Catch.try m a
action m (Either SomeException a)
-> (Either SomeException a
    -> m (Either SomeException (Either (OpenUnion (Errors m)) a)))
-> m (Either SomeException (Either (OpenUnion (Errors m)) a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Left  e :: SomeException
e@(SomeException e
_) -> Either SomeException (Either (OpenUnion (Errors m)) a)
-> m (Either SomeException (Either (OpenUnion (Errors m)) a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SomeException (Either (OpenUnion (Errors m)) a)
 -> m (Either SomeException (Either (OpenUnion (Errors m)) a)))
-> Either SomeException (Either (OpenUnion (Errors m)) a)
-> m (Either SomeException (Either (OpenUnion (Errors m)) a))
forall a b. (a -> b) -> a -> b
$ SomeException
-> Either SomeException (Either (OpenUnion (Errors m)) a)
forall a b. a -> Either a b
Left SomeException
e
            Right a
val                 -> Either (OpenUnion (Errors m)) a
-> Either SomeException (Either (OpenUnion (Errors m)) a)
forall a b. b -> Either a b
Right (Either (OpenUnion (Errors m)) a
 -> Either SomeException (Either (OpenUnion (Errors m)) a))
-> m (Either (OpenUnion (Errors m)) a)
-> m (Either SomeException (Either (OpenUnion (Errors m)) a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a -> m (Either (OpenUnion (Errors m)) a)
forall (m :: * -> *) a.
MonadRescue m =>
m a -> m (Either (ErrorCase m) a)
attempt (a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
val)

instance
  ( MonadRescue m
  , MonadMask   m
  , CheckErrors m
  , Contains (Errors m) (SomeException ': Errors m)
  )
  => MonadCleanup (CleanupT m) where
  cleanup :: CleanupT m resource
-> (resource -> ErrorCase (CleanupT m) -> CleanupT m _ig1)
-> (resource -> CleanupT m _ig2)
-> (resource -> CleanupT m a)
-> CleanupT m a
cleanup CleanupT m resource
acquire resource -> ErrorCase (CleanupT m) -> CleanupT m _ig1
onErr resource -> CleanupT m _ig2
onOk resource -> CleanupT m a
action =
    ((forall a. CleanupT m a -> CleanupT m a) -> CleanupT m a)
-> CleanupT m a
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. CleanupT m a -> CleanupT m a) -> CleanupT m a)
 -> CleanupT m a)
-> ((forall a. CleanupT m a -> CleanupT m a) -> CleanupT m a)
-> CleanupT m a
forall a b. (a -> b) -> a -> b
$ \forall a. CleanupT m a -> CleanupT m a
restore -> do
      resource
resource <- CleanupT m resource
acquire

      CleanupT m a -> CleanupT m (Either (ErrorCase (CleanupT m)) a)
forall (m :: * -> *) a.
MonadRescue m =>
m a -> m (Either (ErrorCase m) a)
attempt (CleanupT m a -> CleanupT m a
forall a. CleanupT m a -> CleanupT m a
restore (CleanupT m a -> CleanupT m a) -> CleanupT m a -> CleanupT m a
forall a b. (a -> b) -> a -> b
$ resource -> CleanupT m a
action resource
resource) CleanupT m (Either (Union Identity (SomeException : Errors m)) a)
-> (Either (Union Identity (SomeException : Errors m)) a
    -> CleanupT m a)
-> CleanupT m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left Union Identity (SomeException : Errors m)
errs -> do
          ()
_ <- CleanupT m () -> CleanupT m ()
forall (m :: * -> *) a. MonadMask m => m a -> m a
uninterruptibleMask_ (CleanupT m () -> CleanupT m ()) -> CleanupT m () -> CleanupT m ()
forall a b. (a -> b) -> a -> b
$
                 (_ig1 -> ()) -> CleanupT m _ig1 -> CleanupT m ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\_ig1
_ -> ()) (resource -> ErrorCase (CleanupT m) -> CleanupT m _ig1
onErr resource
resource Union Identity (SomeException : Errors m)
ErrorCase (CleanupT m)
errs)
                   CleanupT m () -> (SomeException -> CleanupT m ()) -> CleanupT m ()
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \(SomeException
_ :: SomeException) -> () -> CleanupT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

          Union Identity (SomeException : Errors m) -> CleanupT m a
forall (m :: * -> *) err a.
(MonadRaise m, Subset err (ErrorCase m)) =>
err -> m a
raise Union Identity (SomeException : Errors m)
errs

        Right a
output -> do
          _ig2
_ <- resource -> CleanupT m _ig2
onOk resource
resource
          a -> CleanupT m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
output