Skip to content
Snippets Groups Projects
Commit 7ff04621 authored by Jens Nolte's avatar Jens Nolte
Browse files

Add registerNewResource to handle a diposed resource manager


Co-authored-by: default avatarJan Beinke <git@janbeinke.com>
parent 8ab59796
No related branches found
No related tags found
No related merge requests found
...@@ -2,6 +2,7 @@ module Quasar.ResourceManager ( ...@@ -2,6 +2,7 @@ module Quasar.ResourceManager (
-- * MonadResourceManager -- * MonadResourceManager
MonadResourceManager(..), MonadResourceManager(..),
FailedToRegisterResource, FailedToRegisterResource,
registerNewResource,
registerDisposable, registerDisposable,
registerDisposeAction, registerDisposeAction,
registerSimpleDisposeAction, registerSimpleDisposeAction,
...@@ -136,6 +137,12 @@ registerDisposeAction disposeAction = mask_ $ registerDisposable =<< newDisposab ...@@ -136,6 +137,12 @@ registerDisposeAction disposeAction = mask_ $ registerDisposable =<< newDisposab
registerSimpleDisposeAction :: MonadResourceManager m => IO () -> m () registerSimpleDisposeAction :: MonadResourceManager m => IO () -> m ()
registerSimpleDisposeAction disposeAction = registerDisposeAction (pure () <$ disposeAction) registerSimpleDisposeAction disposeAction = registerDisposeAction (pure () <$ disposeAction)
registerNewResource :: (IsDisposable a, MonadResourceManager m) => m a -> m a
registerNewResource action = mask_ do
afix \awaitable -> do
registerDisposeAction $ either (\(_ :: SomeException) -> mempty) dispose =<< try (await awaitable)
action
-- TODO rename to withResourceScope? -- TODO rename to withResourceScope?
withSubResourceManagerM :: MonadResourceManager m => m a -> m a withSubResourceManagerM :: MonadResourceManager m => m a -> m a
...@@ -278,20 +285,15 @@ instance IsResourceManager DefaultResourceManager where ...@@ -278,20 +285,15 @@ instance IsResourceManager DefaultResourceManager where
entry <- newEntry disposable entry <- newEntry disposable
join $ atomically do join $ atomically do
disposing <- readTVar (disposingVar resourceManager)
disposed <- readTVar (disposedVar resourceManager) disposed <- readTVar (disposedVar resourceManager)
unless disposed $ modifyTVar (entriesVar resourceManager) (|> entry) unless disposing $ modifyTVar (entriesVar resourceManager) (|> entry)
disposing <- readTVar (disposingVar resourceManager) pure do
-- IO that is run after the STM transaction is completed
-- IO that is run after the STM transaction is completed when disposing $
pure $ (`catchAll` throwToResourceManager resourceManager) do throwM FailedToRegisterResource `catchAll` throwToResourceManager resourceManager
if disposed
then do
traceIO "Attached a disposable to a disposed resource manager"
await =<< dispose disposable
else when disposing do
void (dispose disposable)
instance IsDisposable DefaultResourceManager where instance IsDisposable DefaultResourceManager where
dispose resourceManager = liftIO $ mask_ do dispose resourceManager = liftIO $ mask_ do
...@@ -406,6 +408,7 @@ freeGarbage resourceManager = go ...@@ -406,6 +408,7 @@ freeGarbage resourceManager = go
entriesVar' = entriesVar resourceManager entriesVar' = entriesVar resourceManager
-- | Creates an `Disposable` that is bound to a ResourceManager. It will automatically be disposed when the resource manager is disposed. -- | 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 :: MonadIO m => ResourceManager -> IO (Awaitable ()) -> m Disposable
attachDisposeAction resourceManager action = liftIO $ mask_ $ do attachDisposeAction resourceManager action = liftIO $ mask_ $ do
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment