From 9e5b3c2b4a4ff58738f0d5e5c8b4ee84758c8f5c Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Sun, 22 Aug 2021 23:11:25 +0200
Subject: [PATCH] Change resource manager api (for awaitable disposables)
---
src/Quasar/Core.hs | 18 +++++++++---------
src/Quasar/Observable.hs | 30 ++++++++++++++++--------------
2 files changed, 25 insertions(+), 23 deletions(-)
diff --git a/src/Quasar/Core.hs b/src/Quasar/Core.hs
index 08646c8..99d0892 100644
--- a/src/Quasar/Core.hs
+++ b/src/Quasar/Core.hs
@@ -33,7 +33,7 @@ module Quasar.Core (
synchronousDisposable,
noDisposable,
disposeEventually,
- boundDisposable,
+ attachDisposable,
attachDisposeAction,
attachDisposeAction_,
) where
@@ -283,8 +283,8 @@ instance IsDisposable EmptyDisposable where
-newDisposable :: IO (Awaitable ()) -> IO Disposable
-newDisposable = fmap (toDisposable . FnDisposable) . newTMVarIO . Left
+newDisposable :: MonadIO m => IO (Awaitable ()) -> m Disposable
+newDisposable = liftIO . fmap (toDisposable . FnDisposable) . newTMVarIO . Left
synchronousDisposable :: IO () -> IO Disposable
synchronousDisposable = newDisposable . fmap pure . liftIO
@@ -303,15 +303,15 @@ disposeEventually _resourceManager disposable = liftIO $ do
Just (Right ()) -> pure ()
Nothing -> undefined -- TODO register on resourceManager
--- | Creates an `Disposable` that is bound to a ResourceManager. It will automatically be disposed when the resource manager is disposed.
-boundDisposable :: HasResourceManager m => IO (Awaitable ()) -> m Disposable
-boundDisposable action = do
- resourceManager <- askResourceManager
- attachDisposeAction resourceManager action
+attachDisposable :: (IsDisposable a, MonadIO m) => ResourceManager -> a -> m ()
+attachDisposable _resourceManager disposable = undefined
-- | 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 undefined
+attachDisposeAction resourceManager action = do
+ disposable <- newDisposable action
+ attachDisposable resourceManager disposable
+ pure disposable
-- | Attaches a dispose action to a ResourceManager. It will automatically be run when the resource manager is disposed.
attachDisposeAction_ :: MonadIO m => ResourceManager -> IO (Awaitable ()) -> m ()
diff --git a/src/Quasar/Observable.hs b/src/Quasar/Observable.hs
index bd2eb26..d4e8d81 100644
--- a/src/Quasar/Observable.hs
+++ b/src/Quasar/Observable.hs
@@ -81,24 +81,26 @@ class IsRetrievable v o => IsObservable v o | o -> v where
-- | Observe until the callback returns `False`. The callback will also be unsubscribed when the `ResourceManager` is disposed.
observeWhile :: (IsObservable v o, HasResourceManager m) => o -> (ObservableMessage v -> IO Bool) -> m Disposable
observeWhile observable callback = do
- disposeVar <- liftIO $ newTVarIO False
+ --disposeVar <- liftIO $ newTVarIO False
- innerDisposable <- liftIO $ observe observable \msg -> do
- disposeRequested <- readTVarIO disposeVar
- unless disposeRequested do
- continue <- callback msg
- unless continue $ atomically $ writeTVar disposeVar True
+ --innerDisposable <- liftIO $ observe observable \msg -> do
+ -- disposeRequested <- readTVarIO disposeVar
+ -- unless disposeRequested do
+ -- continue <- callback msg
+ -- unless continue $ atomically $ writeTVar disposeVar True
- -- Bind the disposable to the ResourceManager, to prevent leaks if the `async` is disposed
- disposable <- boundDisposable $ dispose innerDisposable
+ ---- Bind the disposable to the ResourceManager, to prevent leaks if the `async` is disposed
+ --disposable <- boundDisposable $ dispose innerDisposable
- task <- async do
- liftIO $ atomically do
- disposeRequested <- readTVar disposeVar
- unless disposeRequested retry
- liftIO $ dispose disposable
+ --task <- async do
+ -- liftIO $ atomically do
+ -- disposeRequested <- readTVar disposeVar
+ -- unless disposeRequested retry
+ -- liftIO $ dispose disposable
- pure (disposable <> (toDisposable task))
+ --pure (disposable <> (toDisposable task))
+
+ undefined -- TODO reimplement after ResouceManager API is changed
-- | Observe until the callback returns `False`. The callback will also be unsubscribed when the `ResourceManager` is disposed.
--
GitLab