From 7ff046219d3a3f3a58b1833e22d3366bcfd32599 Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Mon, 4 Oct 2021 15:11:13 +0200
Subject: [PATCH] Add registerNewResource to handle a diposed resource manager
Co-authored-by: Jan Beinke <git@janbeinke.com>
---
src/Quasar/ResourceManager.hs | 25 ++++++++++++++-----------
1 file changed, 14 insertions(+), 11 deletions(-)
diff --git a/src/Quasar/ResourceManager.hs b/src/Quasar/ResourceManager.hs
index 393bf17..38f4858 100644
--- a/src/Quasar/ResourceManager.hs
+++ b/src/Quasar/ResourceManager.hs
@@ -2,6 +2,7 @@ module Quasar.ResourceManager (
-- * MonadResourceManager
MonadResourceManager(..),
FailedToRegisterResource,
+ registerNewResource,
registerDisposable,
registerDisposeAction,
registerSimpleDisposeAction,
@@ -136,6 +137,12 @@ registerDisposeAction disposeAction = mask_ $ registerDisposable =<< newDisposab
registerSimpleDisposeAction :: MonadResourceManager m => IO () -> m ()
registerSimpleDisposeAction disposeAction = registerDisposeAction (pure () <$ disposeAction)
+registerNewResource :: (IsDisposable a, MonadResourceManager m) => m a -> m a
+registerNewResource action = mask_ do
+ afix \awaitable -> do
+ registerDisposeAction $ either (\(_ :: SomeException) -> mempty) dispose =<< try (await awaitable)
+ action
+
-- TODO rename to withResourceScope?
withSubResourceManagerM :: MonadResourceManager m => m a -> m a
@@ -278,20 +285,15 @@ instance IsResourceManager DefaultResourceManager where
entry <- newEntry disposable
join $ atomically do
+ disposing <- readTVar (disposingVar resourceManager)
disposed <- readTVar (disposedVar resourceManager)
- unless disposed $ modifyTVar (entriesVar resourceManager) (|> entry)
+ unless disposing $ modifyTVar (entriesVar resourceManager) (|> entry)
- disposing <- readTVar (disposingVar resourceManager)
-
- -- IO that is run after the STM transaction is completed
- pure $ (`catchAll` throwToResourceManager resourceManager) do
- if disposed
- then do
- traceIO "Attached a disposable to a disposed resource manager"
- await =<< dispose disposable
- else when disposing do
- void (dispose disposable)
+ pure do
+ -- IO that is run after the STM transaction is completed
+ when disposing $
+ throwM FailedToRegisterResource `catchAll` throwToResourceManager resourceManager
instance IsDisposable DefaultResourceManager where
dispose resourceManager = liftIO $ mask_ do
@@ -406,6 +408,7 @@ freeGarbage resourceManager = go
entriesVar' = entriesVar resourceManager
+
-- | Creates an `Disposable` that is bound to a ResourceManager. It will automatically be disposed when the resource manager is disposed.
attachDisposeAction :: MonadIO m => ResourceManager -> IO (Awaitable ()) -> m Disposable
attachDisposeAction resourceManager action = liftIO $ mask_ $ do
--
GitLab