{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
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
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