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

  -- * Registering and releasing resources
  , R.allocate
  , R.allocate_
  , R.register
  , R.release
  , R.unprotect
  ) where

import Control.Exception
import qualified Control.Monad.Trans.Resource as R
import qualified Control.Monad.Trans.Resource.Internal as RI

import Effectful.Internal.Env
import Effectful.Internal.Has
import Effectful.Internal.Monad

-- | Data tag for a resource effect.
newtype Resource = Resource R.InternalState

-- | Run the resource effect.
runResource :: Eff (Resource : es) a -> Eff es a
runResource :: Eff (Resource : es) a -> Eff es a
runResource (Eff Env (Resource : es) -> IO a
m) = (Env es -> IO a) -> Eff es a
forall (es :: [*]) a. (Env es -> IO a) -> Eff es a
impureEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Env es
es0 -> do
  Int
size0 <- Env es -> IO Int
forall (es :: [*]). Env es -> IO Int
sizeEnv Env es
es0
  InternalState
istate <- IO InternalState
forall (m :: * -> *). MonadIO m => m InternalState
R.createInternalState
  ((forall a. IO a -> IO a) -> IO a) -> IO a
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO a) -> IO a)
-> ((forall a. IO a -> IO a) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
    Env (Resource : es)
es <- Resource -> Env es -> IO (Env (Resource : es))
forall e (es :: [*]).
HasCallStack =>
e -> Env es -> IO (Env (e : es))
unsafeConsEnv (InternalState -> Resource
Resource InternalState
istate) Env es
es0
    a
a <- IO a -> IO a
forall a. IO a -> IO a
restore (Env (Resource : es) -> IO a
m Env (Resource : es)
es) IO a -> (SomeException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \SomeException
e -> do
      Env Any
_ <- Int -> Env (Resource : es) -> IO (Env Any)
forall (es :: [*]) (es0 :: [*]).
HasCallStack =>
Int -> Env es -> IO (Env es0)
unsafeTrimEnv Int
size0 Env (Resource : es)
es
      Maybe SomeException -> InternalState -> IO ()
RI.stateCleanupChecked (SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
e) InternalState
istate
      SomeException -> IO a
forall e a. Exception e => e -> IO a
throwIO SomeException
e
    Env Any
_ <- Int -> Env (Resource : es) -> IO (Env Any)
forall (es :: [*]) (es0 :: [*]).
HasCallStack =>
Int -> Env es -> IO (Env es0)
unsafeTrimEnv Int
size0 Env (Resource : es)
es
    Maybe SomeException -> InternalState -> IO ()
RI.stateCleanupChecked Maybe SomeException
forall a. Maybe a
Nothing InternalState
istate
    a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

instance (IOE :> es, Resource :> es) => R.MonadResource (Eff es) where
  liftResourceT :: ResourceT IO a -> Eff es a
liftResourceT (RI.ResourceT InternalState -> IO a
m) = (Env es -> IO a) -> Eff es a
forall (es :: [*]) a. (Env es -> IO a) -> Eff es a
impureEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Env es
es -> do
    Env es -> IO Resource
forall e (es :: [*]). (HasCallStack, e :> es) => Env es -> IO e
getEnv Env es
es IO Resource -> (Resource -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Resource InternalState
istate) -> InternalState -> IO a
m InternalState
istate