{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Effectful.Resource
(
Resource
, runResource
, allocateEff
, allocateEff_
, registerEff
, releaseEff
, R.allocate
, R.allocate_
, R.register
, R.release
, R.unprotect
, ReleaseAction(..)
, unprotectEff
, R.InternalState
, getInternalState
, runInternalState
, R.createInternalState
, R.closeInternalState
, R.ReleaseKey
, R.ResourceCleanupException(..)
) where
import Control.Exception
import qualified Control.Monad.Trans.Resource as R
import qualified Control.Monad.Trans.Resource.Internal as RI
import Effectful
import Effectful.Dispatch.Static
import Effectful.Dispatch.Static.Primitive
data Resource :: Effect
type instance DispatchOf Resource = Static WithSideEffects
newtype instance StaticRep Resource = Resource R.InternalState
runResource :: IOE :> es => Eff (Resource : es) a -> Eff es a
runResource :: forall (es :: [Effect]) a.
(IOE :> es) =>
Eff (Resource : es) a -> Eff es a
runResource Eff (Resource : es) a
m = forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff forall a b. (a -> b) -> a -> b
$ \Env es
es0 -> do
InternalState
istate <- forall (m :: Type -> Type). MonadIO m => m InternalState
R.createInternalState
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
unmask -> do
Env (Resource : es)
es <- forall (e :: Effect) (es :: [Effect]).
EffectRep (DispatchOf e) e
-> Relinker (EffectRep (DispatchOf e)) e
-> Env es
-> IO (Env (e : es))
consEnv (InternalState -> StaticRep Resource
Resource InternalState
istate) forall (rep :: Effect -> Type) (e :: Effect). Relinker rep e
dummyRelinker Env es
es0
a
a <- forall a. IO a -> IO a
unmask (forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff Eff (Resource : es) a
m Env (Resource : es)
es) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \SomeException
e -> do
forall (e :: Effect) (es :: [Effect]). Env (e : es) -> IO ()
unconsEnv Env (Resource : es)
es
Maybe SomeException -> InternalState -> IO ()
RI.stateCleanupChecked (forall a. a -> Maybe a
Just SomeException
e) InternalState
istate
forall e a. Exception e => e -> IO a
throwIO SomeException
e
forall (e :: Effect) (es :: [Effect]). Env (e : es) -> IO ()
unconsEnv Env (Resource : es)
es
Maybe SomeException -> InternalState -> IO ()
RI.stateCleanupChecked forall a. Maybe a
Nothing InternalState
istate
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
a
allocateEff
:: Resource :> es
=> Eff es a
-> (a -> Eff es ())
-> Eff es (R.ReleaseKey, a)
allocateEff :: forall (es :: [Effect]) a.
(Resource :> es) =>
Eff es a -> (a -> Eff es ()) -> Eff es (ReleaseKey, a)
allocateEff Eff es a
acquire a -> Eff es ()
release = do
InternalState
istate <- forall (es :: [Effect]). (Resource :> es) => Eff es InternalState
getInternalState
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff forall a b. (a -> b) -> a -> b
$ \Env es
es0 -> forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$ do
a
a <- forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff Eff es a
acquire Env es
es0
Env es
es1 <- forall (es :: [Effect]). Env es -> IO (Env es)
cloneEnv Env es
es0
ReleaseKey
key <- InternalState -> IO () -> IO ReleaseKey
RI.register' InternalState
istate forall a b. (a -> b) -> a -> b
$ forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff (a -> Eff es ()
release a
a) Env es
es1
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (ReleaseKey
key, a
a)
allocateEff_
:: Resource :> es
=> Eff es a
-> Eff es ()
-> Eff es R.ReleaseKey
allocateEff_ :: forall (es :: [Effect]) a.
(Resource :> es) =>
Eff es a -> Eff es () -> Eff es ReleaseKey
allocateEff_ Eff es a
a = forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (es :: [Effect]) a.
(Resource :> es) =>
Eff es a -> (a -> Eff es ()) -> Eff es (ReleaseKey, a)
allocateEff Eff es a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
registerEff :: Resource :> es => Eff es () -> Eff es R.ReleaseKey
registerEff :: forall (es :: [Effect]).
(Resource :> es) =>
Eff es () -> Eff es ReleaseKey
registerEff Eff es ()
release = do
InternalState
istate <- forall (es :: [Effect]). (Resource :> es) => Eff es InternalState
getInternalState
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff forall a b. (a -> b) -> a -> b
$ \Env es
es0 -> do
Env es
es1 <- forall (es :: [Effect]). Env es -> IO (Env es)
cloneEnv Env es
es0
InternalState -> IO () -> IO ReleaseKey
RI.register' InternalState
istate forall a b. (a -> b) -> a -> b
$ forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff Eff es ()
release Env es
es1
releaseEff :: Resource :> es => R.ReleaseKey -> Eff es ()
releaseEff :: forall (es :: [Effect]).
(Resource :> es) =>
ReleaseKey -> Eff es ()
releaseEff = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: Type -> Type). MonadIO m => ReleaseKey -> m ()
R.release
newtype ReleaseAction = ReleaseAction
{ ReleaseAction
-> forall (es :: [Effect]). (Resource :> es) => Eff es ()
runReleaseAction :: forall es. Resource :> es => Eff es ()
}
unprotectEff :: Resource :> es => R.ReleaseKey -> Eff es (Maybe ReleaseAction)
unprotectEff :: forall (es :: [Effect]).
(Resource :> es) =>
ReleaseKey -> Eff es (Maybe ReleaseAction)
unprotectEff ReleaseKey
key = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall a b. (a -> b) -> a -> b
$ do
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\IO ()
m -> (forall (es :: [Effect]). (Resource :> es) => Eff es ())
-> ReleaseAction
ReleaseAction forall a b. (a -> b) -> a -> b
$ forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ IO ()
m) forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: Type -> Type).
MonadIO m =>
ReleaseKey -> m (Maybe (IO ()))
R.unprotect ReleaseKey
key
getInternalState :: Resource :> es => Eff es R.InternalState
getInternalState :: forall (es :: [Effect]). (Resource :> es) => Eff es InternalState
getInternalState = do
Resource InternalState
istate <- forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect]).
(DispatchOf e ~ 'Static sideEffects, e :> es) =>
Eff es (StaticRep e)
getStaticRep
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure InternalState
istate
runInternalState :: IOE :> es => R.InternalState -> Eff (Resource : es) a -> Eff es a
runInternalState :: forall (es :: [Effect]) a.
(IOE :> es) =>
InternalState -> Eff (Resource : es) a -> Eff es a
runInternalState InternalState
istate = forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect])
a.
(DispatchOf e ~ 'Static sideEffects, MaybeIOE sideEffects es) =>
StaticRep e -> Eff (e : es) a -> Eff es a
evalStaticRep (InternalState -> StaticRep Resource
Resource InternalState
istate)
instance (IOE :> es, Resource :> es) => R.MonadResource (Eff es) where
liftResourceT :: forall a. ResourceT IO a -> Eff es a
liftResourceT (RI.ResourceT InternalState -> IO a
m) = forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff forall a b. (a -> b) -> a -> b
$ \Env es
es -> do
forall (e :: Effect) (es :: [Effect]).
(e :> es) =>
Env es -> IO (EffectRep (DispatchOf e) e)
getEnv Env es
es forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Resource InternalState
istate) -> InternalState -> IO a
m InternalState
istate