From 7adf2a50a96bb91f00262b38b37ea2fd5faba49e Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Fri, 11 Feb 2022 23:08:43 +0100
Subject: [PATCH] Fix some warnings
---
src/Quasar/Resources/Disposer.hs | 7 +++----
src/Quasar/Timer.hs | 11 ++++++-----
src/Quasar/Timer/PosixTimer.hsc | 2 +-
3 files changed, 10 insertions(+), 10 deletions(-)
diff --git a/src/Quasar/Resources/Disposer.hs b/src/Quasar/Resources/Disposer.hs
index 3bf9d39..009b227 100644
--- a/src/Quasar/Resources/Disposer.hs
+++ b/src/Quasar/Resources/Disposer.hs
@@ -110,7 +110,6 @@ disposerFinalizers (ResourceManagerDisposer rm) = resourceManagerFinalizers rm
-
data DisposeResult
= DisposeResultAwait (Awaitable ())
| DisposeResultDependencies DisposeDependencies
@@ -133,7 +132,7 @@ data ResourceManagerState
instance Resource ResourceManager where
getDisposer = ResourceManagerDisposer
-
+
newResourceManagerSTM :: TIOWorker -> ExceptionChannel -> STM ResourceManager
newResourceManagerSTM worker exChan = do
@@ -171,7 +170,7 @@ attachDisposer resourceManager disposer = do
-- No finalization required in other states, since all resources are disposed soon
-- (and awaiting each resource is cheaper than modifying a HashMap until it is empty).
_ -> pure ()
-
+
beginDisposeResourceManager :: ResourceManager -> STM (Awaitable ())
beginDisposeResourceManager rm = do
@@ -262,7 +261,7 @@ runFinalizers (Finalizers finalizerVar) = do
runFinalizersAfter :: Finalizers -> Awaitable () -> IO ()
runFinalizersAfter finalizers awaitable = do
-- Peek awaitable to ensure trivial disposables always run without forking
- isCompleted <- isJust <$> peekAwaitable awaitable
+ isCompleted <- isJust <$> peekAwaitable awaitable
if isCompleted
then
atomically $ runFinalizers finalizers
diff --git a/src/Quasar/Timer.hs b/src/Quasar/Timer.hs
index e00da88..b426f7c 100644
--- a/src/Quasar/Timer.hs
+++ b/src/Quasar/Timer.hs
@@ -73,7 +73,7 @@ data TimerSchedulerDisposed = TimerSchedulerDisposed
instance Exception TimerSchedulerDisposed
-newTimerScheduler :: (MonadResourceManager m, MonadIO m, MonadMask m) => m TimerScheduler
+newTimerScheduler :: (MonadResourceManager m, MonadIO m) => m TimerScheduler
newTimerScheduler = registerNewResource newUnmanagedTimerScheduler
newUnmanagedTimerScheduler :: MonadIO m => m TimerScheduler
@@ -104,7 +104,8 @@ startSchedulerThread scheduler = toDisposable <$> unmanagedAsync (schedulerThrea
-- Get next timer (blocks when heap is empty)
nextTimer <- atomically do
- uncons <$> readTMVar heap' >>= \case
+ mNext <- uncons <$> readTMVar heap'
+ case mNext of
Nothing -> retry
Just (timer, _) -> pure timer
@@ -152,7 +153,7 @@ startSchedulerThread scheduler = toDisposable <$> unmanagedAsync (schedulerThrea
disposeSTMDisposable disposable
cleanup :: STM ()
- cleanup = putTMVar heap' . fromList =<< mapMaybeM cleanupTimer =<< (toList <$> takeTMVar heap')
+ cleanup = putTMVar heap' . fromList =<< mapMaybeM cleanupTimer . toList =<< takeTMVar heap'
cleanupTimer :: Timer -> STM (Maybe Timer)
cleanupTimer timer = do
@@ -169,7 +170,7 @@ startSchedulerThread scheduler = toDisposable <$> unmanagedAsync (schedulerThrea
mapM_ dispose timers
-newTimer :: (MonadResourceManager m, MonadIO m, MonadMask m) => TimerScheduler -> UTCTime -> m Timer
+newTimer :: (MonadResourceManager m, MonadIO m) => TimerScheduler -> UTCTime -> m Timer
newTimer scheduler time =
registerNewResource $ newUnmanagedTimer scheduler time
@@ -206,7 +207,7 @@ newtype Delay = Delay (Async ())
instance IsAwaitable () Delay where
toAwaitable (Delay task) = toAwaitable task `catch` \AsyncDisposed -> throwM TimerCancelled
-newDelay :: (MonadResourceManager m, MonadIO m, MonadMask m) => Int -> m Delay
+newDelay :: (MonadResourceManager m, MonadIO m) => Int -> m Delay
newDelay microseconds = registerNewResource $ newUnmanagedDelay microseconds
newUnmanagedDelay :: MonadIO m => Int -> m Delay
diff --git a/src/Quasar/Timer/PosixTimer.hsc b/src/Quasar/Timer/PosixTimer.hsc
index ba9e098..9a669ba 100644
--- a/src/Quasar/Timer/PosixTimer.hsc
+++ b/src/Quasar/Timer/PosixTimer.hsc
@@ -166,7 +166,7 @@ instance IsDisposable PosixTimer where
toDisposable = disposable
-newPosixTimer :: (MonadResourceManager m, MonadIO m, MonadMask m) => ClockId -> IO () -> m PosixTimer
+newPosixTimer :: (MonadResourceManager m, MonadIO m) => ClockId -> IO () -> m PosixTimer
newPosixTimer clockId callback = registerNewResource do
liftIO $ newUnmanagedPosixTimer clockId callback
--
GitLab