diff --git a/src/Quasar/Resources/Disposer.hs b/src/Quasar/Resources/Disposer.hs index 3bf9d39912e6e68ef4ef47c4a0deb139474a10d0..009b22741392546a381e0fcc02c72aedc6524c53 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 e00da88790cb61bacc68ab1dfcc0773dcf44b00e..b426f7c3b0349ae2357f21d337ac184e08df7d0b 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 ba9e098114e45af1b40b952545723daa0f60eb0c..9a669ba870da38bcc7b1b856be0ab1c93bdbc98f 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