{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
-- | Resource management via 'R.MonadResource'.
module Effectful.Resource
  ( -- * Effect
    Resource

    -- ** Handlers
  , runResource

    -- * Registering and releasing resources
  , allocateEff
  , allocateEff_
  , registerEff
  , releaseEff
  , R.allocate
  , R.allocate_
  , R.register
  , R.release
  , R.unprotect
  , ReleaseAction(..)
  , unprotectEff

    -- * Internal state
  , R.InternalState
  , getInternalState
  , runInternalState
  , R.createInternalState
  , R.closeInternalState

    -- * Re-exports
  , 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

-- | Provide the ability to use the 'R.MonadResource' instance of 'Eff'.
data Resource :: Effect

type instance DispatchOf Resource = Static WithSideEffects
newtype instance StaticRep Resource = Resource R.InternalState

-- | Run the resource effect.
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

----------------------------------------
-- Registering and releasing resources

-- | A variant of 'R.allocate` adjusted to work in the 'Eff' monad.
--
-- /Note:/ the @release@ action will run a cloned environment, so any changes it
-- makes to thread local data will not be visible outside of it.
allocateEff
  :: Resource :> es
  => Eff es a -- ^ allocate
  -> (a -> Eff es ()) -- ^ free resource
  -> 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
    -- we need to clone original env for release action
    -- because it will be called when original env already unconsed
    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)

-- | A variant of 'R.allocate_' adjusted to work in the 'Eff' monad.
--
-- /Note:/ the @release@ action will run a cloned environment, so any changes it
-- makes to thread local data will not be visible outside of it.
allocateEff_
  :: Resource :> es
  => Eff es a -- ^ allocate
  -> Eff es () -- ^ free resource
  -> 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

-- | A variant of 'R.register' adjusted to work in the 'Eff' monad.
--
-- /Note:/ the @release@ action will run a cloned environment, so any changes it
-- makes to thread local data will not be visible outside of it.
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
    -- we need to clone original env for release action
    -- because it will be called when original env already unconsed
    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

-- | A variant of 'R.release' adjusted to work in the 'Eff' monad.
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

-- | Action for releasing a resource.
newtype ReleaseAction = ReleaseAction
  { ReleaseAction
-> forall (es :: [Effect]). (Resource :> es) => Eff es ()
runReleaseAction :: forall es. Resource :> es => Eff es ()
  }

-- | A variant of 'R.unprotect' adjusted to work in the 'Eff' monad.
--
-- /Note:/ if the resource was acquired using 'allocateEff', 'allocateEff_' or
-- 'registerEff' then the returned 'ReleaseAction' will run in a clone of the
-- environment it was registered in.
--
-- See the documentation of the aforementioned functions for more information.
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

----------------------------------------
-- Internal state

-- | Get the 'R.InternalState' of the current 'Resource' effect.
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

-- | Run the 'Resource' effect with existing 'R.InternalState'.
--
-- /Note:/ the 'R.InternalState' will not be closed at the end.
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)

----------------------------------------
-- Orphan instance

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