From dc6ce1cf2217ad151a0b7fff1df6c7844cbf7d03 Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Tue, 31 Aug 2021 20:17:39 +0200
Subject: [PATCH] Use MonadResourceManager in more places
---
src/Quasar/Disposable.hs | 6 +++---
src/Quasar/Timer.hs | 35 +++++++++++++++++------------------
2 files changed, 20 insertions(+), 21 deletions(-)
diff --git a/src/Quasar/Disposable.hs b/src/Quasar/Disposable.hs
index d17a282..befa2e3 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 9030405..320b608 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
--
GitLab