diff --git a/src/Quasar/Async.hs b/src/Quasar/Async.hs index 08a2dd86f22a5316fff248b27d0ba281fcbe4e13..b3efc4d078d4864fc0f098f51e3d3aed5e76b04b 100644 --- a/src/Quasar/Async.hs +++ b/src/Quasar/Async.hs @@ -57,7 +57,7 @@ instance MonadAsync (ReaderT ResourceManager IO) where -- Thread has completed work, "disarm" the disposable and fire it void $ atomically $ swapTMVar threadIdVar Nothing - disposeIO disposable + awaitDispose disposable do atomically $ putTMVar threadIdVar Nothing diff --git a/src/Quasar/Disposable.hs b/src/Quasar/Disposable.hs index 89291043e3521fdab94f229e4568074ecbbbe2cf..76e0f2858f2dd558e7567d5dba92d1504143f034 100644 --- a/src/Quasar/Disposable.hs +++ b/src/Quasar/Disposable.hs @@ -2,7 +2,7 @@ module Quasar.Disposable ( -- * Disposable IsDisposable(..), Disposable, - disposeIO, + awaitDispose, newDisposable, synchronousDisposable, noDisposable, @@ -54,9 +54,12 @@ class IsDisposable a where {-# MINIMAL toDisposable | (dispose, isDisposed) #-} + -- | Dispose a resource in the IO monad. -disposeIO :: IsDisposable a => a -> IO () -disposeIO = await <=< dispose +awaitDispose :: (MonadAwait m, MonadIO m) => IsDisposable a => a -> m () +awaitDispose disposable = await =<< liftIO (dispose disposable) + + instance IsDisposable a => IsDisposable (Maybe a) where toDisposable = maybe noDisposable toDisposable diff --git a/src/Quasar/Timer.hs b/src/Quasar/Timer.hs index 32a5ef6b8b571b1ff28705940f3646cbdc50d6db..6ffb81cf6941e032fb02d4b7040a59a5cf6b27d2 100644 --- a/src/Quasar/Timer.hs +++ b/src/Quasar/Timer.hs @@ -185,7 +185,7 @@ newTimer scheduler time = do sleepUntil :: TimerScheduler -> UTCTime -> IO () -sleepUntil scheduler time = bracketOnError (newTimer scheduler time) disposeIO await +sleepUntil scheduler time = bracketOnError (newTimer scheduler time) awaitDispose await diff --git a/test/Quasar/DisposableSpec.hs b/test/Quasar/DisposableSpec.hs index ad3ab96f3c1ad6f7cd1bb52e13e9f90af6a6482b..ba961d3e74da8a56951b3f11aeea18b542340597 100644 --- a/test/Quasar/DisposableSpec.hs +++ b/test/Quasar/DisposableSpec.hs @@ -26,20 +26,20 @@ spec = parallel $ do describe "newDisposable" $ do it "signals it's disposed state" $ do disposable <- newDisposable $ pure $ pure () - void $ forkIO $ threadDelay 100000 >> disposeIO disposable + void $ forkIO $ threadDelay 100000 >> awaitDispose disposable await (isDisposed disposable) pure () :: IO () - it "can be disposed multiple times" $ do + it "can be disposed multiple times" $ io do disposable <- newDisposable $ pure $ pure () - disposeIO disposable - disposeIO disposable + awaitDispose disposable + awaitDispose disposable await (isDisposed disposable) it "can be disposed in parallel" $ do disposable <- newDisposable $ pure () <$ threadDelay 100000 - void $ forkIO $ disposeIO disposable - disposeIO disposable + void $ forkIO $ awaitDispose disposable + awaitDispose disposable await (isDisposed disposable) @@ -98,4 +98,4 @@ spec = parallel $ do it "can attach an disposable that is disposed asynchronously" $ do withResourceManager \resourceManager -> do disposable <- attachDisposeAction resourceManager $ pure () <$ threadDelay 100000 - void $ forkIO $ disposeIO disposable + void $ forkIO $ awaitDispose disposable diff --git a/test/Quasar/Observable/ObservableHashMapSpec.hs b/test/Quasar/Observable/ObservableHashMapSpec.hs index 147fb6116ce9214b7c615abebdc5012bbd85ee85..d69d1c142b8bfba4b872092f6d241f9242525bd3 100644 --- a/test/Quasar/Observable/ObservableHashMapSpec.hs +++ b/test/Quasar/Observable/ObservableHashMapSpec.hs @@ -39,7 +39,7 @@ spec = parallel $ do OM.insert "key2" "value2" om lastCallbackShouldBe (HM.fromList [("key", "value"), ("key2", "value2")]) - disposeIO subscriptionHandle + awaitDispose subscriptionHandle lastCallbackShouldBe (HM.fromList [("key", "value"), ("key2", "value2")]) OM.insert "key3" "value3" om @@ -61,7 +61,7 @@ spec = parallel $ do OM.insert "key2" "value2" om lastDeltaShouldBe $ Insert "key2" "value2" - disposeIO subscriptionHandle + awaitDispose subscriptionHandle lastDeltaShouldBe $ Insert "key2" "value2" OM.insert "key3" "value3" om @@ -120,7 +120,7 @@ spec = parallel $ do v2ShouldBe $ Just "changed" retrieveIO om `shouldReturn` HM.singleton "key2" "changed" - disposeIO handle2 + awaitDispose handle2 OM.lookupDelete "key2" om `shouldReturn` Just "changed" v2ShouldBe $ Just "changed" diff --git a/test/Quasar/Observable/ObservablePrioritySpec.hs b/test/Quasar/Observable/ObservablePrioritySpec.hs index d500d0f7a132939cccd59c1d808d756c88d05f93..003a0df825f2ecbf2111cbbcf17e25348bd97254 100644 --- a/test/Quasar/Observable/ObservablePrioritySpec.hs +++ b/test/Quasar/Observable/ObservablePrioritySpec.hs @@ -22,9 +22,9 @@ spec = do retrieveIO op `shouldReturn` Just "p2" p1 <- OP.insertValue op 1 "p1" retrieveIO op `shouldReturn` Just "p2" - disposeIO p2 + awaitDispose p2 retrieveIO op `shouldReturn` Just "p1" - disposeIO p1 + awaitDispose p1 retrieveIO op `shouldReturn` Nothing it "sends updates when its value changes" $ do result <- newIORef [] @@ -40,9 +40,9 @@ spec = do mostRecentShouldBe (Just "p2") p1 <- OP.insertValue op 1 "p1" mostRecentShouldBe (Just "p2") - disposeIO p2 + awaitDispose p2 mostRecentShouldBe (Just "p1") - disposeIO p1 + awaitDispose p1 mostRecentShouldBe Nothing length <$> readIORef result `shouldReturn` 4