{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnicodeSyntax #-}
module Data.GeneralAllocate where
import Control.Monad
import {-# SOURCE #-} Control.Monad.With
newtype GeneralAllocate m e releaseReturn releaseArg a
= GeneralAllocate ((∀ x. m x → m x) → m (GeneralAllocated m e releaseReturn releaseArg a))
data GeneralAllocated m e releaseReturn releaseArg a = GeneralAllocated
{ forall (m :: * -> *) e releaseReturn releaseArg a.
GeneralAllocated m e releaseReturn releaseArg a -> a
allocatedResource ∷ !a
, forall (m :: * -> *) e releaseReturn releaseArg a.
GeneralAllocated m e releaseReturn releaseArg a
-> GeneralReleaseType e releaseArg -> m releaseReturn
releaseAllocated ∷ !(GeneralReleaseType e releaseArg → m releaseReturn)
}
data GeneralReleaseType e a
=
ReleaseSuccess !a
|
ReleaseFailure !e
deriving stock ((forall a b.
(a -> b) -> GeneralReleaseType e a -> GeneralReleaseType e b)
-> (forall a b.
a -> GeneralReleaseType e b -> GeneralReleaseType e a)
-> Functor (GeneralReleaseType e)
forall a b. a -> GeneralReleaseType e b -> GeneralReleaseType e a
forall a b.
(a -> b) -> GeneralReleaseType e a -> GeneralReleaseType e b
forall e a b. a -> GeneralReleaseType e b -> GeneralReleaseType e a
forall e a b.
(a -> b) -> GeneralReleaseType e a -> GeneralReleaseType e b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall e a b.
(a -> b) -> GeneralReleaseType e a -> GeneralReleaseType e b
fmap :: forall a b.
(a -> b) -> GeneralReleaseType e a -> GeneralReleaseType e b
$c<$ :: forall e a b. a -> GeneralReleaseType e b -> GeneralReleaseType e a
<$ :: forall a b. a -> GeneralReleaseType e b -> GeneralReleaseType e a
Functor)
instance Functor (GeneralAllocated m e releaseReturn releaseArg) where
a -> b
f fmap :: forall a b.
(a -> b)
-> GeneralAllocated m e releaseReturn releaseArg a
-> GeneralAllocated m e releaseReturn releaseArg b
`fmap` (GeneralAllocated a
x GeneralReleaseType e releaseArg -> m releaseReturn
rel) = b
-> (GeneralReleaseType e releaseArg -> m releaseReturn)
-> GeneralAllocated m e releaseReturn releaseArg b
forall (m :: * -> *) e releaseReturn releaseArg a.
a
-> (GeneralReleaseType e releaseArg -> m releaseReturn)
-> GeneralAllocated m e releaseReturn releaseArg a
GeneralAllocated (a -> b
f a
x) GeneralReleaseType e releaseArg -> m releaseReturn
rel
instance (Functor m) ⇒ Functor (GeneralAllocate m e releaseReturn releaseArg) where
a -> b
f fmap :: forall a b.
(a -> b)
-> GeneralAllocate m e releaseReturn releaseArg a
-> GeneralAllocate m e releaseReturn releaseArg b
`fmap` (GeneralAllocate (forall x. m x -> m x)
-> m (GeneralAllocated m e releaseReturn releaseArg a)
alloc) = ((forall x. m x -> m x)
-> m (GeneralAllocated m e releaseReturn releaseArg b))
-> GeneralAllocate m e releaseReturn releaseArg b
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 e releaseReturn releaseArg b))
-> GeneralAllocate m e releaseReturn releaseArg b)
-> ((forall x. m x -> m x)
-> m (GeneralAllocated m e releaseReturn releaseArg b))
-> GeneralAllocate m e releaseReturn releaseArg b
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> m x
restore → (a -> b)
-> GeneralAllocated m e releaseReturn releaseArg a
-> GeneralAllocated m e releaseReturn releaseArg b
forall a b.
(a -> b)
-> GeneralAllocated m e releaseReturn releaseArg a
-> GeneralAllocated m e releaseReturn releaseArg b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (GeneralAllocated m e releaseReturn releaseArg a
-> GeneralAllocated m e releaseReturn releaseArg b)
-> m (GeneralAllocated m e releaseReturn releaseArg a)
-> m (GeneralAllocated m e releaseReturn releaseArg b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall x. m x -> m x)
-> m (GeneralAllocated m e releaseReturn releaseArg a)
alloc m x -> m x
forall x. m x -> m x
restore
instance (MonadWith m, Monoid releaseReturn, e ~ WithException m) ⇒ Applicative (GeneralAllocate m e releaseReturn releaseArg) where
pure :: forall a. a -> GeneralAllocate m e releaseReturn releaseArg a
pure a
a = ((forall x. m x -> m x)
-> m (GeneralAllocated m e releaseReturn releaseArg a))
-> GeneralAllocate m e releaseReturn releaseArg a
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 e releaseReturn releaseArg a))
-> GeneralAllocate m e releaseReturn releaseArg a)
-> ((forall x. m x -> m x)
-> m (GeneralAllocated m e releaseReturn releaseArg a))
-> GeneralAllocate m e releaseReturn releaseArg a
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> m x
_ → GeneralAllocated m e releaseReturn releaseArg a
-> m (GeneralAllocated m e releaseReturn releaseArg a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GeneralAllocated m e releaseReturn releaseArg a
-> m (GeneralAllocated m e releaseReturn releaseArg a))
-> (m releaseReturn
-> GeneralAllocated m e releaseReturn releaseArg a)
-> m releaseReturn
-> m (GeneralAllocated m e releaseReturn releaseArg a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a
-> (GeneralReleaseType e releaseArg -> m releaseReturn)
-> GeneralAllocated m e releaseReturn releaseArg a
forall (m :: * -> *) e releaseReturn releaseArg a.
a
-> (GeneralReleaseType e releaseArg -> m releaseReturn)
-> GeneralAllocated m e releaseReturn releaseArg a
GeneralAllocated a
a ((GeneralReleaseType e releaseArg -> m releaseReturn)
-> GeneralAllocated m e releaseReturn releaseArg a)
-> (m releaseReturn
-> GeneralReleaseType e releaseArg -> m releaseReturn)
-> m releaseReturn
-> GeneralAllocated m e releaseReturn releaseArg a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m releaseReturn
-> GeneralReleaseType e releaseArg -> m releaseReturn
forall a b. a -> b -> a
const (m releaseReturn
-> m (GeneralAllocated m e releaseReturn releaseArg a))
-> m releaseReturn
-> m (GeneralAllocated m e releaseReturn releaseArg a)
forall a b. (a -> b) -> a -> b
$ releaseReturn -> m releaseReturn
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure releaseReturn
forall a. Monoid a => a
mempty
<*> :: forall a b.
GeneralAllocate m e releaseReturn releaseArg (a -> b)
-> GeneralAllocate m e releaseReturn releaseArg a
-> GeneralAllocate m e releaseReturn releaseArg b
(<*>) = GeneralAllocate m e releaseReturn releaseArg (a -> b)
-> GeneralAllocate m e releaseReturn releaseArg a
-> GeneralAllocate m e releaseReturn releaseArg b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance (MonadWith m, Monoid releaseReturn, e ~ WithException m) ⇒ Monad (GeneralAllocate m e releaseReturn releaseArg) where
return :: forall a. a -> GeneralAllocate m e releaseReturn releaseArg a
return = a -> GeneralAllocate m e releaseReturn releaseArg a
forall a. a -> GeneralAllocate m e releaseReturn releaseArg a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(GeneralAllocate (forall x. m x -> m x)
-> m (GeneralAllocated m e releaseReturn releaseArg a)
allocX) >>= :: forall a b.
GeneralAllocate m e releaseReturn releaseArg a
-> (a -> GeneralAllocate m e releaseReturn releaseArg b)
-> GeneralAllocate m e releaseReturn releaseArg b
>>= a -> GeneralAllocate m e releaseReturn releaseArg b
f = ((forall x. m x -> m x)
-> m (GeneralAllocated m e releaseReturn releaseArg b))
-> GeneralAllocate m e releaseReturn releaseArg b
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 e releaseReturn releaseArg b))
-> GeneralAllocate m e releaseReturn releaseArg b)
-> ((forall x. m x -> m x)
-> m (GeneralAllocated m e releaseReturn releaseArg b))
-> GeneralAllocate m e releaseReturn releaseArg b
forall a b. (a -> b) -> a -> b
$ \forall x. m x -> m x
restore → do
GeneralAllocated a
x GeneralReleaseType e releaseArg -> m releaseReturn
releaseX ← (forall x. m x -> m x)
-> m (GeneralAllocated m e releaseReturn releaseArg a)
allocX m x -> m x
forall x. m x -> m x
restore
let GeneralAllocate (forall x. m x -> m x)
-> m (GeneralAllocated m e releaseReturn releaseArg b)
allocY = a -> GeneralAllocate m e releaseReturn releaseArg b
f a
x
GeneralAllocated b
y GeneralReleaseType e releaseArg -> m releaseReturn
releaseY ← (forall x. m x -> m x)
-> m (GeneralAllocated m e releaseReturn releaseArg b)
allocY m x -> m x
forall x. m x -> m x
restore m (GeneralAllocated m e releaseReturn releaseArg b)
-> (WithException m -> m releaseReturn)
-> m (GeneralAllocated m e releaseReturn releaseArg b)
forall (m :: * -> *) a b.
MonadWith m =>
m a -> (WithException m -> m b) -> m a
`onFailure` (GeneralReleaseType e releaseArg -> m releaseReturn
releaseX (GeneralReleaseType e releaseArg -> m releaseReturn)
-> (e -> GeneralReleaseType e releaseArg) -> e -> m releaseReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> GeneralReleaseType e releaseArg
forall e a. e -> GeneralReleaseType e a
ReleaseFailure)
GeneralAllocated m e releaseReturn releaseArg b
-> m (GeneralAllocated m e releaseReturn releaseArg b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GeneralAllocated m e releaseReturn releaseArg b
-> m (GeneralAllocated m e releaseReturn releaseArg b))
-> GeneralAllocated m e releaseReturn releaseArg b
-> m (GeneralAllocated m e releaseReturn releaseArg b)
forall a b. (a -> b) -> a -> b
$
b
-> (GeneralReleaseType e releaseArg -> m releaseReturn)
-> GeneralAllocated m e releaseReturn releaseArg b
forall (m :: * -> *) e releaseReturn releaseArg a.
a
-> (GeneralReleaseType e releaseArg -> m releaseReturn)
-> GeneralAllocated m e releaseReturn releaseArg a
GeneralAllocated b
y ((GeneralReleaseType e releaseArg -> m releaseReturn)
-> GeneralAllocated m e releaseReturn releaseArg b)
-> (GeneralReleaseType e releaseArg -> m releaseReturn)
-> GeneralAllocated m e releaseReturn releaseArg b
forall a b. (a -> b) -> a -> b
$ \GeneralReleaseType e releaseArg
relTy →
(releaseReturn -> releaseReturn -> releaseReturn)
-> (releaseReturn, releaseReturn) -> releaseReturn
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry releaseReturn -> releaseReturn -> releaseReturn
forall a. Semigroup a => a -> a -> a
(<>) ((releaseReturn, releaseReturn) -> releaseReturn)
-> m (releaseReturn, releaseReturn) -> m releaseReturn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m releaseReturn
-> m releaseReturn -> m (releaseReturn, releaseReturn)
forall (m :: * -> *) a b. MonadWith m => m a -> m b -> m (a, b)
generalFinally (GeneralReleaseType e releaseArg -> m releaseReturn
releaseY GeneralReleaseType e releaseArg
relTy) (GeneralReleaseType e releaseArg -> m releaseReturn
releaseX GeneralReleaseType e releaseArg
relTy)