{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RankNTypes #-}
module Context.Resource
(
Provider
, withProvider
, withResource
, shareResource
, withSharedResource
) where
import Control.Monad.Catch (MonadMask, MonadThrow)
import Control.Monad.IO.Class (MonadIO)
import Prelude
import qualified Context
newtype Provider m res = Provider
{ forall (m :: * -> *) res. Provider m res -> Store (WithRes m res)
store :: Context.Store (WithRes m res)
}
newtype WithRes m res = WithRes (forall r. (res -> m r) -> m r)
withProvider
:: forall m res a
. (MonadIO m, MonadMask m)
=> (forall r. (res -> m r) -> m r)
-> (Provider m res -> m a)
-> m a
withProvider :: forall (m :: * -> *) res a.
(MonadIO m, MonadMask m) =>
(forall r. (res -> m r) -> m r) -> (Provider m res -> m a) -> m a
withProvider forall r. (res -> m r) -> m r
withRes Provider m res -> m a
f = do
forall (m :: * -> *) ctx a.
(MonadIO m, MonadMask m) =>
PropagationStrategy -> Maybe ctx -> (Store ctx -> m a) -> m a
Context.withStore PropagationStrategy
Context.noPropagation (forall a. a -> Maybe a
Just (forall (m :: * -> *) res.
(forall r. (res -> m r) -> m r) -> WithRes m res
WithRes forall r. (res -> m r) -> m r
withRes)) forall a b. (a -> b) -> a -> b
$ \Store (WithRes m res)
store -> do
Provider m res -> m a
f Provider { Store (WithRes m res)
store :: Store (WithRes m res)
store :: Store (WithRes m res)
store }
withResource
:: forall m res a
. (MonadIO m, MonadThrow m)
=> Provider m res
-> (res -> m a)
-> m a
withResource :: forall (m :: * -> *) res a.
(MonadIO m, MonadThrow m) =>
Provider m res -> (res -> m a) -> m a
withResource Provider { Store (WithRes m res)
store :: Store (WithRes m res)
store :: forall (m :: * -> *) res. Provider m res -> Store (WithRes m res)
store } res -> m a
f = do
WithRes forall r. (res -> m r) -> m r
withRes <- forall (m :: * -> *) ctx.
(MonadIO m, MonadThrow m) =>
Store ctx -> m ctx
Context.mine Store (WithRes m res)
store
forall r. (res -> m r) -> m r
withRes res -> m a
f
shareResource
:: forall m res a
. (MonadIO m, MonadMask m)
=> Provider m res
-> res
-> m a
-> m a
shareResource :: forall (m :: * -> *) res a.
(MonadIO m, MonadMask m) =>
Provider m res -> res -> m a -> m a
shareResource Provider { Store (WithRes m res)
store :: Store (WithRes m res)
store :: forall (m :: * -> *) res. Provider m res -> Store (WithRes m res)
store } res
resource m a
action = do
forall (m :: * -> *) ctx a.
(MonadIO m, MonadMask m) =>
Store ctx -> ctx -> m a -> m a
Context.use Store (WithRes m res)
store (forall (m :: * -> *) res.
(forall r. (res -> m r) -> m r) -> WithRes m res
WithRes (forall a b. (a -> b) -> a -> b
$ res
resource)) m a
action
withSharedResource
:: forall m res a
. (MonadIO m, MonadMask m)
=> Provider m res
-> (res -> m a)
-> m a
withSharedResource :: forall (m :: * -> *) res a.
(MonadIO m, MonadMask m) =>
Provider m res -> (res -> m a) -> m a
withSharedResource Provider m res
provider res -> m a
f = do
forall (m :: * -> *) res a.
(MonadIO m, MonadThrow m) =>
Provider m res -> (res -> m a) -> m a
withResource Provider m res
provider forall a b. (a -> b) -> a -> b
$ \res
resource -> do
forall (m :: * -> *) res a.
(MonadIO m, MonadMask m) =>
Provider m res -> res -> m a -> m a
shareResource Provider m res
provider res
resource forall a b. (a -> b) -> a -> b
$ do
res -> m a
f res
resource