{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
module Control.Monad.Cleanup where
import Control.Exception.Safe
import Control.Monad.Catch (ExitCase (..))
import Control.Monad.ST
import Control.Monad.Trans.Except (ExceptT (..), runExceptT)
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
import qualified Control.Monad.Trans.RWS.Lazy as LazyRWS
import qualified Control.Monad.Trans.RWS.Strict as StrictRWS
import Control.Monad.Trans.Reader (ReaderT (..), runReaderT)
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 Data.Coerce
import Data.Functor.Identity
class (Monad m) => MonadCleanup m where
generalCleanup ::
m a ->
(a -> ExitCase b -> m c) ->
(a -> m b) ->
m (b, c)
data AbortException = AbortException
deriving stock (Int -> AbortException -> ShowS
[AbortException] -> ShowS
AbortException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AbortException] -> ShowS
$cshowList :: [AbortException] -> ShowS
show :: AbortException -> String
$cshow :: AbortException -> String
showsPrec :: Int -> AbortException -> ShowS
$cshowsPrec :: Int -> AbortException -> ShowS
Show)
deriving anyclass (Show AbortException
Typeable AbortException
SomeException -> Maybe AbortException
AbortException -> String
AbortException -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: AbortException -> String
$cdisplayException :: AbortException -> String
fromException :: SomeException -> Maybe AbortException
$cfromException :: SomeException -> Maybe AbortException
toException :: AbortException -> SomeException
$ctoException :: AbortException -> SomeException
Exception)
withCleanup ::
(MonadCleanup m) =>
m a ->
(Maybe SomeException -> a -> m b) ->
(a -> m c) ->
m c
withCleanup :: forall (m :: * -> *) a b c.
MonadCleanup m =>
m a -> (Maybe SomeException -> a -> m b) -> (a -> m c) -> m c
withCleanup m a
acquire Maybe SomeException -> a -> m b
cleanup a -> m c
go = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b c.
MonadCleanup m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalCleanup m a
acquire forall {a}. a -> ExitCase a -> m b
release a -> m c
go
where
release :: a -> ExitCase a -> m b
release a
x (ExitCaseSuccess a
_) = Maybe SomeException -> a -> m b
cleanup forall a. Maybe a
Nothing a
x
release a
x ExitCase a
ExitCaseAbort = Maybe SomeException -> a -> m b
cleanup (forall a. a -> Maybe a
Just (forall e. Exception e => e -> SomeException
toException AbortException
AbortException)) a
x
release a
x (ExitCaseException SomeException
e) = Maybe SomeException -> a -> m b
cleanup (forall a. a -> Maybe a
Just SomeException
e) a
x
newtype CleanupFromMask m a = CleanupFromMask (m a) deriving newtype (forall a b. a -> CleanupFromMask m b -> CleanupFromMask m a
forall a b. (a -> b) -> CleanupFromMask m a -> CleanupFromMask m b
forall (m :: * -> *) a b.
Functor m =>
a -> CleanupFromMask m b -> CleanupFromMask m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> CleanupFromMask m a -> CleanupFromMask m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> CleanupFromMask m b -> CleanupFromMask m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> CleanupFromMask m b -> CleanupFromMask m a
fmap :: forall a b. (a -> b) -> CleanupFromMask m a -> CleanupFromMask m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> CleanupFromMask m a -> CleanupFromMask m b
Functor, forall a. a -> CleanupFromMask m a
forall a b.
CleanupFromMask m a -> CleanupFromMask m b -> CleanupFromMask m a
forall a b.
CleanupFromMask m a -> CleanupFromMask m b -> CleanupFromMask m b
forall a b.
CleanupFromMask m (a -> b)
-> CleanupFromMask m a -> CleanupFromMask m b
forall a b c.
(a -> b -> c)
-> CleanupFromMask m a
-> CleanupFromMask m b
-> CleanupFromMask m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {m :: * -> *}. Applicative m => Functor (CleanupFromMask m)
forall (m :: * -> *) a. Applicative m => a -> CleanupFromMask m a
forall (m :: * -> *) a b.
Applicative m =>
CleanupFromMask m a -> CleanupFromMask m b -> CleanupFromMask m a
forall (m :: * -> *) a b.
Applicative m =>
CleanupFromMask m a -> CleanupFromMask m b -> CleanupFromMask m b
forall (m :: * -> *) a b.
Applicative m =>
CleanupFromMask m (a -> b)
-> CleanupFromMask m a -> CleanupFromMask m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> CleanupFromMask m a
-> CleanupFromMask m b
-> CleanupFromMask m c
<* :: forall a b.
CleanupFromMask m a -> CleanupFromMask m b -> CleanupFromMask m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
CleanupFromMask m a -> CleanupFromMask m b -> CleanupFromMask m a
*> :: forall a b.
CleanupFromMask m a -> CleanupFromMask m b -> CleanupFromMask m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
CleanupFromMask m a -> CleanupFromMask m b -> CleanupFromMask m b
liftA2 :: forall a b c.
(a -> b -> c)
-> CleanupFromMask m a
-> CleanupFromMask m b
-> CleanupFromMask m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> CleanupFromMask m a
-> CleanupFromMask m b
-> CleanupFromMask m c
<*> :: forall a b.
CleanupFromMask m (a -> b)
-> CleanupFromMask m a -> CleanupFromMask m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
CleanupFromMask m (a -> b)
-> CleanupFromMask m a -> CleanupFromMask m b
pure :: forall a. a -> CleanupFromMask m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> CleanupFromMask m a
Applicative, forall a. a -> CleanupFromMask m a
forall a b.
CleanupFromMask m a -> CleanupFromMask m b -> CleanupFromMask m b
forall a b.
CleanupFromMask m a
-> (a -> CleanupFromMask m b) -> CleanupFromMask m b
forall {m :: * -> *}. Monad m => Applicative (CleanupFromMask m)
forall (m :: * -> *) a. Monad m => a -> CleanupFromMask m a
forall (m :: * -> *) a b.
Monad m =>
CleanupFromMask m a -> CleanupFromMask m b -> CleanupFromMask m b
forall (m :: * -> *) a b.
Monad m =>
CleanupFromMask m a
-> (a -> CleanupFromMask m b) -> CleanupFromMask m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> CleanupFromMask m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> CleanupFromMask m a
>> :: forall a b.
CleanupFromMask m a -> CleanupFromMask m b -> CleanupFromMask m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
CleanupFromMask m a -> CleanupFromMask m b -> CleanupFromMask m b
>>= :: forall a b.
CleanupFromMask m a
-> (a -> CleanupFromMask m b) -> CleanupFromMask m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
CleanupFromMask m a
-> (a -> CleanupFromMask m b) -> CleanupFromMask m b
Monad)
instance (MonadMask m) => MonadCleanup (CleanupFromMask m) where
generalCleanup :: forall a b c. CleanupFromMask m a -> (a -> ExitCase b -> CleanupFromMask m c) -> (a -> CleanupFromMask m b) -> CleanupFromMask m (b, c)
generalCleanup :: forall a b c.
CleanupFromMask m a
-> (a -> ExitCase b -> CleanupFromMask m c)
-> (a -> CleanupFromMask m b)
-> CleanupFromMask m (b, c)
generalCleanup = coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket @m @a @b @c
deriving via CleanupFromMask IO instance MonadCleanup IO
newtype CleanupNoException m a = CleanupNoException (m a) deriving newtype (forall a b. a -> CleanupNoException m b -> CleanupNoException m a
forall a b.
(a -> b) -> CleanupNoException m a -> CleanupNoException m b
forall (m :: * -> *) a b.
Functor m =>
a -> CleanupNoException m b -> CleanupNoException m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> CleanupNoException m a -> CleanupNoException m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> CleanupNoException m b -> CleanupNoException m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> CleanupNoException m b -> CleanupNoException m a
fmap :: forall a b.
(a -> b) -> CleanupNoException m a -> CleanupNoException m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> CleanupNoException m a -> CleanupNoException m b
Functor, forall a. a -> CleanupNoException m a
forall a b.
CleanupNoException m a
-> CleanupNoException m b -> CleanupNoException m a
forall a b.
CleanupNoException m a
-> CleanupNoException m b -> CleanupNoException m b
forall a b.
CleanupNoException m (a -> b)
-> CleanupNoException m a -> CleanupNoException m b
forall a b c.
(a -> b -> c)
-> CleanupNoException m a
-> CleanupNoException m b
-> CleanupNoException m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {m :: * -> *}.
Applicative m =>
Functor (CleanupNoException m)
forall (m :: * -> *) a.
Applicative m =>
a -> CleanupNoException m a
forall (m :: * -> *) a b.
Applicative m =>
CleanupNoException m a
-> CleanupNoException m b -> CleanupNoException m a
forall (m :: * -> *) a b.
Applicative m =>
CleanupNoException m a
-> CleanupNoException m b -> CleanupNoException m b
forall (m :: * -> *) a b.
Applicative m =>
CleanupNoException m (a -> b)
-> CleanupNoException m a -> CleanupNoException m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> CleanupNoException m a
-> CleanupNoException m b
-> CleanupNoException m c
<* :: forall a b.
CleanupNoException m a
-> CleanupNoException m b -> CleanupNoException m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
CleanupNoException m a
-> CleanupNoException m b -> CleanupNoException m a
*> :: forall a b.
CleanupNoException m a
-> CleanupNoException m b -> CleanupNoException m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
CleanupNoException m a
-> CleanupNoException m b -> CleanupNoException m b
liftA2 :: forall a b c.
(a -> b -> c)
-> CleanupNoException m a
-> CleanupNoException m b
-> CleanupNoException m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> CleanupNoException m a
-> CleanupNoException m b
-> CleanupNoException m c
<*> :: forall a b.
CleanupNoException m (a -> b)
-> CleanupNoException m a -> CleanupNoException m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
CleanupNoException m (a -> b)
-> CleanupNoException m a -> CleanupNoException m b
pure :: forall a. a -> CleanupNoException m a
$cpure :: forall (m :: * -> *) a.
Applicative m =>
a -> CleanupNoException m a
Applicative, forall a. a -> CleanupNoException m a
forall a b.
CleanupNoException m a
-> CleanupNoException m b -> CleanupNoException m b
forall a b.
CleanupNoException m a
-> (a -> CleanupNoException m b) -> CleanupNoException m b
forall {m :: * -> *}. Monad m => Applicative (CleanupNoException m)
forall (m :: * -> *) a. Monad m => a -> CleanupNoException m a
forall (m :: * -> *) a b.
Monad m =>
CleanupNoException m a
-> CleanupNoException m b -> CleanupNoException m b
forall (m :: * -> *) a b.
Monad m =>
CleanupNoException m a
-> (a -> CleanupNoException m b) -> CleanupNoException m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> CleanupNoException m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> CleanupNoException m a
>> :: forall a b.
CleanupNoException m a
-> CleanupNoException m b -> CleanupNoException m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
CleanupNoException m a
-> CleanupNoException m b -> CleanupNoException m b
>>= :: forall a b.
CleanupNoException m a
-> (a -> CleanupNoException m b) -> CleanupNoException m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
CleanupNoException m a
-> (a -> CleanupNoException m b) -> CleanupNoException m b
Monad)
instance (Monad m) => MonadCleanup (CleanupNoException m) where
generalCleanup :: forall a b c.
CleanupNoException m a
-> (a -> ExitCase b -> CleanupNoException m c)
-> (a -> CleanupNoException m b)
-> CleanupNoException m (b, c)
generalCleanup CleanupNoException m a
acquire a -> ExitCase b -> CleanupNoException m c
release a -> CleanupNoException m b
go = do
a
x <- CleanupNoException m a
acquire
b
res <- a -> CleanupNoException m b
go a
x
c
carry <- a -> ExitCase b -> CleanupNoException m c
release a
x (forall a. a -> ExitCase a
ExitCaseSuccess b
res)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b
res, c
carry)
deriving via CleanupNoException (ST s) instance MonadCleanup (ST s)
deriving via CleanupNoException Identity instance MonadCleanup Identity
instance (MonadCleanup m) => MonadCleanup (IdentityT m) where
generalCleanup :: forall a b c.
IdentityT m a
-> (a -> ExitCase b -> IdentityT m c)
-> (a -> IdentityT m b)
-> IdentityT m (b, c)
generalCleanup 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.
MonadCleanup m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalCleanup
(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 MonadCleanup m => MonadCleanup (LazyS.StateT s m) where
generalCleanup :: forall a b c.
StateT s m a
-> (a -> ExitCase b -> StateT s m c)
-> (a -> StateT s m b)
-> StateT s m (b, c)
generalCleanup 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
((b
b, s
_s2), (c
c, s
s3)) <-
forall (m :: * -> *) a b c.
MonadCleanup m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalCleanup
(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
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 MonadCleanup m => MonadCleanup (StrictS.StateT s m) where
generalCleanup :: forall a b c.
StateT s m a
-> (a -> ExitCase b -> StateT s m c)
-> (a -> StateT s m b)
-> StateT s m (b, c)
generalCleanup 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.
MonadCleanup m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalCleanup
(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
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 MonadCleanup m => MonadCleanup (ReaderT r m) where
generalCleanup :: forall a b c.
ReaderT r m a
-> (a -> ExitCase b -> ReaderT r m c)
-> (a -> ReaderT r m b)
-> ReaderT r m (b, c)
generalCleanup 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.
MonadCleanup m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalCleanup
(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 (MonadCleanup m, Monoid w) => MonadCleanup (StrictW.WriterT w m) where
generalCleanup :: forall a b c.
WriterT w m a
-> (a -> ExitCase b -> WriterT w m c)
-> (a -> WriterT w m b)
-> WriterT w m (b, c)
generalCleanup 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.
MonadCleanup m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalCleanup
(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)
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 (MonadCleanup m, Monoid w) => MonadCleanup (LazyW.WriterT w m) where
generalCleanup :: forall a b c.
WriterT w m a
-> (a -> ExitCase b -> WriterT w m c)
-> (a -> WriterT w m b)
-> WriterT w m (b, c)
generalCleanup 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.
MonadCleanup m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalCleanup
(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)
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 (MonadCleanup m, Monoid w) => MonadCleanup (LazyRWS.RWST r w s m) where
generalCleanup :: forall a b c.
RWST r w s m a
-> (a -> ExitCase b -> RWST r w s m c)
-> (a -> RWST r w s m b)
-> RWST r w s m (b, c)
generalCleanup 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.
MonadCleanup m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalCleanup
(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)
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 (MonadCleanup m, Monoid w) => MonadCleanup (StrictRWS.RWST r w s m) where
generalCleanup :: forall a b c.
RWST r w s m a
-> (a -> ExitCase b -> RWST r w s m c)
-> (a -> RWST r w s m b)
-> RWST r w s m (b, c)
generalCleanup 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.
MonadCleanup m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalCleanup
(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)
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)
instance MonadCleanup m => MonadCleanup (MaybeT m) where
generalCleanup :: forall a b c.
MaybeT m a
-> (a -> ExitCase b -> MaybeT m c)
-> (a -> MaybeT m b)
-> MaybeT m (b, c)
generalCleanup 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.
MonadCleanup m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalCleanup
(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
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)
)
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)
instance MonadCleanup m => MonadCleanup (ExceptT e m) where
generalCleanup :: forall a b c.
ExceptT e m a
-> (a -> ExitCase b -> ExceptT e m c)
-> (a -> ExceptT e m b)
-> ExceptT e m (b, c)
generalCleanup 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
(Either e b
eb, Either e c
ec) <-
forall (m :: * -> *) a b c.
MonadCleanup m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalCleanup
(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)
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
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)