From c7bcce3769c08bbf3275e8826da9071412cf937a Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Sun, 5 Sep 2021 04:27:58 +0200
Subject: [PATCH] Move ResourceManager to Quasar.ResourceManager

---
 quasar.cabal                  |   1 +
 src/Quasar/Async.hs           |   1 +
 src/Quasar/Disposable.hs      | 296 --------------------------------
 src/Quasar/Observable.hs      |   2 +-
 src/Quasar/ResourceManager.hs | 308 ++++++++++++++++++++++++++++++++++
 src/Quasar/Timer.hs           |   1 +
 test/Quasar/AsyncSpec.hs      |   1 +
 test/Quasar/DisposableSpec.hs |   1 +
 test/Quasar/ObservableSpec.hs |   1 +
 9 files changed, 315 insertions(+), 297 deletions(-)
 create mode 100644 src/Quasar/ResourceManager.hs

diff --git a/quasar.cabal b/quasar.cabal
index 83c4f01..333903e 100644
--- a/quasar.cabal
+++ b/quasar.cabal
@@ -92,6 +92,7 @@ library
     Quasar.Observable.ObservablePriority
     Quasar.Prelude
     Quasar.PreludeExtras
+    Quasar.ResourceManager
     Quasar.Timer
     Quasar.Utils.ExtraT
   hs-source-dirs:
diff --git a/src/Quasar/Async.hs b/src/Quasar/Async.hs
index 846aec4..07a1422 100644
--- a/src/Quasar/Async.hs
+++ b/src/Quasar/Async.hs
@@ -26,6 +26,7 @@ import Control.Monad.Reader
 import Quasar.Awaitable
 import Quasar.Disposable
 import Quasar.Prelude
+import Quasar.ResourceManager
 
 
 
diff --git a/src/Quasar/Disposable.hs b/src/Quasar/Disposable.hs
index 63fb487..8a6e3d4 100644
--- a/src/Quasar/Disposable.hs
+++ b/src/Quasar/Disposable.hs
@@ -8,27 +8,6 @@ module Quasar.Disposable (
   noDisposable,
   alreadyDisposing,
 
-  -- * MonadResourceManager
-  MonadResourceManager(..),
-  registerDisposable,
-  registerDisposeAction,
-  disposeEventually,
-  withResourceManagerM,
-  withSubResourceManagerM,
-  onResourceManager,
-  captureDisposable,
-  captureTask,
-
-  -- ** ResourceManager
-  IsResourceManager(..),
-  ResourceManager,
-  withResourceManager,
-  newResourceManager,
-  unsafeNewResourceManager,
-  attachDisposable,
-  attachDisposeAction,
-  attachDisposeAction_,
-
   -- * Task
   Task(..),
   cancelTask,
@@ -42,18 +21,11 @@ module Quasar.Disposable (
   TaskDisposed(..),
 ) where
 
-import Control.Concurrent (forkIOWithUnmask)
 import Control.Concurrent.STM
 import Control.Monad.Catch
 import Control.Monad.Reader
-import Data.Foldable (toList)
-import Data.List.NonEmpty (NonEmpty(..))
-import Data.Maybe (isJust)
-import Data.Sequence
-import Data.Sequence qualified as Seq
 import Quasar.Awaitable
 import Quasar.Prelude
-import System.IO (hPutStrLn, stderr)
 
 
 -- * Disposable
@@ -185,274 +157,6 @@ alreadyDisposing :: IsAwaitable () a => a -> Disposable
 alreadyDisposing someAwaitable = toDisposable $ AlreadyDisposing $ toAwaitable someAwaitable
 
 
--- | Internal entry of `ResourceManager`. The `TMVar` will be set to `Nothing` when the disposable has completed disposing.
-newtype ResourceManagerEntry = ResourceManagerEntry (TMVar (Awaitable (), Disposable))
-
-instance IsAwaitable () ResourceManagerEntry where
-  toAwaitable (ResourceManagerEntry var) = do
-    varContents <- unsafeAwaitSTM $ tryReadTMVar var
-    case varContents of
-      -- If the var is empty the Entry has already been disposed
-      Nothing -> pure ()
-      Just (awaitable, _) -> awaitable
-
-
-newEntry :: IsDisposable a => a -> IO ResourceManagerEntry
-newEntry disposable = do
-  disposedAwaitable <- cacheAwaitable (isDisposed disposable)
-  ResourceManagerEntry <$> newTMVarIO (disposedAwaitable, toDisposable disposable)
-
-entryStartDispose :: ResourceManagerEntry -> IO ()
-entryStartDispose (ResourceManagerEntry var) =
-  atomically (tryReadTMVar var) >>= \case
-    Nothing -> pure ()
-    Just (_, disposable) -> void $ dispose disposable
-
-checkEntries :: Seq ResourceManagerEntry -> IO ()
-checkEntries = mapM_ checkEntry
-
-checkEntry :: ResourceManagerEntry -> IO ()
-checkEntry (ResourceManagerEntry var) = do
-  atomically (tryReadTMVar var) >>= \case
-    Nothing -> pure ()
-    Just (awaitable, _) -> do
-      completed <- isJust <$> peekAwaitable awaitable
-      when completed $ atomically $ void $ tryTakeTMVar var
-
-entryIsEmpty :: ResourceManagerEntry -> STM Bool
-entryIsEmpty (ResourceManagerEntry var) = isEmptyTMVar var
-
-
-class IsResourceManager a where
-  toResourceManager :: a -> ResourceManager
-
-  -- TODO move to class
-  --attachDisposable :: (IsDisposable b, MonadIO m) => a -> b -> m ()
-
-  --subResourceManager :: MonadResourceManager m => m (DisposableResourceThingy)
-
-  throwToResourceManager :: Exception e => a -> e -> IO ()
-  throwToResourceManager = throwToResourceManager . toResourceManager
-
-
-instance IsResourceManager ResourceManager where
-  toResourceManager = id
-  -- TODO delegate to parent
-  throwToResourceManager _ ex = hPutStrLn stderr $ displayException ex
-
-class (MonadAwait m, MonadMask m, MonadIO m) => MonadResourceManager m where
-  -- | Get the underlying resource manager.
-  askResourceManager :: m ResourceManager
-
-  -- | Replace the resource manager for a computation.
-  localResourceManager :: IsResourceManager a => a -> m r -> m r
-
-
-registerDisposable :: (IsDisposable a, MonadResourceManager m) => a -> m ()
-registerDisposable disposable = do
-  resourceManager <- askResourceManager
-  attachDisposable resourceManager disposable
-
-
-registerDisposeAction :: MonadResourceManager m => IO (Awaitable ()) -> m ()
-registerDisposeAction disposeAction = mask_ $ registerDisposable =<< newDisposable disposeAction
-
-
-withSubResourceManagerM :: MonadResourceManager m => m a -> m a
-withSubResourceManagerM action =
-  bracket newResourceManager (await <=< dispose) \scope -> localResourceManager scope action
-
-
-instance (MonadAwait m, MonadMask m, MonadIO m) => MonadResourceManager (ReaderT ResourceManager m) where
-  localResourceManager resourceManager = local (const (toResourceManager resourceManager))
-
-  askResourceManager = ask
-
-
-instance {-# OVERLAPPABLE #-} MonadResourceManager m => MonadResourceManager (ReaderT r m) where
-  askResourceManager = lift askResourceManager
-
-  localResourceManager resourceManager action = do
-    x <- ask
-    lift $ localResourceManager resourceManager $ runReaderT action x
-
-
--- TODO MonadResourceManager instances for StateT, WriterT, RWST, MaybeT, ...
-
-
-onResourceManager :: (IsResourceManager a) => a -> ReaderT ResourceManager m r -> m r
-onResourceManager target action = runReaderT action (toResourceManager target)
-
-
-captureTask :: MonadResourceManager m => m (Awaitable a) -> m (Task a)
-captureTask action = do
-  -- TODO improve performance by only creating a new resource manager when two or more disposables are attached
-  resourceManager <- newResourceManager
-  awaitable <- localResourceManager resourceManager action
-  pure $ Task (toDisposable resourceManager) awaitable
-
-captureDisposable :: MonadResourceManager m => m () -> m Disposable
-captureDisposable action = do
-  -- TODO improve performance by only creating a new resource manager when two or more disposables are attached
-  resourceManager <- newResourceManager
-  localResourceManager resourceManager action
-  pure $ toDisposable resourceManager
-
-
-
-data ResourceManager = ResourceManager {
-  disposingVar :: TVar Bool,
-  disposedVar :: TVar Bool,
-  exceptionVar :: TMVar SomeException,
-  entriesVar :: TVar (Seq ResourceManagerEntry)
-}
-
-instance IsDisposable ResourceManager where
-  dispose resourceManager = liftIO $ mask \unmask ->
-    unmask dispose' `catchAll` \ex -> setException resourceManager ex >> throwIO ex
-    where
-      dispose' :: IO (Awaitable ())
-      dispose' = do
-        entries <- atomically do
-          isAlreadyDisposing <- swapTVar (disposingVar resourceManager) True
-          if not isAlreadyDisposing
-            then readTVar (entriesVar resourceManager)
-            else pure Empty
-
-        mapM_ entryStartDispose entries
-        pure $ isDisposed resourceManager
-
-  isDisposed resourceManager =
-    unsafeAwaitSTM do
-      (throwM =<< readTMVar (exceptionVar resourceManager))
-        `orElse`
-          ((\disposed -> unless disposed retry) =<< readTVar (disposedVar resourceManager))
-
-withResourceManager :: (MonadAwait m, MonadMask m, MonadIO m) => (ResourceManager -> m a) -> m a
-withResourceManager = bracket unsafeNewResourceManager (await <=< liftIO . dispose)
-
-withResourceManagerM :: (MonadAwait m, MonadMask m, MonadIO m) => (ReaderT ResourceManager m a) -> m a
-withResourceManagerM action = withResourceManager \resourceManager -> onResourceManager resourceManager action
-
-newResourceManager :: MonadResourceManager m => m ResourceManager
-newResourceManager = mask_ do
-  resourceManager <- unsafeNewResourceManager
-  registerDisposable resourceManager
-  pure resourceManager
-
-unsafeNewResourceManager :: MonadIO m => m ResourceManager
-unsafeNewResourceManager = liftIO do
-  disposingVar <- newTVarIO False
-  disposedVar <- newTVarIO False
-  exceptionVar <- newEmptyTMVarIO
-  entriesVar <- newTVarIO Empty
-
-  let resourceManager = ResourceManager {
-    disposingVar,
-    disposedVar,
-    exceptionVar,
-    entriesVar
-  }
-
-  void $ mask_ $ forkIOWithUnmask \unmask ->
-    unmask (collectGarbage resourceManager) `catchAll` \ex -> setException resourceManager ex
-
-  pure resourceManager
-
-
-collectGarbage :: ResourceManager -> IO ()
-collectGarbage resourceManager = go
-  where
-    go :: IO ()
-    go = do
-      snapshot <- atomically $ readTVar entriesVar'
-
-      let listChanged = unsafeAwaitSTM do
-            newLength <- Seq.length <$> readTVar entriesVar'
-            when (newLength == Seq.length snapshot) retry
-
-          isDisposing = unsafeAwaitSTM do
-            disposing <- readTVar (disposingVar resourceManager)
-            unless disposing retry
-
-      -- Wait for any entry to complete or until a new entry is added
-      let awaitables = (toAwaitable <$> toList snapshot)
-      -- GC fails here when an waitable throws an exception
-      void if Quasar.Prelude.null awaitables
-        then awaitAny2 listChanged isDisposing
-        else awaitAny (listChanged :| awaitables)
-
-      -- Checking entries for completion has to be done in IO.
-      -- Completion is then queried with `entryIsEmpty` during the following STM transaction.
-      checkEntries =<< atomically (readTVar entriesVar')
-
-      join $ atomically $ do
-        disposing <- readTVar (disposingVar resourceManager)
-
-        -- Filter completed entries
-        allEntries <- readTVar entriesVar'
-        filteredEntries <- foldM (\acc entry -> entryIsEmpty entry >>= \isEmpty -> pure if isEmpty then acc else acc |> entry) Empty allEntries
-        writeTVar entriesVar' filteredEntries
-
-        if disposing && Seq.null filteredEntries
-           then do
-             writeTVar (disposedVar resourceManager) True
-             pure $ pure ()
-           else pure go
-
-    entriesVar' :: TVar (Seq ResourceManagerEntry)
-    entriesVar' = entriesVar resourceManager
-
-
-setException :: ResourceManager -> SomeException -> IO ()
-setException resourceManager ex =
-  -- TODO re-throw exception unchanged or wrap it?
-  atomically $ void $ tryPutTMVar (exceptionVar resourceManager) ex
-
-
-
--- | Attaches an `Disposable` to a ResourceManager. It will automatically be disposed when the resource manager is disposed.
-attachDisposable :: (IsDisposable a, MonadIO m) => ResourceManager -> a -> m ()
-attachDisposable resourceManager disposable = liftIO $ mask \unmask -> do
-  entry <- newEntry disposable
-
-  join $ atomically do
-    mapM_ throwM =<< tryReadTMVar (exceptionVar resourceManager)
-
-    disposed <- readTVar (disposedVar resourceManager)
-    when disposed $ throwM (userError "Cannot attach a disposable to a disposed resource manager")
-
-    modifyTVar (entriesVar resourceManager) (|> entry)
-
-    disposing <- readTVar (disposingVar resourceManager)
-
-    pure do
-      -- IO that is run after the STM transaction is completed
-      when disposing $
-        void $ unmask (dispose disposable) `catchAll` \ex -> setException resourceManager ex >> throwIO ex
-
--- | 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
-  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 ()
-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
--- `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, MonadResourceManager m) => a -> m ()
-disposeEventually disposable = do
-  disposeCompleted <- dispose disposable
-  peekAwaitable disposeCompleted >>= \case
-    Just () -> pure ()
-    Nothing -> registerDisposable disposable
 
 
 
diff --git a/src/Quasar/Observable.hs b/src/Quasar/Observable.hs
index de9f814..a20d946 100644
--- a/src/Quasar/Observable.hs
+++ b/src/Quasar/Observable.hs
@@ -42,10 +42,10 @@ import Control.Monad.Trans.Maybe
 import Data.HashMap.Strict qualified as HM
 import Data.IORef
 import Data.Unique
-import Quasar.Async
 import Quasar.Awaitable
 import Quasar.Disposable
 import Quasar.Prelude
+import Quasar.ResourceManager
 
 data ObservableMessage a
   = ObservableUpdate a
diff --git a/src/Quasar/ResourceManager.hs b/src/Quasar/ResourceManager.hs
new file mode 100644
index 0000000..05eade7
--- /dev/null
+++ b/src/Quasar/ResourceManager.hs
@@ -0,0 +1,308 @@
+module Quasar.ResourceManager (
+  -- * MonadResourceManager
+  MonadResourceManager(..),
+  registerDisposable,
+  registerDisposeAction,
+  disposeEventually,
+  withResourceManagerM,
+  withSubResourceManagerM,
+  onResourceManager,
+  captureDisposable,
+  captureTask,
+
+  -- ** ResourceManager
+  IsResourceManager(..),
+  ResourceManager,
+  withResourceManager,
+  newResourceManager,
+  unsafeNewResourceManager,
+  attachDisposable,
+  attachDisposeAction,
+  attachDisposeAction_,
+) where
+
+
+import Control.Concurrent (forkIOWithUnmask)
+import Control.Concurrent.STM
+import Control.Monad.Catch
+import Control.Monad.Reader
+import Data.Foldable (toList)
+import Data.List.NonEmpty (NonEmpty(..))
+import Data.Maybe (isJust)
+import Data.Sequence
+import Data.Sequence qualified as Seq
+import Quasar.Awaitable
+import Quasar.Disposable
+import Quasar.Prelude
+import System.IO (hPutStrLn, stderr)
+
+
+
+-- | Internal entry of `ResourceManager`. The `TMVar` will be set to `Nothing` when the disposable has completed disposing.
+newtype ResourceManagerEntry = ResourceManagerEntry (TMVar (Awaitable (), Disposable))
+
+instance IsAwaitable () ResourceManagerEntry where
+  toAwaitable (ResourceManagerEntry var) = do
+    varContents <- unsafeAwaitSTM $ tryReadTMVar var
+    case varContents of
+      -- If the var is empty the Entry has already been disposed
+      Nothing -> pure ()
+      Just (awaitable, _) -> awaitable
+
+
+newEntry :: IsDisposable a => a -> IO ResourceManagerEntry
+newEntry disposable = do
+  disposedAwaitable <- cacheAwaitable (isDisposed disposable)
+  ResourceManagerEntry <$> newTMVarIO (disposedAwaitable, toDisposable disposable)
+
+entryStartDispose :: ResourceManagerEntry -> IO ()
+entryStartDispose (ResourceManagerEntry var) =
+  atomically (tryReadTMVar var) >>= \case
+    Nothing -> pure ()
+    Just (_, disposable) -> void $ dispose disposable
+
+checkEntries :: Seq ResourceManagerEntry -> IO ()
+checkEntries = mapM_ checkEntry
+
+checkEntry :: ResourceManagerEntry -> IO ()
+checkEntry (ResourceManagerEntry var) = do
+  atomically (tryReadTMVar var) >>= \case
+    Nothing -> pure ()
+    Just (awaitable, _) -> do
+      completed <- isJust <$> peekAwaitable awaitable
+      when completed $ atomically $ void $ tryTakeTMVar var
+
+entryIsEmpty :: ResourceManagerEntry -> STM Bool
+entryIsEmpty (ResourceManagerEntry var) = isEmptyTMVar var
+
+
+class IsResourceManager a where
+  toResourceManager :: a -> ResourceManager
+
+  -- TODO move to class
+  --attachDisposable :: (IsDisposable b, MonadIO m) => a -> b -> m ()
+
+  --subResourceManager :: MonadResourceManager m => m (DisposableResourceThingy)
+
+  throwToResourceManager :: Exception e => a -> e -> IO ()
+  throwToResourceManager = throwToResourceManager . toResourceManager
+
+
+instance IsResourceManager ResourceManager where
+  toResourceManager = id
+  -- TODO delegate to parent
+  throwToResourceManager _ ex = hPutStrLn stderr $ displayException ex
+
+class (MonadAwait m, MonadMask m, MonadIO m) => MonadResourceManager m where
+  -- | Get the underlying resource manager.
+  askResourceManager :: m ResourceManager
+
+  -- | Replace the resource manager for a computation.
+  localResourceManager :: IsResourceManager a => a -> m r -> m r
+
+
+registerDisposable :: (IsDisposable a, MonadResourceManager m) => a -> m ()
+registerDisposable disposable = do
+  resourceManager <- askResourceManager
+  attachDisposable resourceManager disposable
+
+
+registerDisposeAction :: MonadResourceManager m => IO (Awaitable ()) -> m ()
+registerDisposeAction disposeAction = mask_ $ registerDisposable =<< newDisposable disposeAction
+
+
+withSubResourceManagerM :: MonadResourceManager m => m a -> m a
+withSubResourceManagerM action =
+  bracket newResourceManager (await <=< dispose) \scope -> localResourceManager scope action
+
+
+instance (MonadAwait m, MonadMask m, MonadIO m) => MonadResourceManager (ReaderT ResourceManager m) where
+  localResourceManager resourceManager = local (const (toResourceManager resourceManager))
+
+  askResourceManager = ask
+
+
+instance {-# OVERLAPPABLE #-} MonadResourceManager m => MonadResourceManager (ReaderT r m) where
+  askResourceManager = lift askResourceManager
+
+  localResourceManager resourceManager action = do
+    x <- ask
+    lift $ localResourceManager resourceManager $ runReaderT action x
+
+
+-- TODO MonadResourceManager instances for StateT, WriterT, RWST, MaybeT, ...
+
+
+onResourceManager :: (IsResourceManager a) => a -> ReaderT ResourceManager m r -> m r
+onResourceManager target action = runReaderT action (toResourceManager target)
+
+
+captureTask :: MonadResourceManager m => m (Awaitable a) -> m (Task a)
+captureTask action = do
+  -- TODO improve performance by only creating a new resource manager when two or more disposables are attached
+  resourceManager <- newResourceManager
+  awaitable <- localResourceManager resourceManager action
+  pure $ Task (toDisposable resourceManager) awaitable
+
+captureDisposable :: MonadResourceManager m => m () -> m Disposable
+captureDisposable action = do
+  -- TODO improve performance by only creating a new resource manager when two or more disposables are attached
+  resourceManager <- newResourceManager
+  localResourceManager resourceManager action
+  pure $ toDisposable resourceManager
+
+
+
+data ResourceManager = ResourceManager {
+  disposingVar :: TVar Bool,
+  disposedVar :: TVar Bool,
+  exceptionVar :: TMVar SomeException,
+  entriesVar :: TVar (Seq ResourceManagerEntry)
+}
+
+instance IsDisposable ResourceManager where
+  dispose resourceManager = liftIO $ mask \unmask ->
+    unmask dispose' `catchAll` \ex -> setException resourceManager ex >> throwIO ex
+    where
+      dispose' :: IO (Awaitable ())
+      dispose' = do
+        entries <- atomically do
+          isAlreadyDisposing <- swapTVar (disposingVar resourceManager) True
+          if not isAlreadyDisposing
+            then readTVar (entriesVar resourceManager)
+            else pure Empty
+
+        mapM_ entryStartDispose entries
+        pure $ isDisposed resourceManager
+
+  isDisposed resourceManager =
+    unsafeAwaitSTM do
+      (throwM =<< readTMVar (exceptionVar resourceManager))
+        `orElse`
+          ((\disposed -> unless disposed retry) =<< readTVar (disposedVar resourceManager))
+
+withResourceManager :: (MonadAwait m, MonadMask m, MonadIO m) => (ResourceManager -> m a) -> m a
+withResourceManager = bracket unsafeNewResourceManager (await <=< liftIO . dispose)
+
+withResourceManagerM :: (MonadAwait m, MonadMask m, MonadIO m) => (ReaderT ResourceManager m a) -> m a
+withResourceManagerM action = withResourceManager \resourceManager -> onResourceManager resourceManager action
+
+newResourceManager :: MonadResourceManager m => m ResourceManager
+newResourceManager = mask_ do
+  resourceManager <- unsafeNewResourceManager
+  registerDisposable resourceManager
+  pure resourceManager
+
+unsafeNewResourceManager :: MonadIO m => m ResourceManager
+unsafeNewResourceManager = liftIO do
+  disposingVar <- newTVarIO False
+  disposedVar <- newTVarIO False
+  exceptionVar <- newEmptyTMVarIO
+  entriesVar <- newTVarIO Empty
+
+  let resourceManager = ResourceManager {
+    disposingVar,
+    disposedVar,
+    exceptionVar,
+    entriesVar
+  }
+
+  void $ mask_ $ forkIOWithUnmask \unmask ->
+    unmask (collectGarbage resourceManager) `catchAll` \ex -> setException resourceManager ex
+
+  pure resourceManager
+
+
+collectGarbage :: ResourceManager -> IO ()
+collectGarbage resourceManager = go
+  where
+    go :: IO ()
+    go = do
+      snapshot <- atomically $ readTVar entriesVar'
+
+      let listChanged = unsafeAwaitSTM do
+            newLength <- Seq.length <$> readTVar entriesVar'
+            when (newLength == Seq.length snapshot) retry
+
+          isDisposing = unsafeAwaitSTM do
+            disposing <- readTVar (disposingVar resourceManager)
+            unless disposing retry
+
+      -- Wait for any entry to complete or until a new entry is added
+      let awaitables = (toAwaitable <$> toList snapshot)
+      -- GC fails here when an waitable throws an exception
+      void if Quasar.Prelude.null awaitables
+        then awaitAny2 listChanged isDisposing
+        else awaitAny (listChanged :| awaitables)
+
+      -- Checking entries for completion has to be done in IO.
+      -- Completion is then queried with `entryIsEmpty` during the following STM transaction.
+      checkEntries =<< atomically (readTVar entriesVar')
+
+      join $ atomically $ do
+        disposing <- readTVar (disposingVar resourceManager)
+
+        -- Filter completed entries
+        allEntries <- readTVar entriesVar'
+        filteredEntries <- foldM (\acc entry -> entryIsEmpty entry >>= \isEmpty -> pure if isEmpty then acc else acc |> entry) Empty allEntries
+        writeTVar entriesVar' filteredEntries
+
+        if disposing && Seq.null filteredEntries
+           then do
+             writeTVar (disposedVar resourceManager) True
+             pure $ pure ()
+           else pure go
+
+    entriesVar' :: TVar (Seq ResourceManagerEntry)
+    entriesVar' = entriesVar resourceManager
+
+
+setException :: ResourceManager -> SomeException -> IO ()
+setException resourceManager ex =
+  -- TODO re-throw exception unchanged or wrap it?
+  atomically $ void $ tryPutTMVar (exceptionVar resourceManager) ex
+
+
+
+-- | Attaches an `Disposable` to a ResourceManager. It will automatically be disposed when the resource manager is disposed.
+attachDisposable :: (IsDisposable a, MonadIO m) => ResourceManager -> a -> m ()
+attachDisposable resourceManager disposable = liftIO $ mask \unmask -> do
+  entry <- newEntry disposable
+
+  join $ atomically do
+    mapM_ throwM =<< tryReadTMVar (exceptionVar resourceManager)
+
+    disposed <- readTVar (disposedVar resourceManager)
+    when disposed $ throwM (userError "Cannot attach a disposable to a disposed resource manager")
+
+    modifyTVar (entriesVar resourceManager) (|> entry)
+
+    disposing <- readTVar (disposingVar resourceManager)
+
+    pure do
+      -- IO that is run after the STM transaction is completed
+      when disposing $
+        void $ unmask (dispose disposable) `catchAll` \ex -> setException resourceManager ex >> throwIO ex
+
+-- | 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
+  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 ()
+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
+-- `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, MonadResourceManager m) => a -> m ()
+disposeEventually disposable = do
+  disposeCompleted <- dispose disposable
+  peekAwaitable disposeCompleted >>= \case
+    Just () -> pure ()
+    Nothing -> registerDisposable disposable
diff --git a/src/Quasar/Timer.hs b/src/Quasar/Timer.hs
index f8f1341..4d32cfa 100644
--- a/src/Quasar/Timer.hs
+++ b/src/Quasar/Timer.hs
@@ -24,6 +24,7 @@ import Quasar.Async
 import Quasar.Awaitable
 import Quasar.Disposable
 import Quasar.Prelude
+import Quasar.ResourceManager
 
 
 data TimerCancelled = TimerCancelled
diff --git a/test/Quasar/AsyncSpec.hs b/test/Quasar/AsyncSpec.hs
index e0e506c..fe2c7f4 100644
--- a/test/Quasar/AsyncSpec.hs
+++ b/test/Quasar/AsyncSpec.hs
@@ -8,6 +8,7 @@ import Test.Hspec
 import Quasar.Async
 import Quasar.Awaitable
 import Quasar.Disposable
+import Quasar.ResourceManager
 import System.Timeout
 
 spec :: Spec
diff --git a/test/Quasar/DisposableSpec.hs b/test/Quasar/DisposableSpec.hs
index 3989064..a424215 100644
--- a/test/Quasar/DisposableSpec.hs
+++ b/test/Quasar/DisposableSpec.hs
@@ -6,6 +6,7 @@ import Quasar.Prelude
 import Test.Hspec
 import Quasar.Awaitable
 import Quasar.Disposable
+import Quasar.ResourceManager
 
 data TestException = TestException
   deriving stock (Eq, Show)
diff --git a/test/Quasar/ObservableSpec.hs b/test/Quasar/ObservableSpec.hs
index f7103d6..53d9e07 100644
--- a/test/Quasar/ObservableSpec.hs
+++ b/test/Quasar/ObservableSpec.hs
@@ -4,6 +4,7 @@ import Data.IORef
 import Quasar.Prelude
 import Quasar.Disposable
 import Quasar.Observable
+import Quasar.ResourceManager
 import Test.Hspec
 
 
-- 
GitLab