module Resource.Region
  ( run
  , exec
  , eval

  , local
  , local_

  , register_
  , attach
  , attachAsync

  , logDebug

  , ReleaseKey
  , ResourceT.release
  ) where

import RIO hiding (local, logDebug)

import Control.Monad.Trans.Resource (MonadResource, ResourceT, ReleaseKey)
import Control.Monad.Trans.Resource qualified as ResourceT
import GHC.Stack (withFrozenCallStack)
import RIO qualified

run :: MonadResource m => ResourceT m a -> m (ReleaseKey, a)
run :: forall (m :: * -> *) a.
MonadResource m =>
ResourceT m a -> m (ReleaseKey, a)
run ResourceT m a
action = do
  InternalState
regionResource <- m InternalState
forall (m :: * -> *). MonadIO m => m InternalState
ResourceT.createInternalState
  ReleaseKey
regionKey <- IO () -> m ReleaseKey
forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey
ResourceT.register (IO () -> m ReleaseKey) -> IO () -> m ReleaseKey
forall a b. (a -> b) -> a -> b
$ InternalState -> IO ()
forall (m :: * -> *). MonadIO m => InternalState -> m ()
ResourceT.closeInternalState InternalState
regionResource
  a
resource <- ResourceT m a -> InternalState -> m a
forall (m :: * -> *) a. ResourceT m a -> InternalState -> m a
ResourceT.runInternalState ResourceT m a
action InternalState
regionResource
  pure (ReleaseKey
regionKey, a
resource)

exec :: MonadResource m => ResourceT m a -> m ReleaseKey
exec :: forall (m :: * -> *) a.
MonadResource m =>
ResourceT m a -> m ReleaseKey
exec = ((ReleaseKey, a) -> ReleaseKey)
-> m (ReleaseKey, a) -> m ReleaseKey
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReleaseKey, a) -> ReleaseKey
forall a b. (a, b) -> a
fst (m (ReleaseKey, a) -> m ReleaseKey)
-> (ResourceT m a -> m (ReleaseKey, a))
-> ResourceT m a
-> m ReleaseKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceT m a -> m (ReleaseKey, a)
forall (m :: * -> *) a.
MonadResource m =>
ResourceT m a -> m (ReleaseKey, a)
run

eval :: MonadResource m => ResourceT m a -> m a
eval :: forall (m :: * -> *) a. MonadResource m => ResourceT m a -> m a
eval = ((ReleaseKey, a) -> a) -> m (ReleaseKey, a) -> m a
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReleaseKey, a) -> a
forall a b. (a, b) -> b
snd (m (ReleaseKey, a) -> m a)
-> (ResourceT m a -> m (ReleaseKey, a)) -> ResourceT m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceT m a -> m (ReleaseKey, a)
forall (m :: * -> *) a.
MonadResource m =>
ResourceT m a -> m (ReleaseKey, a)
run

local :: MonadResource m => m (ReleaseKey, a) -> ResourceT m a
local :: forall (m :: * -> *) a.
MonadResource m =>
m (ReleaseKey, a) -> ResourceT m a
local m (ReleaseKey, a)
action = do
  (ReleaseKey
key, a
resource) <- m (ReleaseKey, a) -> ResourceT m (ReleaseKey, a)
forall (m :: * -> *) a. Monad m => m a -> ResourceT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (ReleaseKey, a)
action
  IO () -> ResourceT m ReleaseKey
forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey
ResourceT.register (IO () -> ResourceT m ReleaseKey)
-> IO () -> ResourceT m ReleaseKey
forall a b. (a -> b) -> a -> b
$
    ReleaseKey -> IO ()
forall (m :: * -> *). MonadIO m => ReleaseKey -> m ()
ResourceT.release ReleaseKey
key
  pure a
resource

local_ :: MonadResource m => m ReleaseKey -> ResourceT m ()
local_ :: forall (m :: * -> *).
MonadResource m =>
m ReleaseKey -> ResourceT m ()
local_ m ReleaseKey
action = do
  ReleaseKey
key <- m ReleaseKey -> ResourceT m ReleaseKey
forall (m :: * -> *) a. Monad m => m a -> ResourceT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ReleaseKey
action
  ResourceT m ReleaseKey -> ResourceT m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ResourceT m ReleaseKey -> ResourceT m ())
-> (IO () -> ResourceT m ReleaseKey) -> IO () -> ResourceT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> ResourceT m ReleaseKey
forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey
ResourceT.register (IO () -> ResourceT m ()) -> IO () -> ResourceT m ()
forall a b. (a -> b) -> a -> b
$
    ReleaseKey -> IO ()
forall (m :: * -> *). MonadIO m => ReleaseKey -> m ()
ResourceT.release ReleaseKey
key

register_ :: MonadUnliftIO m => IO () -> ResourceT m ()
register_ :: forall (m :: * -> *). MonadUnliftIO m => IO () -> ResourceT m ()
register_ = ResourceT m ReleaseKey -> ResourceT m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ResourceT m ReleaseKey -> ResourceT m ())
-> (IO () -> ResourceT m ReleaseKey) -> IO () -> ResourceT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> ResourceT m ReleaseKey
forall (m :: * -> *). MonadResource m => IO () -> m ReleaseKey
ResourceT.register

attach :: MonadUnliftIO m => ReleaseKey -> ResourceT m ()
attach :: forall (m :: * -> *).
MonadUnliftIO m =>
ReleaseKey -> ResourceT m ()
attach = IO () -> ResourceT m ()
forall (m :: * -> *). MonadUnliftIO m => IO () -> ResourceT m ()
register_ (IO () -> ResourceT m ())
-> (ReleaseKey -> IO ()) -> ReleaseKey -> ResourceT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReleaseKey -> IO ()
forall (m :: * -> *). MonadIO m => ReleaseKey -> m ()
ResourceT.release

attachAsync :: MonadUnliftIO m => Async a -> ResourceT m ()
attachAsync :: forall (m :: * -> *) a.
MonadUnliftIO m =>
Async a -> ResourceT m ()
attachAsync = IO () -> ResourceT m ()
forall (m :: * -> *). MonadUnliftIO m => IO () -> ResourceT m ()
register_ (IO () -> ResourceT m ())
-> (Async a -> IO ()) -> Async a -> ResourceT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async a -> IO ()
forall (m :: * -> *) a. MonadIO m => Async a -> m ()
cancel

logDebug
  :: ( MonadUnliftIO m
     , MonadReader env m, HasLogFunc env
     , HasCallStack
     )
  => Utf8Builder
  -> Utf8Builder
  -> ResourceT m ()
logDebug :: forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasLogFunc env,
 HasCallStack) =>
Utf8Builder -> Utf8Builder -> ResourceT m ()
logDebug Utf8Builder
enter Utf8Builder
leave = (HasCallStack => ResourceT m ()) -> ResourceT m ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => ResourceT m ()) -> ResourceT m ())
-> (HasCallStack => ResourceT m ()) -> ResourceT m ()
forall a b. (a -> b) -> a -> b
$ do
  Utf8Builder -> ResourceT m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
RIO.logDebug Utf8Builder
enter
  ResourceT m () -> ResourceT m (IO ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (IO a)
toIO (Utf8Builder -> ResourceT m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
RIO.logDebug Utf8Builder
leave) ResourceT m (IO ()) -> (IO () -> ResourceT m ()) -> ResourceT m ()
forall a b. ResourceT m a -> (a -> ResourceT m b) -> ResourceT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> ResourceT m ()
forall (m :: * -> *). MonadUnliftIO m => IO () -> ResourceT m ()
register_