diff --git a/src/Quasar/Resources/Disposer.hs b/src/Quasar/Resources/Disposer.hs index 009b22741392546a381e0fcc02c72aedc6524c53..75270d2210aba5a614a9c4ab01364e2be214f84d 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