diff --git a/src/Quasar/Disposable.hs b/src/Quasar/Disposable.hs index d17a282df222f058bda4af1e65d49d00f22afa77..befa2e31b07439c5784fd641baee993ad1054d8c 100644 --- a/src/Quasar/Disposable.hs +++ b/src/Quasar/Disposable.hs @@ -283,10 +283,10 @@ withResourceManager = bracket unsafeNewResourceManager (await <=< liftIO . dispo withOnResourceManager :: (MonadAwait m, MonadMask m, MonadIO m) => (ReaderT ResourceManager m a) -> m a withOnResourceManager action = withResourceManager \resourceManager -> onResourceManager resourceManager action -newResourceManager :: MonadIO m => ResourceManager -> m ResourceManager -newResourceManager parent = liftIO $ mask_ do +newResourceManager :: MonadResourceManager m => m ResourceManager +newResourceManager = mask_ do resourceManager <- unsafeNewResourceManager - attachDisposable parent resourceManager + registerDisposable resourceManager pure resourceManager unsafeNewResourceManager :: MonadIO m => m ResourceManager diff --git a/src/Quasar/Timer.hs b/src/Quasar/Timer.hs index 9030405ec3d91d7eae756cadc344f206894873f3..320b608b38f090a3a8c3e38ec148ca9b27b4ea39 100644 --- a/src/Quasar/Timer.hs +++ b/src/Quasar/Timer.hs @@ -75,28 +75,27 @@ data TimerSchedulerDisposed = TimerSchedulerDisposed instance Exception TimerSchedulerDisposed -newTimerScheduler :: ResourceManager -> IO TimerScheduler -newTimerScheduler parentResourceManager = do - heap <- newTVarIO empty - activeCount <- newTVarIO 0 - cancelledCount <- newTVarIO 0 - resourceManager <- newResourceManager parentResourceManager - let scheduler = TimerScheduler { - heap, - activeCount, - cancelledCount, - resourceManager - } - startSchedulerThread scheduler - pure scheduler +newTimerScheduler :: MonadResourceManager m => m TimerScheduler +newTimerScheduler = do + resourceManager <- newResourceManager + liftIO do + heap <- newTVarIO empty + activeCount <- newTVarIO 0 + cancelledCount <- newTVarIO 0 + let scheduler = TimerScheduler { + heap, + activeCount, + cancelledCount, + resourceManager + } + startSchedulerThread scheduler + pure scheduler startSchedulerThread :: TimerScheduler -> IO () startSchedulerThread scheduler = do mask_ do - threadId <- forkIOWithUnmask ($ schedulerThread) - attachDisposeAction_ (resourceManager scheduler) do - throwTo threadId TimerSchedulerDisposed - pure $ pure () + onResourceManager (resourceManager scheduler) do + registerDisposable =<< forkTask schedulerThread where resourceManager' :: ResourceManager resourceManager' = resourceManager scheduler