diff --git a/src/Quasar/ResourceManager.hs b/src/Quasar/ResourceManager.hs index 393bf17908d3cce06845b4f5c58efdd8ea5cb189..38f4858eb2efb8ab04a5a786b999a26444ed57cd 100644 --- a/src/Quasar/ResourceManager.hs +++ b/src/Quasar/ResourceManager.hs @@ -2,6 +2,7 @@ module Quasar.ResourceManager ( -- * MonadResourceManager MonadResourceManager(..), FailedToRegisterResource, + registerNewResource, registerDisposable, registerDisposeAction, registerSimpleDisposeAction, @@ -136,6 +137,12 @@ registerDisposeAction disposeAction = mask_ $ registerDisposable =<< newDisposab registerSimpleDisposeAction :: MonadResourceManager m => IO () -> m () 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? withSubResourceManagerM :: MonadResourceManager m => m a -> m a @@ -278,20 +285,15 @@ instance IsResourceManager DefaultResourceManager where entry <- newEntry disposable join $ atomically do + disposing <- readTVar (disposingVar resourceManager) disposed <- readTVar (disposedVar resourceManager) - unless disposed $ modifyTVar (entriesVar resourceManager) (|> entry) + unless disposing $ modifyTVar (entriesVar resourceManager) (|> entry) - disposing <- readTVar (disposingVar resourceManager) - - -- IO that is run after the STM transaction is completed - pure $ (`catchAll` throwToResourceManager resourceManager) do - if disposed - then do - traceIO "Attached a disposable to a disposed resource manager" - await =<< dispose disposable - else when disposing do - void (dispose disposable) + pure do + -- IO that is run after the STM transaction is completed + when disposing $ + throwM FailedToRegisterResource `catchAll` throwToResourceManager resourceManager instance IsDisposable DefaultResourceManager where dispose resourceManager = liftIO $ mask_ do @@ -406,6 +408,7 @@ freeGarbage resourceManager = go entriesVar' = entriesVar resourceManager + -- | 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