From 4874b82a019b44166385d692eeddbf417b626140 Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Sat, 12 Feb 2022 00:55:59 +0100
Subject: [PATCH] Add isDisposing
---
src/Quasar/Resources/Disposer.hs | 16 ++++++++++++++++
1 file changed, 16 insertions(+)
diff --git a/src/Quasar/Resources/Disposer.hs b/src/Quasar/Resources/Disposer.hs
index 009b227..75270d2 100644
--- a/src/Quasar/Resources/Disposer.hs
+++ b/src/Quasar/Resources/Disposer.hs
@@ -6,6 +6,7 @@ module Quasar.Resources.Disposer (
dispose,
disposeEventuallySTM,
disposeEventuallySTM_,
+ isDisposing,
isDisposed,
newPrimitiveDisposer,
@@ -20,6 +21,7 @@ import Control.Concurrent (forkIO)
import Control.Concurrent.STM
import Control.Monad (foldM)
import Control.Monad.Catch
+import Data.Either (isRight)
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HM
import Data.HashSet (HashSet)
@@ -75,6 +77,13 @@ isDisposed resource =
FnDisposer _ _ _ state _ -> join (toAwaitable state)
ResourceManagerDisposer resourceManager -> resourceManagerIsDisposed resourceManager
+isDisposing :: Resource a => a -> Awaitable ()
+isDisposing resource =
+ case getDisposer resource of
+ FnDisposer _ _ _ state _ -> unsafeAwaitSTM (check . isRight =<< readTOnceState state)
+ ResourceManagerDisposer resourceManager -> resourceManagerIsDisposing resourceManager
+
+
beginDisposeFnDisposer :: TIOWorker -> ExceptionChannel -> DisposerState -> Finalizers -> STM (Awaitable ())
beginDisposeFnDisposer worker exChan disposeState finalizers =
@@ -235,6 +244,13 @@ resourceManagerIsDisposed rm = unsafeAwaitSTM $
ResourceManagerDisposed -> pure ()
_ -> retry
+resourceManagerIsDisposing :: ResourceManager -> Awaitable ()
+resourceManagerIsDisposing rm = unsafeAwaitSTM $
+ readTVar (resourceManagerState rm) >>= \case
+ (ResourceManagerNormal _ _) -> retry
+ _ -> pure ()
+
+
-- * Implementation internals
--
GitLab