{-# LANGUAGE BlockArguments #-}
{-# 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
{ 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 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
PropagationStrategy
-> Maybe (WithRes m res) -> (Store (WithRes m res) -> m a) -> m a
forall (m :: * -> *) ctx a.
(MonadIO m, MonadMask m) =>
PropagationStrategy -> Maybe ctx -> (Store ctx -> m a) -> m a
Context.withStore PropagationStrategy
Context.noPropagation (WithRes m res -> Maybe (WithRes m res)
forall a. a -> Maybe a
Just ((forall r. (res -> m r) -> m r) -> WithRes m res
forall (m :: * -> *) res.
(forall r. (res -> m r) -> m r) -> WithRes m res
WithRes forall r. (res -> m r) -> m r
withRes)) \Store (WithRes m res)
store -> do
Provider m res -> m a
f Provider :: forall (m :: * -> *) res. Store (WithRes m res) -> Provider m res
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 :: 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 <- Store (WithRes m res) -> m (WithRes m res)
forall (m :: * -> *) ctx.
(MonadIO m, MonadThrow m) =>
Store ctx -> m ctx
Context.mine Store (WithRes m res)
store
(res -> m a) -> m a
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 :: 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
Store (WithRes m res) -> WithRes m res -> m a -> m a
forall (m :: * -> *) ctx a.
(MonadIO m, MonadMask m) =>
Store ctx -> ctx -> m a -> m a
Context.use Store (WithRes m res)
store ((forall r. (res -> m r) -> m r) -> WithRes m res
forall (m :: * -> *) res.
(forall r. (res -> m r) -> m r) -> WithRes m res
WithRes ((res -> m r) -> res -> m r
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 :: Provider m res -> (res -> m a) -> m a
withSharedResource Provider m res
provider res -> m a
f = do
Provider m res -> (res -> m a) -> m a
forall (m :: * -> *) res a.
(MonadIO m, MonadThrow m) =>
Provider m res -> (res -> m a) -> m a
withResource Provider m res
provider \res
resource -> do
Provider m res -> res -> m a -> m a
forall (m :: * -> *) res a.
(MonadIO m, MonadMask m) =>
Provider m res -> res -> m a -> m a
shareResource Provider m res
provider res
resource do
res -> m a
f res
resource