From 4b1e31f1abb896dca8d981565ba76378d2488bb1 Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Sun, 2 Jan 2022 01:47:30 +0100
Subject: [PATCH] Add helper functions for ResourceManagerSTM
---
src/Quasar/ResourceManager.hs | 13 +++++++++++++
1 file changed, 13 insertions(+)
diff --git a/src/Quasar/ResourceManager.hs b/src/Quasar/ResourceManager.hs
index 07e8057..63c643d 100644
--- a/src/Quasar/ResourceManager.hs
+++ b/src/Quasar/ResourceManager.hs
@@ -12,12 +12,14 @@ module Quasar.ResourceManager (
registerAsyncDisposeAction,
withScopedResourceManager,
onResourceManager,
+ onResourceManagerSTM,
captureDisposable,
captureDisposable_,
disposeOnError,
liftResourceManagerIO,
runInResourceManagerSTM,
enterResourceManager,
+ enterResourceManagerSTM,
lockResourceManager,
-- ** Top level initialization
@@ -219,6 +221,9 @@ instance {-# OVERLAPS #-} MonadResourceManager (ResourceManagerT STM) where
onResourceManager :: (IsResourceManager a, MonadIO m) => a -> ResourceManagerIO r -> m r
onResourceManager target action = liftIO $ runReaderT action (toResourceManager target)
+onResourceManagerSTM :: (IsResourceManager a) => a -> ResourceManagerSTM r -> STM r
+onResourceManagerSTM target action = runReaderT action (toResourceManager target)
+
liftResourceManagerIO :: (MonadResourceManager m, MonadIO m) => ResourceManagerIO r -> m r
liftResourceManagerIO action = do
resourceManager <- askResourceManager
@@ -254,6 +259,14 @@ enterResourceManager resourceManager action = liftIO do
onResourceManager resourceManager $ lockResourceManager do
action `catchAll` \ex -> liftIO $ throwToResourceManager resourceManager ex
+-- | Run a computation on a resource manager and throw any exception that occurs to the resource manager.
+--
+-- This can be used to run e.g. callbacks that belong to a different resource context.
+enterResourceManagerSTM :: ResourceManager -> ResourceManagerSTM () -> STM ()
+enterResourceManagerSTM resourceManager action = do
+ onResourceManagerSTM resourceManager do
+ action `catchAll` \ex -> throwToResourceManager ex
+
-- * Resource manager implementations
--
GitLab