{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UnicodeSyntax #-}

{- |
Description : Lexically-scoped exception-safe resource usage
Copyright   : Copyright 2022 Shea Levy.
License     : Apache-2.0
Maintainer  : shea@shealevy.com

This module defines interfaces for safe resource usage on top of 'GeneralAllocate',
where resource cleanup happens at the end of a lexical scope.

For contexts where nested scope-based allocation and release is insufficient, see
"Control.Monad.Allocate".
-}
module Control.Monad.With where

import Control.Exception.Safe
import Control.Monad.Except
import qualified Control.Monad.RWS.Lazy as L
import Control.Monad.RWS.Strict
import Control.Monad.Reader
import Control.Monad.ST
import qualified Control.Monad.State.Lazy as L
import Control.Monad.State.Strict
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Resource.Internal
import qualified Control.Monad.Writer.Lazy as L
import Control.Monad.Writer.Strict
import Data.Functor
import Data.Functor.Identity
import Data.GeneralAllocate
import Data.Void

{- | A monad allowing for exception-safe resource usage within a lexical scope.

The guarantees of 'MonadWith' are weaker than t'Control.Monad.Catch.MonadMask': in some
monads, it's possible for resources not to get cleaned up if the /entire/ monadic
computation is going to be aborted (e.g. an async exception sent to a thread executing a monad
with no exception catching). Of course, t'Control.Monad.Catch.MonadMask' itself can't guarantee
cleanup in the presence of @SIGKILL@... In any case, this allows for 'MonadWith' to be implemented
lawfully in more monads (see 'WithNoContinuation'). In particular, the 'MonadWith' instances for
'IO', 'ST', and 'Identity' allow for writing monad-generic exception-safe code which can be properly
instantiated in 'IO' or mocked out in 'ST'/'Identity' without changing the code.
-}
class Monad m ⇒ MonadWith m where
  -- | Data characterizing exceptional exit from the scope.
  type WithException m

  type WithException m = SomeException

  -- | Allocate, use, and release a resource in some scope, threading through some state.
  --
  -- If resource acquisition succeeds, the resource is guaranteed to be released
  -- /if the monadic computation itself is going to continue/. This is weaker than
  -- the guarantees of v'Control.Monad.Catch.generalBracket', which can't be
  -- implemented in monads without exception catching.
  --
  -- See 'generalWith' for the common use case where state threading isn't needed.
  stateThreadingGeneralWith
    ∷ GeneralAllocate m (WithException m) releaseReturn b a
    -- ^ Allocate the resource
    → (a → m b)
    -- ^ Use the resource
    → m (b, releaseReturn)

{- | Describe the allocation and release of a resource.

A specialization of 'GeneralAllocate' for the most
common case with 'MonadWith', see 'generalWith'.
-}
type With m = GeneralAllocate m (WithException m) ()

{- | Allocate, use, and release a resource in some scope.

If resource acquisition succeeds, the resource is guaranteed to be released
/if the monadic computation itself is going to continue/. This is weaker than
the guarantees of v'Control.Monad.Catch.generalBracket', which can't be
implemented in monads without exception catching.
-}
generalWith
  ∷ (MonadWith m)
  ⇒ With m b a
  -- ^ Allocate the resource
  → (a → m b)
  -- ^ Use the resource
  → m b
generalWith :: forall (m :: * -> *) b a.
MonadWith m =>
With m b a -> (a -> m b) -> m b
generalWith With m b a
alloc = (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) releaseReturn b a.
MonadWith m =>
GeneralAllocate m (WithException m) releaseReturn b a
-> (a -> m b) -> m (b, releaseReturn)
stateThreadingGeneralWith With m b a
alloc

{- | Run some action if the first action fails.

Exception propagation will continue after the failure action runs.

If failure occurs, the failure action is guaranteed to run
/if the monadic compuation itself is going to continue/. This is
weaker than the guranatess of v'Control.Monad.Catch.onError', which can't
be implemented in monads without exception catching.
-}
onFailure
  ∷ (MonadWith m)
  ⇒ m a
  -- ^ Main action
  → (WithException m → m b)
  -- ^ Failure action
  → m a
onFailure :: forall (m :: * -> *) a b.
MonadWith m =>
m a -> (WithException m -> m b) -> m a
onFailure m a
go WithException m -> m b
err = forall (m :: * -> *) b a.
MonadWith m =>
With m b a -> (a -> m b) -> m b
generalWith GeneralAllocate m (WithException m) () a ()
alloc (forall a b. a -> b -> a
const m a
go)
 where
  alloc :: GeneralAllocate m (WithException m) () a ()
alloc = forall (m :: * -> *) e releaseReturn releaseArg a.
((forall x. m x -> m x)
 -> m (GeneralAllocated m e releaseReturn releaseArg a))
-> GeneralAllocate m e releaseReturn releaseArg a
GeneralAllocate forall a b. (a -> b) -> a -> b
$ \forall x. m x -> m x
_ → forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e releaseReturn releaseArg a.
a
-> (GeneralReleaseType e releaseArg -> m releaseReturn)
-> GeneralAllocated m e releaseReturn releaseArg a
GeneralAllocated () GeneralReleaseType (WithException m) a -> m ()
rel
  rel :: GeneralReleaseType (WithException m) a -> m ()
rel (ReleaseFailure WithException m
e) = WithException m -> m b
err WithException m
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  rel GeneralReleaseType (WithException m) a
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

{- | Run some action after another one completes in an exception-safe manner.

The final action is guaranteed to run
/if the monadic compuation itself is going to continue/. This is
weaker than the guranatess of v'Control.Monad.Catch.finally', which can't
be implemented in monads without exception catching.
-}
generalFinally
  ∷ (MonadWith m)
  ⇒ m a
  -- ^ Main action
  → m b
  -- ^ Final action
  → m (a, b)
generalFinally :: forall (m :: * -> *) a b. MonadWith m => m a -> m b -> m (a, b)
generalFinally m a
go m b
fin = forall (m :: * -> *) releaseReturn b a.
MonadWith m =>
GeneralAllocate m (WithException m) releaseReturn b a
-> (a -> m b) -> m (b, releaseReturn)
stateThreadingGeneralWith GeneralAllocate m (WithException m) b a ()
alloc forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const m a
go
 where
  alloc :: GeneralAllocate m (WithException m) b a ()
alloc = forall (m :: * -> *) e releaseReturn releaseArg a.
((forall x. m x -> m x)
 -> m (GeneralAllocated m e releaseReturn releaseArg a))
-> GeneralAllocate m e releaseReturn releaseArg a
GeneralAllocate forall a b. (a -> b) -> a -> b
$ \forall x. m x -> m x
_ → forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e releaseReturn releaseArg a.
a
-> (GeneralReleaseType e releaseArg -> m releaseReturn)
-> GeneralAllocated m e releaseReturn releaseArg a
GeneralAllocated () GeneralReleaseType (WithException m) a -> m b
rel
  rel :: GeneralReleaseType (WithException m) a -> m b
rel GeneralReleaseType (WithException m) a
_ = m b
fin

-- | A 'MonadWith' whose exception type can be projected into the Haskell exception hierarchy
class MonadWith m ⇒ MonadWithExceptable m where
  -- |
  withExceptionToException ∷ WithException m → SomeException

instance MonadWith IO where
  stateThreadingGeneralWith :: forall releaseReturn b a.
GeneralAllocate IO (WithException IO) releaseReturn b a
-> (a -> IO b) -> IO (b, releaseReturn)
stateThreadingGeneralWith (GeneralAllocate (forall x. IO x -> IO x)
-> IO (GeneralAllocated IO (WithException IO) releaseReturn b a)
allocA) a -> IO b
go = forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall x. IO x -> IO x
restore → do
    GeneralAllocated a
a GeneralReleaseType SomeException b -> IO releaseReturn
releaseA ← (forall x. IO x -> IO x)
-> IO (GeneralAllocated IO (WithException IO) releaseReturn b a)
allocA forall x. IO x -> IO x
restore
    b
b ←
      forall x. IO x -> IO x
restore (a -> IO b
go a
a) forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \SomeException
e → do
        releaseReturn
_ ← GeneralReleaseType SomeException b -> IO releaseReturn
releaseA forall a b. (a -> b) -> a -> b
$ forall e a. e -> GeneralReleaseType e a
ReleaseFailure SomeException
e
        forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SomeException
e
    releaseReturn
c ← GeneralReleaseType SomeException b -> IO releaseReturn
releaseA forall a b. (a -> b) -> a -> b
$ forall e a. a -> GeneralReleaseType e a
ReleaseSuccess b
b
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (b
b, releaseReturn
c)

instance MonadWithExceptable IO where
  withExceptionToException :: WithException IO -> SomeException
withExceptionToException = forall a. a -> a
id

{- | A helper for [DerivingVia](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/deriving_via.html) a
'MonadWith' and 'MonadWithExceptable' instance for any 'Monad'.

Note that the derived instance is only valid if the monad satisfies the "no continuation" condition, i.e.
that if execution of a computation exits a given lexical scope we are guaranteed that either all of the
actions within that scope have executed or the entire monadic computation has been terminated.

The most common factors violating "no continuation" are call/cc and exception catching. A monad which allows
exception /throwing/ but not catching is not thereby disqualified, as any thrown exception will of necessity
propagate until it terminates the entire monadic computation.
-}
newtype WithNoContinuation m a = WithNoContinuation (m a) deriving newtype (forall a b. a -> WithNoContinuation m b -> WithNoContinuation m a
forall a b.
(a -> b) -> WithNoContinuation m a -> WithNoContinuation m b
forall (m :: * -> *) a b.
Functor m =>
a -> WithNoContinuation m b -> WithNoContinuation m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> WithNoContinuation m a -> WithNoContinuation 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 -> WithNoContinuation m b -> WithNoContinuation m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> WithNoContinuation m b -> WithNoContinuation m a
fmap :: forall a b.
(a -> b) -> WithNoContinuation m a -> WithNoContinuation m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> WithNoContinuation m a -> WithNoContinuation m b
Functor, forall a. a -> WithNoContinuation m a
forall a b.
WithNoContinuation m a
-> WithNoContinuation m b -> WithNoContinuation m a
forall a b.
WithNoContinuation m a
-> WithNoContinuation m b -> WithNoContinuation m b
forall a b.
WithNoContinuation m (a -> b)
-> WithNoContinuation m a -> WithNoContinuation m b
forall a b c.
(a -> b -> c)
-> WithNoContinuation m a
-> WithNoContinuation m b
-> WithNoContinuation 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 (WithNoContinuation m)
forall (m :: * -> *) a.
Applicative m =>
a -> WithNoContinuation m a
forall (m :: * -> *) a b.
Applicative m =>
WithNoContinuation m a
-> WithNoContinuation m b -> WithNoContinuation m a
forall (m :: * -> *) a b.
Applicative m =>
WithNoContinuation m a
-> WithNoContinuation m b -> WithNoContinuation m b
forall (m :: * -> *) a b.
Applicative m =>
WithNoContinuation m (a -> b)
-> WithNoContinuation m a -> WithNoContinuation m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> WithNoContinuation m a
-> WithNoContinuation m b
-> WithNoContinuation m c
<* :: forall a b.
WithNoContinuation m a
-> WithNoContinuation m b -> WithNoContinuation m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
WithNoContinuation m a
-> WithNoContinuation m b -> WithNoContinuation m a
*> :: forall a b.
WithNoContinuation m a
-> WithNoContinuation m b -> WithNoContinuation m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
WithNoContinuation m a
-> WithNoContinuation m b -> WithNoContinuation m b
liftA2 :: forall a b c.
(a -> b -> c)
-> WithNoContinuation m a
-> WithNoContinuation m b
-> WithNoContinuation m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> WithNoContinuation m a
-> WithNoContinuation m b
-> WithNoContinuation m c
<*> :: forall a b.
WithNoContinuation m (a -> b)
-> WithNoContinuation m a -> WithNoContinuation m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
WithNoContinuation m (a -> b)
-> WithNoContinuation m a -> WithNoContinuation m b
pure :: forall a. a -> WithNoContinuation m a
$cpure :: forall (m :: * -> *) a.
Applicative m =>
a -> WithNoContinuation m a
Applicative, forall a. a -> WithNoContinuation m a
forall a b.
WithNoContinuation m a
-> WithNoContinuation m b -> WithNoContinuation m b
forall a b.
WithNoContinuation m a
-> (a -> WithNoContinuation m b) -> WithNoContinuation m b
forall {m :: * -> *}. Monad m => Applicative (WithNoContinuation m)
forall (m :: * -> *) a. Monad m => a -> WithNoContinuation m a
forall (m :: * -> *) a b.
Monad m =>
WithNoContinuation m a
-> WithNoContinuation m b -> WithNoContinuation m b
forall (m :: * -> *) a b.
Monad m =>
WithNoContinuation m a
-> (a -> WithNoContinuation m b) -> WithNoContinuation 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 -> WithNoContinuation m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> WithNoContinuation m a
>> :: forall a b.
WithNoContinuation m a
-> WithNoContinuation m b -> WithNoContinuation m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
WithNoContinuation m a
-> WithNoContinuation m b -> WithNoContinuation m b
>>= :: forall a b.
WithNoContinuation m a
-> (a -> WithNoContinuation m b) -> WithNoContinuation m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
WithNoContinuation m a
-> (a -> WithNoContinuation m b) -> WithNoContinuation m b
Monad)

instance (Monad m) ⇒ MonadWith (WithNoContinuation m) where
  type WithException (WithNoContinuation m) = Void
  stateThreadingGeneralWith :: forall releaseReturn b a.
GeneralAllocate
  (WithNoContinuation m)
  (WithException (WithNoContinuation m))
  releaseReturn
  b
  a
-> (a -> WithNoContinuation m b)
-> WithNoContinuation m (b, releaseReturn)
stateThreadingGeneralWith (GeneralAllocate (forall x. WithNoContinuation m x -> WithNoContinuation m x)
-> WithNoContinuation
     m
     (GeneralAllocated
        (WithNoContinuation m)
        (WithException (WithNoContinuation m))
        releaseReturn
        b
        a)
allocA) a -> WithNoContinuation m b
go = forall (m :: * -> *) a. m a -> WithNoContinuation m a
WithNoContinuation forall a b. (a -> b) -> a -> b
$ do
    let WithNoContinuation m (GeneralAllocated
     (WithNoContinuation m)
     (WithException (WithNoContinuation m))
     releaseReturn
     b
     a)
allocA' = (forall x. WithNoContinuation m x -> WithNoContinuation m x)
-> WithNoContinuation
     m
     (GeneralAllocated
        (WithNoContinuation m)
        (WithException (WithNoContinuation m))
        releaseReturn
        b
        a)
allocA forall a. a -> a
id
    GeneralAllocated a
a GeneralReleaseType Void b -> WithNoContinuation m releaseReturn
releaseA ← m (GeneralAllocated
     (WithNoContinuation m)
     (WithException (WithNoContinuation m))
     releaseReturn
     b
     a)
allocA'
    let WithNoContinuation m b
go' = a -> WithNoContinuation m b
go a
a
    b
b ← m b
go'
    let WithNoContinuation m releaseReturn
releaseA' = GeneralReleaseType Void b -> WithNoContinuation m releaseReturn
releaseA forall a b. (a -> b) -> a -> b
$ forall e a. a -> GeneralReleaseType e a
ReleaseSuccess b
b
    releaseReturn
c ← m releaseReturn
releaseA'
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (b
b, releaseReturn
c)

instance (Monad m) ⇒ MonadWithExceptable (WithNoContinuation m) where
  withExceptionToException :: WithException (WithNoContinuation m) -> SomeException
withExceptionToException = forall a. Void -> a
absurd

deriving via WithNoContinuation (ST s) instance MonadWith (ST s)

deriving via WithNoContinuation (ST s) instance MonadWithExceptable (ST s)

deriving via WithNoContinuation Identity instance MonadWith Identity

deriving via WithNoContinuation Identity instance MonadWithExceptable Identity

instance (MonadWith m) ⇒ MonadWith (ReaderT r m) where
  type WithException (ReaderT r m) = WithException m
  stateThreadingGeneralWith
    ∷ ∀ a b releaseReturn
     . GeneralAllocate (ReaderT r m) (WithException m) releaseReturn b a
    → (a → ReaderT r m b)
    → ReaderT r m (b, releaseReturn)
  stateThreadingGeneralWith :: forall a b releaseReturn.
GeneralAllocate (ReaderT r m) (WithException m) releaseReturn b a
-> (a -> ReaderT r m b) -> ReaderT r m (b, releaseReturn)
stateThreadingGeneralWith (GeneralAllocate (forall x. ReaderT r m x -> ReaderT r m x)
-> ReaderT
     r
     m
     (GeneralAllocated
        (ReaderT r m) (WithException m) releaseReturn b a)
allocA) a -> ReaderT r m b
go = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
r → do
    let
      allocA' ∷ (∀ x. m x → m x) → m (GeneralAllocated m (WithException m) releaseReturn b a)
      allocA' :: (forall x. m x -> m x)
-> m (GeneralAllocated m (WithException m) releaseReturn b a)
allocA' forall x. m x -> m x
restore = do
        let
          restore' ∷ ∀ x. ReaderT r m x → ReaderT r m x
          restore' :: forall x. ReaderT r m x -> ReaderT r m x
restore' ReaderT r m x
mx = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ forall x. m x -> m x
restore forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m x
mx
        GeneralAllocated a
a GeneralReleaseType (WithException m) b -> ReaderT r m releaseReturn
releaseA ← forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ((forall x. ReaderT r m x -> ReaderT r m x)
-> ReaderT
     r
     m
     (GeneralAllocated
        (ReaderT r m) (WithException m) releaseReturn b a)
allocA forall x. ReaderT r m x -> ReaderT r m x
restore') r
r
        let
          releaseA' :: GeneralReleaseType (WithException m) b -> m releaseReturn
releaseA' GeneralReleaseType (WithException m) b
relTy = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (GeneralReleaseType (WithException m) b -> ReaderT r m releaseReturn
releaseA GeneralReleaseType (WithException m) b
relTy) r
r
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e releaseReturn releaseArg a.
a
-> (GeneralReleaseType e releaseArg -> m releaseReturn)
-> GeneralAllocated m e releaseReturn releaseArg a
GeneralAllocated a
a GeneralReleaseType (WithException m) b -> m releaseReturn
releaseA'
    forall (m :: * -> *) releaseReturn b a.
MonadWith m =>
GeneralAllocate m (WithException m) releaseReturn b a
-> (a -> m b) -> m (b, releaseReturn)
stateThreadingGeneralWith (forall (m :: * -> *) e releaseReturn releaseArg a.
((forall x. m x -> m x)
 -> m (GeneralAllocated m e releaseReturn releaseArg a))
-> GeneralAllocate m e releaseReturn releaseArg a
GeneralAllocate (forall x. m x -> m x)
-> m (GeneralAllocated m (WithException m) releaseReturn b a)
allocA') (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT r
r forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ReaderT r m b
go)

instance (MonadWithExceptable m) ⇒ MonadWithExceptable (ReaderT r m) where
  withExceptionToException :: WithException (ReaderT r m) -> SomeException
withExceptionToException = forall (m :: * -> *).
MonadWithExceptable m =>
WithException m -> SomeException
withExceptionToException @m

instance (MonadWith m) ⇒ MonadWith (ResourceT m) where
  type WithException (ResourceT m) = WithException m
  stateThreadingGeneralWith
    ∷ ∀ a b releaseReturn
     . GeneralAllocate (ResourceT m) (WithException m) releaseReturn b a
    → (a → ResourceT m b)
    → ResourceT m (b, releaseReturn)
  stateThreadingGeneralWith :: forall a b releaseReturn.
GeneralAllocate (ResourceT m) (WithException m) releaseReturn b a
-> (a -> ResourceT m b) -> ResourceT m (b, releaseReturn)
stateThreadingGeneralWith (GeneralAllocate (forall x. ResourceT m x -> ResourceT m x)
-> ResourceT
     m
     (GeneralAllocated
        (ResourceT m) (WithException m) releaseReturn b a)
allocA) a -> ResourceT m b
go = forall (m :: * -> *) a. (IORef ReleaseMap -> m a) -> ResourceT m a
ResourceT forall a b. (a -> b) -> a -> b
$ \IORef ReleaseMap
st → do
    let
      allocA' ∷ (∀ x. m x → m x) → m (GeneralAllocated m (WithException m) releaseReturn b a)
      allocA' :: (forall x. m x -> m x)
-> m (GeneralAllocated m (WithException m) releaseReturn b a)
allocA' forall x. m x -> m x
restore = do
        let
          restore' ∷ ∀ x. ResourceT m x → ResourceT m x
          restore' :: forall x. ResourceT m x -> ResourceT m x
restore' ResourceT m x
mx = forall (m :: * -> *) a. (IORef ReleaseMap -> m a) -> ResourceT m a
ResourceT forall a b. (a -> b) -> a -> b
$ forall x. m x -> m x
restore forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. ResourceT m a -> IORef ReleaseMap -> m a
unResourceT ResourceT m x
mx
        GeneralAllocated a
a GeneralReleaseType (WithException m) b -> ResourceT m releaseReturn
releaseA ← forall (m :: * -> *) a. ResourceT m a -> IORef ReleaseMap -> m a
unResourceT ((forall x. ResourceT m x -> ResourceT m x)
-> ResourceT
     m
     (GeneralAllocated
        (ResourceT m) (WithException m) releaseReturn b a)
allocA forall x. ResourceT m x -> ResourceT m x
restore') IORef ReleaseMap
st
        let
          releaseA' :: GeneralReleaseType (WithException m) b -> m releaseReturn
releaseA' GeneralReleaseType (WithException m) b
relTy = forall (m :: * -> *) a. ResourceT m a -> IORef ReleaseMap -> m a
unResourceT (GeneralReleaseType (WithException m) b -> ResourceT m releaseReturn
releaseA GeneralReleaseType (WithException m) b
relTy) IORef ReleaseMap
st
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e releaseReturn releaseArg a.
a
-> (GeneralReleaseType e releaseArg -> m releaseReturn)
-> GeneralAllocated m e releaseReturn releaseArg a
GeneralAllocated a
a GeneralReleaseType (WithException m) b -> m releaseReturn
releaseA'
    forall (m :: * -> *) releaseReturn b a.
MonadWith m =>
GeneralAllocate m (WithException m) releaseReturn b a
-> (a -> m b) -> m (b, releaseReturn)
stateThreadingGeneralWith (forall (m :: * -> *) e releaseReturn releaseArg a.
((forall x. m x -> m x)
 -> m (GeneralAllocated m e releaseReturn releaseArg a))
-> GeneralAllocate m e releaseReturn releaseArg a
GeneralAllocate (forall x. m x -> m x)
-> m (GeneralAllocated m (WithException m) releaseReturn b a)
allocA') (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a. ResourceT m a -> IORef ReleaseMap -> m a
unResourceT IORef ReleaseMap
st forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ResourceT m b
go)

instance (MonadWithExceptable m) ⇒ MonadWithExceptable (ResourceT m) where
  withExceptionToException :: WithException (ResourceT m) -> SomeException
withExceptionToException = forall (m :: * -> *).
MonadWithExceptable m =>
WithException m -> SomeException
withExceptionToException @m

instance MonadWith (Either e) where
  type WithException (Either e) = e
  stateThreadingGeneralWith :: forall releaseReturn b a.
GeneralAllocate
  (Either e) (WithException (Either e)) releaseReturn b a
-> (a -> Either e b) -> Either e (b, releaseReturn)
stateThreadingGeneralWith (GeneralAllocate (forall x. Either e x -> Either e x)
-> Either
     e
     (GeneralAllocated
        (Either e) (WithException (Either e)) releaseReturn b a)
allocA) a -> Either e b
go = do
    GeneralAllocated a
a GeneralReleaseType e b -> Either e releaseReturn
releaseA ← (forall x. Either e x -> Either e x)
-> Either
     e
     (GeneralAllocated
        (Either e) (WithException (Either e)) releaseReturn b a)
allocA forall a. a -> a
id
    b
b ← case a -> Either e b
go a
a of
      Left e
e → do
        releaseReturn
_ ← GeneralReleaseType e b -> Either e releaseReturn
releaseA forall a b. (a -> b) -> a -> b
$ forall e a. e -> GeneralReleaseType e a
ReleaseFailure e
e
        forall a b. a -> Either a b
Left e
e
      Either e b
x → Either e b
x
    releaseReturn
c ← GeneralReleaseType e b -> Either e releaseReturn
releaseA forall a b. (a -> b) -> a -> b
$ forall e a. a -> GeneralReleaseType e a
ReleaseSuccess b
b
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (b
b, releaseReturn
c)

-- | An 'Exception' representing a failure in the 'Either' monad.
newtype EitherException e = EitherException e deriving stock (Int -> EitherException e -> ShowS
forall e. Show e => Int -> EitherException e -> ShowS
forall e. Show e => [EitherException e] -> ShowS
forall e. Show e => EitherException e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EitherException e] -> ShowS
$cshowList :: forall e. Show e => [EitherException e] -> ShowS
show :: EitherException e -> String
$cshow :: forall e. Show e => EitherException e -> String
showsPrec :: Int -> EitherException e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> EitherException e -> ShowS
Show)

instance (Show e, Typeable e) ⇒ Exception (EitherException e)

instance (Show e, Typeable e) ⇒ MonadWithExceptable (Either e) where
  withExceptionToException :: WithException (Either e) -> SomeException
withExceptionToException = forall e. Exception e => e -> SomeException
toException forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. e -> EitherException e
EitherException

instance MonadWith m ⇒ MonadWith (MaybeT m) where
  type WithException (MaybeT m) = Maybe (WithException m)
  stateThreadingGeneralWith
    ∷ ∀ a b releaseReturn
     . GeneralAllocate (MaybeT m) (Maybe (WithException m)) releaseReturn b a
    → (a → MaybeT m b)
    → MaybeT m (b, releaseReturn)
  stateThreadingGeneralWith :: forall a b releaseReturn.
GeneralAllocate
  (MaybeT m) (Maybe (WithException m)) releaseReturn b a
-> (a -> MaybeT m b) -> MaybeT m (b, releaseReturn)
stateThreadingGeneralWith (GeneralAllocate (forall x. MaybeT m x -> MaybeT m x)
-> MaybeT
     m
     (GeneralAllocated
        (MaybeT m) (Maybe (WithException m)) releaseReturn b a)
allocA) a -> MaybeT m b
go = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ do
    (Maybe b
mb, Maybe releaseReturn
mc) ← forall (m :: * -> *) releaseReturn b a.
MonadWith m =>
GeneralAllocate m (WithException m) releaseReturn b a
-> (a -> m b) -> m (b, releaseReturn)
stateThreadingGeneralWith (forall (m :: * -> *) e releaseReturn releaseArg a.
((forall x. m x -> m x)
 -> m (GeneralAllocated m e releaseReturn releaseArg a))
-> GeneralAllocate m e releaseReturn releaseArg a
GeneralAllocate (forall x. m x -> m x)
-> m (GeneralAllocated
        m (WithException m) (Maybe releaseReturn) (Maybe b) (Maybe a))
allocA') forall a b. (a -> b) -> a -> b
$ \case
      Just a
a → forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ a -> MaybeT m b
go a
a
      Maybe a
Nothing → forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe b
mb forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe releaseReturn
mc
   where
    allocA' ∷ (∀ x. m x → m x) → m (GeneralAllocated m (WithException m) (Maybe releaseReturn) (Maybe b) (Maybe a))
    allocA' :: (forall x. m x -> m x)
-> m (GeneralAllocated
        m (WithException m) (Maybe releaseReturn) (Maybe b) (Maybe a))
allocA' forall x. m x -> m x
restore =
      forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT ((forall x. MaybeT m x -> MaybeT m x)
-> MaybeT
     m
     (GeneralAllocated
        (MaybeT m) (Maybe (WithException m)) releaseReturn b a)
allocA forall x. MaybeT m x -> MaybeT m x
restore') forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
        Just (GeneralAllocated a
a GeneralReleaseType (Maybe (WithException m)) b
-> MaybeT m releaseReturn
releaseA) → forall (m :: * -> *) e releaseReturn releaseArg a.
a
-> (GeneralReleaseType e releaseArg -> m releaseReturn)
-> GeneralAllocated m e releaseReturn releaseArg a
GeneralAllocated (forall a. a -> Maybe a
Just a
a) forall a b. (a -> b) -> a -> b
$ \case
          ReleaseSuccess (Just b
b) → forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. GeneralReleaseType (Maybe (WithException m)) b
-> MaybeT m releaseReturn
releaseA forall a b. (a -> b) -> a -> b
$ forall e a. a -> GeneralReleaseType e a
ReleaseSuccess b
b
          ReleaseFailure WithException m
e → forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. GeneralReleaseType (Maybe (WithException m)) b
-> MaybeT m releaseReturn
releaseA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. e -> GeneralReleaseType e a
ReleaseFailure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just WithException m
e
          GeneralReleaseType (WithException m) (Maybe b)
_ → forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. GeneralReleaseType (Maybe (WithException m)) b
-> MaybeT m releaseReturn
releaseA forall a b. (a -> b) -> a -> b
$ forall e a. e -> GeneralReleaseType e a
ReleaseFailure forall a. Maybe a
Nothing
        Maybe
  (GeneralAllocated
     (MaybeT m) (Maybe (WithException m)) releaseReturn b a)
Nothing → forall (m :: * -> *) e releaseReturn releaseArg a.
a
-> (GeneralReleaseType e releaseArg -> m releaseReturn)
-> GeneralAllocated m e releaseReturn releaseArg a
GeneralAllocated forall a. Maybe a
Nothing (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing)
     where
      restore' ∷ ∀ x. MaybeT m x → MaybeT m x
      restore' :: forall x. MaybeT m x -> MaybeT m x
restore' = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. m x -> m x
restore forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT

-- | An 'Exception' representing the 'Nothing' case in a 'MaybeT' monad.
data NothingException = NothingException deriving (Int -> NothingException -> ShowS
[NothingException] -> ShowS
NothingException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NothingException] -> ShowS
$cshowList :: [NothingException] -> ShowS
show :: NothingException -> String
$cshow :: NothingException -> String
showsPrec :: Int -> NothingException -> ShowS
$cshowsPrec :: Int -> NothingException -> ShowS
Show)

instance Exception NothingException

instance MonadWithExceptable m ⇒ MonadWithExceptable (MaybeT m) where
  withExceptionToException :: WithException (MaybeT m) -> SomeException
withExceptionToException (Just WithException m
e) = forall (m :: * -> *).
MonadWithExceptable m =>
WithException m -> SomeException
withExceptionToException @m WithException m
e
  withExceptionToException Maybe (WithException m)
WithException (MaybeT m)
Nothing = forall e. Exception e => e -> SomeException
toException NothingException
NothingException

instance MonadWith m ⇒ MonadWith (ExceptT e m) where
  type WithException (ExceptT e m) = Either e (WithException m)
  stateThreadingGeneralWith
    ∷ ∀ a b releaseReturn
     . GeneralAllocate (ExceptT e m) (Either e (WithException m)) releaseReturn b a
    → (a → ExceptT e m b)
    → ExceptT e m (b, releaseReturn)
  stateThreadingGeneralWith :: forall a b releaseReturn.
GeneralAllocate
  (ExceptT e m) (Either e (WithException m)) releaseReturn b a
-> (a -> ExceptT e m b) -> ExceptT e m (b, releaseReturn)
stateThreadingGeneralWith (GeneralAllocate (forall x. ExceptT e m x -> ExceptT e m x)
-> ExceptT
     e
     m
     (GeneralAllocated
        (ExceptT e m) (Either e (WithException m)) releaseReturn b a)
allocA) a -> ExceptT e m b
go = 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 releaseReturn
ec) ← forall (m :: * -> *) releaseReturn b a.
MonadWith m =>
GeneralAllocate m (WithException m) releaseReturn b a
-> (a -> m b) -> m (b, releaseReturn)
stateThreadingGeneralWith (forall (m :: * -> *) e releaseReturn releaseArg a.
((forall x. m x -> m x)
 -> m (GeneralAllocated m e releaseReturn releaseArg a))
-> GeneralAllocate m e releaseReturn releaseArg a
GeneralAllocate (forall x. m x -> m x)
-> m (GeneralAllocated
        m
        (WithException m)
        (Either e releaseReturn)
        (Either e b)
        (Either e a))
allocA') forall a b. (a -> b) -> a -> b
$ \case
      Left e
e → forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left e
e
      Right a
a → forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ a -> ExceptT e m b
go a
a
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ do
      releaseReturn
c ← Either e releaseReturn
ec
      b
b ← Either e b
eb
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (b
b, releaseReturn
c)
   where
    allocA' ∷ (∀ x. m x → m x) → m (GeneralAllocated m (WithException m) (Either e releaseReturn) (Either e b) (Either e a))
    allocA' :: (forall x. m x -> m x)
-> m (GeneralAllocated
        m
        (WithException m)
        (Either e releaseReturn)
        (Either e b)
        (Either e a))
allocA' forall x. m x -> m x
restore =
      forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ((forall x. ExceptT e m x -> ExceptT e m x)
-> ExceptT
     e
     m
     (GeneralAllocated
        (ExceptT e m) (Either e (WithException m)) releaseReturn b a)
allocA forall x. ExceptT e m x -> ExceptT e m x
restore') forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
        Right (GeneralAllocated a
a GeneralReleaseType (Either e (WithException m)) b
-> ExceptT e m releaseReturn
releaseA) → forall (m :: * -> *) e releaseReturn releaseArg a.
a
-> (GeneralReleaseType e releaseArg -> m releaseReturn)
-> GeneralAllocated m e releaseReturn releaseArg a
GeneralAllocated (forall a b. b -> Either a b
Right a
a) forall a b. (a -> b) -> a -> b
$ \case
          ReleaseSuccess (Right b
b) → forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. GeneralReleaseType (Either e (WithException m)) b
-> ExceptT e m releaseReturn
releaseA forall a b. (a -> b) -> a -> b
$ forall e a. a -> GeneralReleaseType e a
ReleaseSuccess b
b
          ReleaseSuccess (Left e
e) → forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. GeneralReleaseType (Either e (WithException m)) b
-> ExceptT e m releaseReturn
releaseA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. e -> GeneralReleaseType e a
ReleaseFailure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left e
e
          ReleaseFailure WithException m
e → forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. GeneralReleaseType (Either e (WithException m)) b
-> ExceptT e m releaseReturn
releaseA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. e -> GeneralReleaseType e a
ReleaseFailure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right WithException m
e
        Left e
e → forall (m :: * -> *) e releaseReturn releaseArg a.
a
-> (GeneralReleaseType e releaseArg -> m releaseReturn)
-> GeneralAllocated m e releaseReturn releaseArg a
GeneralAllocated (forall a b. a -> Either a b
Left e
e) (forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left e
e)
     where
      restore' ∷ ∀ x. ExceptT e m x → ExceptT e m x
      restore' :: forall x. ExceptT e m x -> ExceptT e m x
restore' = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. m x -> m x
restore forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT

instance (Show e, Typeable e, MonadWithExceptable m) ⇒ MonadWithExceptable (ExceptT e m) where
  withExceptionToException :: WithException (ExceptT e m) -> SomeException
withExceptionToException (Right WithException m
e) = forall (m :: * -> *).
MonadWithExceptable m =>
WithException m -> SomeException
withExceptionToException @m WithException m
e
  withExceptionToException (Left e
e) = forall e. Exception e => e -> SomeException
toException forall a b. (a -> b) -> a -> b
$ forall e. e -> EitherException e
EitherException e
e

instance MonadWith m ⇒ MonadWith (IdentityT m) where
  type WithException (IdentityT m) = WithException m
  stateThreadingGeneralWith
    ∷ ∀ a b releaseReturn
     . GeneralAllocate (IdentityT m) (WithException m) releaseReturn b a
    → (a → IdentityT m b)
    → IdentityT m (b, releaseReturn)
  stateThreadingGeneralWith :: forall a b releaseReturn.
GeneralAllocate (IdentityT m) (WithException m) releaseReturn b a
-> (a -> IdentityT m b) -> IdentityT m (b, releaseReturn)
stateThreadingGeneralWith (GeneralAllocate (forall x. IdentityT m x -> IdentityT m x)
-> IdentityT
     m
     (GeneralAllocated
        (IdentityT m) (WithException m) releaseReturn b a)
allocA) a -> IdentityT m b
go = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *) releaseReturn b a.
MonadWith m =>
GeneralAllocate m (WithException m) releaseReturn b a
-> (a -> m b) -> m (b, releaseReturn)
stateThreadingGeneralWith (forall (m :: * -> *) e releaseReturn releaseArg a.
((forall x. m x -> m x)
 -> m (GeneralAllocated m e releaseReturn releaseArg a))
-> GeneralAllocate m e releaseReturn releaseArg a
GeneralAllocate (forall x. m x -> m x)
-> m (GeneralAllocated m (WithException m) releaseReturn b a)
allocA') forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IdentityT m b
go
   where
    allocA' ∷ (∀ x. m x → m x) → m (GeneralAllocated m (WithException m) releaseReturn b a)
    allocA' :: (forall x. m x -> m x)
-> m (GeneralAllocated m (WithException m) releaseReturn b a)
allocA' forall x. m x -> m x
restore =
      forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT ((forall x. IdentityT m x -> IdentityT m x)
-> IdentityT
     m
     (GeneralAllocated
        (IdentityT m) (WithException m) releaseReturn b a)
allocA forall x. IdentityT m x -> IdentityT m x
restore') forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
        GeneralAllocated a
a GeneralReleaseType (WithException m) b -> IdentityT m releaseReturn
releaseA → forall (m :: * -> *) e releaseReturn releaseArg a.
a
-> (GeneralReleaseType e releaseArg -> m releaseReturn)
-> GeneralAllocated m e releaseReturn releaseArg a
GeneralAllocated a
a forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT forall b c a. (b -> c) -> (a -> b) -> a -> c
. GeneralReleaseType (WithException m) b -> IdentityT m releaseReturn
releaseA
     where
      restore' ∷ ∀ x. IdentityT m x → IdentityT m x
      restore' :: forall x. IdentityT m x -> IdentityT m x
restore' = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. m x -> m x
restore forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT

instance MonadWithExceptable m ⇒ MonadWithExceptable (IdentityT m) where
  withExceptionToException :: WithException (IdentityT m) -> SomeException
withExceptionToException = forall (m :: * -> *).
MonadWithExceptable m =>
WithException m -> SomeException
withExceptionToException @m

instance MonadWith m ⇒ MonadWith (L.StateT s m) where
  type WithException (L.StateT s m) = (WithException m, s)
  stateThreadingGeneralWith
    ∷ ∀ a b releaseReturn
     . GeneralAllocate (L.StateT s m) (WithException m, s) releaseReturn b a
    → (a → L.StateT s m b)
    → L.StateT s m (b, releaseReturn)
  stateThreadingGeneralWith :: forall a b releaseReturn.
GeneralAllocate (StateT s m) (WithException m, s) releaseReturn b a
-> (a -> StateT s m b) -> StateT s m (b, releaseReturn)
stateThreadingGeneralWith (GeneralAllocate (forall x. StateT s m x -> StateT s m x)
-> StateT
     s
     m
     (GeneralAllocated
        (StateT s m) (WithException m, s) releaseReturn b a)
allocA) a -> StateT s m b
go = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
L.StateT forall a b. (a -> b) -> a -> b
$ \s
s0 → do
    let allocA' ∷ (∀ x. m x → m x) → m (GeneralAllocated m (WithException m) (releaseReturn, s) (b, s) (a, s))
        allocA' :: (forall x. m x -> m x)
-> m (GeneralAllocated
        m (WithException m) (releaseReturn, s) (b, s) (a, s))
allocA' forall x. m x -> m x
restore =
          forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
L.runStateT ((forall x. StateT s m x -> StateT s m x)
-> StateT
     s
     m
     (GeneralAllocated
        (StateT s m) (WithException m, s) releaseReturn b a)
allocA forall x. StateT s m x -> StateT s m x
restore') s
s0 forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
            (GeneralAllocated a
a GeneralReleaseType (WithException m, s) b
-> StateT s m releaseReturn
releaseA, s
s1) → forall (m :: * -> *) e releaseReturn releaseArg a.
a
-> (GeneralReleaseType e releaseArg -> m releaseReturn)
-> GeneralAllocated m e releaseReturn releaseArg a
GeneralAllocated (a
a, s
s1) forall a b. (a -> b) -> a -> b
$ \case
              ReleaseSuccess (b
b, s
s2) → forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
L.runStateT (GeneralReleaseType (WithException m, s) b
-> StateT s m releaseReturn
releaseA forall a b. (a -> b) -> a -> b
$ forall e a. a -> GeneralReleaseType e a
ReleaseSuccess b
b) s
s2
              ReleaseFailure WithException m
e → forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
L.runStateT (GeneralReleaseType (WithException m, s) b
-> StateT s m releaseReturn
releaseA forall a b. (a -> b) -> a -> b
$ forall e a. e -> GeneralReleaseType e a
ReleaseFailure (WithException m
e, s
s1)) s
s1
         where
          restore' ∷ ∀ x. L.StateT s m x → L.StateT s m x
          restore' :: forall x. StateT s m x -> StateT s m x
restore' StateT s m x
mx = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
L.StateT forall a b. (a -> b) -> a -> b
$ forall x. m x -> m x
restore forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
L.runStateT StateT s m x
mx
    ((b
b, s
_s2), (releaseReturn
c, s
s3)) ← forall (m :: * -> *) releaseReturn b a.
MonadWith m =>
GeneralAllocate m (WithException m) releaseReturn b a
-> (a -> m b) -> m (b, releaseReturn)
stateThreadingGeneralWith (forall (m :: * -> *) e releaseReturn releaseArg a.
((forall x. m x -> m x)
 -> m (GeneralAllocated m e releaseReturn releaseArg a))
-> GeneralAllocate m e releaseReturn releaseArg a
GeneralAllocate (forall x. m x -> m x)
-> m (GeneralAllocated
        m (WithException m) (releaseReturn, s) (b, s) (a, s))
allocA') forall a b. (a -> b) -> a -> b
$ \case
      (a
a, s
s1) → forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
L.runStateT (a -> StateT s m b
go a
a) s
s1
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ((b
b, releaseReturn
c), s
s3)

instance (MonadWithExceptable m) ⇒ MonadWithExceptable (L.StateT s m) where
  withExceptionToException :: WithException (StateT s m) -> SomeException
withExceptionToException (WithException m
e, s
_) = forall (m :: * -> *).
MonadWithExceptable m =>
WithException m -> SomeException
withExceptionToException @m WithException m
e

instance MonadWith m ⇒ MonadWith (StateT s m) where
  type WithException (StateT s m) = (WithException m, s)
  stateThreadingGeneralWith
    ∷ ∀ a b releaseReturn
     . GeneralAllocate (StateT s m) (WithException m, s) releaseReturn b a
    → (a → StateT s m b)
    → StateT s m (b, releaseReturn)
  stateThreadingGeneralWith :: forall a b releaseReturn.
GeneralAllocate (StateT s m) (WithException m, s) releaseReturn b a
-> (a -> StateT s m b) -> StateT s m (b, releaseReturn)
stateThreadingGeneralWith (GeneralAllocate (forall x. StateT s m x -> StateT s m x)
-> StateT
     s
     m
     (GeneralAllocated
        (StateT s m) (WithException m, s) releaseReturn b a)
allocA) a -> StateT s m b
go = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \s
s0 → do
    let allocA' ∷ (∀ x. m x → m x) → m (GeneralAllocated m (WithException m) (releaseReturn, s) (b, s) (a, s))
        allocA' :: (forall x. m x -> m x)
-> m (GeneralAllocated
        m (WithException m) (releaseReturn, s) (b, s) (a, s))
allocA' forall x. m x -> m x
restore =
          forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT ((forall x. StateT s m x -> StateT s m x)
-> StateT
     s
     m
     (GeneralAllocated
        (StateT s m) (WithException m, s) releaseReturn b a)
allocA forall x. StateT s m x -> StateT s m x
restore') s
s0 forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
            (GeneralAllocated a
a GeneralReleaseType (WithException m, s) b
-> StateT s m releaseReturn
releaseA, s
s1) → forall (m :: * -> *) e releaseReturn releaseArg a.
a
-> (GeneralReleaseType e releaseArg -> m releaseReturn)
-> GeneralAllocated m e releaseReturn releaseArg a
GeneralAllocated (a
a, s
s1) forall a b. (a -> b) -> a -> b
$ \case
              ReleaseSuccess (b
b, s
s2) → forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (GeneralReleaseType (WithException m, s) b
-> StateT s m releaseReturn
releaseA forall a b. (a -> b) -> a -> b
$ forall e a. a -> GeneralReleaseType e a
ReleaseSuccess b
b) s
s2
              ReleaseFailure WithException m
e → forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (GeneralReleaseType (WithException m, s) b
-> StateT s m releaseReturn
releaseA forall a b. (a -> b) -> a -> b
$ forall e a. e -> GeneralReleaseType e a
ReleaseFailure (WithException m
e, s
s1)) s
s1
         where
          restore' ∷ ∀ x. StateT s m x → StateT s m x
          restore' :: forall x. StateT s m x -> StateT s m x
restore' StateT s m x
mx = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ forall x. m x -> m x
restore forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT s m x
mx
    ((b
b, s
_s2), (releaseReturn
c, s
s3)) ← forall (m :: * -> *) releaseReturn b a.
MonadWith m =>
GeneralAllocate m (WithException m) releaseReturn b a
-> (a -> m b) -> m (b, releaseReturn)
stateThreadingGeneralWith (forall (m :: * -> *) e releaseReturn releaseArg a.
((forall x. m x -> m x)
 -> m (GeneralAllocated m e releaseReturn releaseArg a))
-> GeneralAllocate m e releaseReturn releaseArg a
GeneralAllocate (forall x. m x -> m x)
-> m (GeneralAllocated
        m (WithException m) (releaseReturn, s) (b, s) (a, s))
allocA') forall a b. (a -> b) -> a -> b
$ \case
      (a
a, s
s1) → forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (a -> StateT s m b
go a
a) s
s1
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ((b
b, releaseReturn
c), s
s3)

instance (MonadWithExceptable m) ⇒ MonadWithExceptable (StateT s m) where
  withExceptionToException :: WithException (StateT s m) -> SomeException
withExceptionToException (WithException m
e, s
_) = forall (m :: * -> *).
MonadWithExceptable m =>
WithException m -> SomeException
withExceptionToException @m WithException m
e

instance (MonadWith m, Monoid w) ⇒ MonadWith (L.WriterT w m) where
  type WithException (L.WriterT w m) = (WithException m, w)
  stateThreadingGeneralWith
    ∷ ∀ a b releaseReturn
     . GeneralAllocate (L.WriterT w m) (WithException m, w) releaseReturn b a
    → (a → L.WriterT w m b)
    → L.WriterT w m (b, releaseReturn)
  stateThreadingGeneralWith :: forall a b releaseReturn.
GeneralAllocate
  (WriterT w m) (WithException m, w) releaseReturn b a
-> (a -> WriterT w m b) -> WriterT w m (b, releaseReturn)
stateThreadingGeneralWith (GeneralAllocate (forall x. WriterT w m x -> WriterT w m x)
-> WriterT
     w
     m
     (GeneralAllocated
        (WriterT w m) (WithException m, w) releaseReturn b a)
allocA) a -> WriterT w m b
go = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
L.WriterT forall a b. (a -> b) -> a -> b
$ do
    let allocA' ∷ (∀ x. m x → m x) → m (GeneralAllocated m (WithException m) (releaseReturn, w) (b, w) (a, w))
        allocA' :: (forall x. m x -> m x)
-> m (GeneralAllocated
        m (WithException m) (releaseReturn, w) (b, w) (a, w))
allocA' forall x. m x -> m x
restore =
          forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
L.runWriterT ((forall x. WriterT w m x -> WriterT w m x)
-> WriterT
     w
     m
     (GeneralAllocated
        (WriterT w m) (WithException m, w) releaseReturn b a)
allocA forall x. WriterT w m x -> WriterT w m x
restore') forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
            (GeneralAllocated a
a GeneralReleaseType (WithException m, w) b
-> WriterT w m releaseReturn
releaseA, w
w0) → forall (m :: * -> *) e releaseReturn releaseArg a.
a
-> (GeneralReleaseType e releaseArg -> m releaseReturn)
-> GeneralAllocated m e releaseReturn releaseArg a
GeneralAllocated (a
a, w
w0) forall a b. (a -> b) -> a -> b
$ \case
              ReleaseSuccess (b
b, w
w1) → do
                (releaseReturn
c, w
w2) ← forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
L.runWriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. GeneralReleaseType (WithException m, w) b
-> WriterT w m releaseReturn
releaseA forall a b. (a -> b) -> a -> b
$ forall e a. a -> GeneralReleaseType e a
ReleaseSuccess b
b
                forall (f :: * -> *) a. Applicative f => a -> f a
pure (releaseReturn
c, w
w1 forall a. Semigroup a => a -> a -> a
<> w
w2)
              ReleaseFailure WithException m
e → do
                (releaseReturn
c, w
w1) ← forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
L.runWriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. GeneralReleaseType (WithException m, w) b
-> WriterT w m releaseReturn
releaseA forall a b. (a -> b) -> a -> b
$ forall e a. e -> GeneralReleaseType e a
ReleaseFailure (WithException m
e, w
w0)
                forall (f :: * -> *) a. Applicative f => a -> f a
pure (releaseReturn
c, w
w0 forall a. Semigroup a => a -> a -> a
<> w
w1)
         where
          restore' ∷ ∀ x. L.WriterT w m x → L.WriterT w m x
          restore' :: forall x. WriterT w m x -> WriterT w m x
restore' = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
L.WriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. m x -> m x
restore forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
L.runWriterT
    ((b
b, w
_w1), (releaseReturn
c, w
w2)) ← forall (m :: * -> *) releaseReturn b a.
MonadWith m =>
GeneralAllocate m (WithException m) releaseReturn b a
-> (a -> m b) -> m (b, releaseReturn)
stateThreadingGeneralWith (forall (m :: * -> *) e releaseReturn releaseArg a.
((forall x. m x -> m x)
 -> m (GeneralAllocated m e releaseReturn releaseArg a))
-> GeneralAllocate m e releaseReturn releaseArg a
GeneralAllocate (forall x. m x -> m x)
-> m (GeneralAllocated
        m (WithException m) (releaseReturn, w) (b, w) (a, w))
allocA') forall a b. (a -> b) -> a -> b
$ \case
      (a
a, w
w0) → do
        (b
b, w
w1) ← forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
L.runWriterT forall a b. (a -> b) -> a -> b
$ a -> WriterT w m b
go a
a
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (b
b, w
w0 forall a. Semigroup a => a -> a -> a
<> w
w1)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ((b
b, releaseReturn
c), w
w2)

instance (MonadWithExceptable m, Monoid w) ⇒ MonadWithExceptable (L.WriterT w m) where
  withExceptionToException :: WithException (WriterT w m) -> SomeException
withExceptionToException (WithException m
e, w
_) = forall (m :: * -> *).
MonadWithExceptable m =>
WithException m -> SomeException
withExceptionToException @m WithException m
e

instance (MonadWith m, Monoid w) ⇒ MonadWith (WriterT w m) where
  type WithException (WriterT w m) = (WithException m, w)
  stateThreadingGeneralWith
    ∷ ∀ a b releaseReturn
     . GeneralAllocate (WriterT w m) (WithException m, w) releaseReturn b a
    → (a → WriterT w m b)
    → WriterT w m (b, releaseReturn)
  stateThreadingGeneralWith :: forall a b releaseReturn.
GeneralAllocate
  (WriterT w m) (WithException m, w) releaseReturn b a
-> (a -> WriterT w m b) -> WriterT w m (b, releaseReturn)
stateThreadingGeneralWith (GeneralAllocate (forall x. WriterT w m x -> WriterT w m x)
-> WriterT
     w
     m
     (GeneralAllocated
        (WriterT w m) (WithException m, w) releaseReturn b a)
allocA) a -> WriterT w m b
go = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT forall a b. (a -> b) -> a -> b
$ do
    let allocA' ∷ (∀ x. m x → m x) → m (GeneralAllocated m (WithException m) (releaseReturn, w) (b, w) (a, w))
        allocA' :: (forall x. m x -> m x)
-> m (GeneralAllocated
        m (WithException m) (releaseReturn, w) (b, w) (a, w))
allocA' forall x. m x -> m x
restore =
          forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT ((forall x. WriterT w m x -> WriterT w m x)
-> WriterT
     w
     m
     (GeneralAllocated
        (WriterT w m) (WithException m, w) releaseReturn b a)
allocA forall x. WriterT w m x -> WriterT w m x
restore') forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
            (GeneralAllocated a
a GeneralReleaseType (WithException m, w) b
-> WriterT w m releaseReturn
releaseA, w
w0) → forall (m :: * -> *) e releaseReturn releaseArg a.
a
-> (GeneralReleaseType e releaseArg -> m releaseReturn)
-> GeneralAllocated m e releaseReturn releaseArg a
GeneralAllocated (a
a, w
w0) forall a b. (a -> b) -> a -> b
$ \case
              ReleaseSuccess (b
b, w
w1) → do
                (releaseReturn
c, w
w2) ← forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. GeneralReleaseType (WithException m, w) b
-> WriterT w m releaseReturn
releaseA forall a b. (a -> b) -> a -> b
$ forall e a. a -> GeneralReleaseType e a
ReleaseSuccess b
b
                forall (f :: * -> *) a. Applicative f => a -> f a
pure (releaseReturn
c, w
w1 forall a. Semigroup a => a -> a -> a
<> w
w2)
              ReleaseFailure WithException m
e → do
                (releaseReturn
c, w
w1) ← forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. GeneralReleaseType (WithException m, w) b
-> WriterT w m releaseReturn
releaseA forall a b. (a -> b) -> a -> b
$ forall e a. e -> GeneralReleaseType e a
ReleaseFailure (WithException m
e, w
w0)
                forall (f :: * -> *) a. Applicative f => a -> f a
pure (releaseReturn
c, w
w0 forall a. Semigroup a => a -> a -> a
<> w
w1)
         where
          restore' ∷ ∀ x. WriterT w m x → WriterT w m x
          restore' :: forall x. WriterT w m x -> WriterT w m x
restore' = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. m x -> m x
restore forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT
    ((b
b, w
_w1), (releaseReturn
c, w
w2)) ← forall (m :: * -> *) releaseReturn b a.
MonadWith m =>
GeneralAllocate m (WithException m) releaseReturn b a
-> (a -> m b) -> m (b, releaseReturn)
stateThreadingGeneralWith (forall (m :: * -> *) e releaseReturn releaseArg a.
((forall x. m x -> m x)
 -> m (GeneralAllocated m e releaseReturn releaseArg a))
-> GeneralAllocate m e releaseReturn releaseArg a
GeneralAllocate (forall x. m x -> m x)
-> m (GeneralAllocated
        m (WithException m) (releaseReturn, w) (b, w) (a, w))
allocA') forall a b. (a -> b) -> a -> b
$ \case
      (a
a, w
w0) → do
        (b
b, w
w1) ← forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT forall a b. (a -> b) -> a -> b
$ a -> WriterT w m b
go a
a
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (b
b, w
w0 forall a. Semigroup a => a -> a -> a
<> w
w1)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ((b
b, releaseReturn
c), w
w2)

instance (MonadWithExceptable m, Monoid w) ⇒ MonadWithExceptable (WriterT w m) where
  withExceptionToException :: WithException (WriterT w m) -> SomeException
withExceptionToException (WithException m
e, w
_) = forall (m :: * -> *).
MonadWithExceptable m =>
WithException m -> SomeException
withExceptionToException @m WithException m
e

instance (MonadWith m, Monoid w) ⇒ MonadWith (L.RWST r w s m) where
  type WithException (L.RWST r w s m) = (WithException m, s, w)
  stateThreadingGeneralWith
    ∷ ∀ a b releaseReturn
     . GeneralAllocate (L.RWST r w s m) (WithException m, s, w) releaseReturn b a
    → (a → L.RWST r w s m b)
    → L.RWST r w s m (b, releaseReturn)
  stateThreadingGeneralWith :: forall a b releaseReturn.
GeneralAllocate
  (RWST r w s m) (WithException m, s, w) releaseReturn b a
-> (a -> RWST r w s m b) -> RWST r w s m (b, releaseReturn)
stateThreadingGeneralWith (GeneralAllocate (forall x. RWST r w s m x -> RWST r w s m x)
-> RWST
     r
     w
     s
     m
     (GeneralAllocated
        (RWST r w s m) (WithException m, s, w) releaseReturn b a)
allocA) a -> RWST r w s m b
go = 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
s0 → do
    let allocA' ∷ (∀ x. m x → m x) → m (GeneralAllocated m (WithException m) (releaseReturn, s, w) (b, s, w) (a, s, w))
        allocA' :: (forall x. m x -> m x)
-> m (GeneralAllocated
        m (WithException m) (releaseReturn, s, w) (b, s, w) (a, s, w))
allocA' forall x. m x -> m x
restore =
          forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
L.runRWST ((forall x. RWST r w s m x -> RWST r w s m x)
-> RWST
     r
     w
     s
     m
     (GeneralAllocated
        (RWST r w s m) (WithException m, s, w) releaseReturn b a)
allocA forall x. RWST r w s m x -> RWST r w s m x
restore') r
r s
s0 forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
            (GeneralAllocated a
a GeneralReleaseType (WithException m, s, w) b
-> RWST r w s m releaseReturn
releaseA, s
s1, w
w0) → forall (m :: * -> *) e releaseReturn releaseArg a.
a
-> (GeneralReleaseType e releaseArg -> m releaseReturn)
-> GeneralAllocated m e releaseReturn releaseArg a
GeneralAllocated (a
a, s
s1, w
w0) forall a b. (a -> b) -> a -> b
$ \case
              ReleaseSuccess (b
b, s
s2, w
w1) → do
                (releaseReturn
c, s
s3, w
w2) ← forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
L.runRWST (GeneralReleaseType (WithException m, s, w) b
-> RWST r w s m releaseReturn
releaseA forall a b. (a -> b) -> a -> b
$ forall e a. a -> GeneralReleaseType e a
ReleaseSuccess b
b) r
r s
s2
                forall (f :: * -> *) a. Applicative f => a -> f a
pure (releaseReturn
c, s
s3, w
w1 forall a. Semigroup a => a -> a -> a
<> w
w2)
              ReleaseFailure WithException m
e → do
                (releaseReturn
c, s
s2, w
w1) ← forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
L.runRWST (GeneralReleaseType (WithException m, s, w) b
-> RWST r w s m releaseReturn
releaseA forall a b. (a -> b) -> a -> b
$ forall e a. e -> GeneralReleaseType e a
ReleaseFailure (WithException m
e, s
s1, w
w0)) r
r s
s1
                forall (f :: * -> *) a. Applicative f => a -> f a
pure (releaseReturn
c, s
s2, w
w0 forall a. Semigroup a => a -> a -> a
<> w
w1)
         where
          restore' ∷ ∀ x. L.RWST r w s m x → L.RWST r w s m x
          restore' :: forall x. RWST r w s m x -> RWST r w s m x
restore' RWST r w s m x
mx = 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' → forall x. m x -> m x
restore forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 x
mx r
r'
    ((b
b, s
_s2, w
_w1), (releaseReturn
c, s
s3, w
w2)) ← forall (m :: * -> *) releaseReturn b a.
MonadWith m =>
GeneralAllocate m (WithException m) releaseReturn b a
-> (a -> m b) -> m (b, releaseReturn)
stateThreadingGeneralWith (forall (m :: * -> *) e releaseReturn releaseArg a.
((forall x. m x -> m x)
 -> m (GeneralAllocated m e releaseReturn releaseArg a))
-> GeneralAllocate m e releaseReturn releaseArg a
GeneralAllocate (forall x. m x -> m x)
-> m (GeneralAllocated
        m (WithException m) (releaseReturn, s, w) (b, s, w) (a, s, w))
allocA') forall a b. (a -> b) -> a -> b
$ \case
      (a
a, s
s1, w
w0) → do
        (b
b, s
s2, w
w1) ← forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
L.runRWST (a -> RWST r w s m b
go a
a) r
r s
s1
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (b
b, s
s2, w
w0 forall a. Semigroup a => a -> a -> a
<> w
w1)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ((b
b, releaseReturn
c), s
s3, w
w2)

instance (MonadWithExceptable m, Monoid w) ⇒ MonadWithExceptable (L.RWST r w s m) where
  withExceptionToException :: WithException (RWST r w s m) -> SomeException
withExceptionToException (WithException m
e, s
_, w
_) = forall (m :: * -> *).
MonadWithExceptable m =>
WithException m -> SomeException
withExceptionToException @m WithException m
e

instance (MonadWith m, Monoid w) ⇒ MonadWith (RWST r w s m) where
  type WithException (RWST r w s m) = (WithException m, s, w)
  stateThreadingGeneralWith
    ∷ ∀ a b releaseReturn
     . GeneralAllocate (RWST r w s m) (WithException m, s, w) releaseReturn b a
    → (a → RWST r w s m b)
    → RWST r w s m (b, releaseReturn)
  stateThreadingGeneralWith :: forall a b releaseReturn.
GeneralAllocate
  (RWST r w s m) (WithException m, s, w) releaseReturn b a
-> (a -> RWST r w s m b) -> RWST r w s m (b, releaseReturn)
stateThreadingGeneralWith (GeneralAllocate (forall x. RWST r w s m x -> RWST r w s m x)
-> RWST
     r
     w
     s
     m
     (GeneralAllocated
        (RWST r w s m) (WithException m, s, w) releaseReturn b a)
allocA) a -> RWST r w s m b
go = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWST forall a b. (a -> b) -> a -> b
$ \r
r s
s0 → do
    let allocA' ∷ (∀ x. m x → m x) → m (GeneralAllocated m (WithException m) (releaseReturn, s, w) (b, s, w) (a, s, w))
        allocA' :: (forall x. m x -> m x)
-> m (GeneralAllocated
        m (WithException m) (releaseReturn, s, w) (b, s, w) (a, s, w))
allocA' forall x. m x -> m x
restore =
          forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST ((forall x. RWST r w s m x -> RWST r w s m x)
-> RWST
     r
     w
     s
     m
     (GeneralAllocated
        (RWST r w s m) (WithException m, s, w) releaseReturn b a)
allocA forall x. RWST r w s m x -> RWST r w s m x
restore') r
r s
s0 forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
            (GeneralAllocated a
a GeneralReleaseType (WithException m, s, w) b
-> RWST r w s m releaseReturn
releaseA, s
s1, w
w0) → forall (m :: * -> *) e releaseReturn releaseArg a.
a
-> (GeneralReleaseType e releaseArg -> m releaseReturn)
-> GeneralAllocated m e releaseReturn releaseArg a
GeneralAllocated (a
a, s
s1, w
w0) forall a b. (a -> b) -> a -> b
$ \case
              ReleaseSuccess (b
b, s
s2, w
w1) → do
                (releaseReturn
c, s
s3, w
w2) ← forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST (GeneralReleaseType (WithException m, s, w) b
-> RWST r w s m releaseReturn
releaseA forall a b. (a -> b) -> a -> b
$ forall e a. a -> GeneralReleaseType e a
ReleaseSuccess b
b) r
r s
s2
                forall (f :: * -> *) a. Applicative f => a -> f a
pure (releaseReturn
c, s
s3, w
w1 forall a. Semigroup a => a -> a -> a
<> w
w2)
              ReleaseFailure WithException m
e → do
                (releaseReturn
c, s
s2, w
w1) ← forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST (GeneralReleaseType (WithException m, s, w) b
-> RWST r w s m releaseReturn
releaseA forall a b. (a -> b) -> a -> b
$ forall e a. e -> GeneralReleaseType e a
ReleaseFailure (WithException m
e, s
s1, w
w0)) r
r s
s1
                forall (f :: * -> *) a. Applicative f => a -> f a
pure (releaseReturn
c, s
s2, w
w0 forall a. Semigroup a => a -> a -> a
<> w
w1)
         where
          restore' ∷ ∀ x. RWST r w s m x → RWST r w s m x
          restore' :: forall x. RWST r w s m x -> RWST r w s m x
restore' RWST r w s m x
mx = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWST forall a b. (a -> b) -> a -> b
$ \r
r' → forall x. m x -> m x
restore forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST RWST r w s m x
mx r
r'
    ((b
b, s
_s2, w
_w1), (releaseReturn
c, s
s3, w
w2)) ← forall (m :: * -> *) releaseReturn b a.
MonadWith m =>
GeneralAllocate m (WithException m) releaseReturn b a
-> (a -> m b) -> m (b, releaseReturn)
stateThreadingGeneralWith (forall (m :: * -> *) e releaseReturn releaseArg a.
((forall x. m x -> m x)
 -> m (GeneralAllocated m e releaseReturn releaseArg a))
-> GeneralAllocate m e releaseReturn releaseArg a
GeneralAllocate (forall x. m x -> m x)
-> m (GeneralAllocated
        m (WithException m) (releaseReturn, s, w) (b, s, w) (a, s, w))
allocA') forall a b. (a -> b) -> a -> b
$ \case
      (a
a, s
s1, w
w0) → do
        (b
b, s
s2, w
w1) ← forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST (a -> RWST r w s m b
go a
a) r
r s
s1
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (b
b, s
s2, w
w0 forall a. Semigroup a => a -> a -> a
<> w
w1)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ((b
b, releaseReturn
c), s
s3, w
w2)

instance (MonadWithExceptable m, Monoid w) ⇒ MonadWithExceptable (RWST r w s m) where
  withExceptionToException :: WithException (RWST r w s m) -> SomeException
withExceptionToException (WithException m
e, s
_, w
_) = forall (m :: * -> *).
MonadWithExceptable m =>
WithException m -> SomeException
withExceptionToException @m WithException m
e