From 5b287e017749e69e3f049b14a597f8c7828beab1 Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Tue, 31 Aug 2021 20:58:57 +0200
Subject: [PATCH] Change disposeEventually to have MonadResourceManager
constraint
---
src/Quasar/Disposable.hs | 12 +++++++-----
src/Quasar/Observable.hs | 10 ++++++----
2 files changed, 13 insertions(+), 9 deletions(-)
diff --git a/src/Quasar/Disposable.hs b/src/Quasar/Disposable.hs
index aa2c6c8..8a4b1a2 100644
--- a/src/Quasar/Disposable.hs
+++ b/src/Quasar/Disposable.hs
@@ -406,15 +406,17 @@ attachDisposeAction resourceManager action = liftIO $ mask_ $ do
attachDisposeAction_ :: MonadIO m => ResourceManager -> IO (Awaitable ()) -> m ()
attachDisposeAction_ resourceManager action = void $ attachDisposeAction resourceManager action
--- | Start disposing a resource but instead of waiting for the operation to complete, pass the responsibility to a `ResourceManager`.
+-- | Start disposing a resource but instead of waiting for the operation to complete, pass the responsibility to a
+-- `MonadResourceManager`.
--
--- The synchronous part of the `dispose`-Function will be run immediately but the resulting `Awaitable` will be passed to the resource manager.
-disposeEventually :: (IsDisposable a, MonadIO m) => ResourceManager -> a -> m ()
-disposeEventually resourceManager disposable = liftIO $ do
+-- The synchronous part of the `dispose`-Function will be run immediately but the resulting `Awaitable` will be passed
+-- to the resource manager.
+disposeEventually :: (IsDisposable a, MonadResourceManager m) => a -> m ()
+disposeEventually disposable = do
disposeCompleted <- dispose disposable
peekAwaitable disposeCompleted >>= \case
Just () -> pure ()
- Nothing -> attachDisposable resourceManager disposable
+ Nothing -> registerDisposable disposable
diff --git a/src/Quasar/Observable.hs b/src/Quasar/Observable.hs
index ea1d06d..a002d51 100644
--- a/src/Quasar/Observable.hs
+++ b/src/Quasar/Observable.hs
@@ -249,8 +249,9 @@ instance IsObservable r (BindObservable r) where
oldDisposable <- takeTMVar disposableVar
-- IO action that will run after the STM transaction
- pure $ do
- disposeEventually resourceManager oldDisposable
+ pure do
+ onResourceManager resourceManager do
+ disposeEventually oldDisposable
disposable <-
unmask (outerMessageHandler key observableMessage)
@@ -316,8 +317,9 @@ instance IsObservable r (CatchObservable e r) where
oldDisposable <- takeTMVar disposableVar
-- IO action that will run after the STM transaction
- pure $ do
- disposeEventually resourceManager oldDisposable
+ pure do
+ onResourceManager resourceManager do
+ disposeEventually oldDisposable
disposable <-
unmask (outerMessageHandler key observableMessage)
--
GitLab