From f7aba7a2876678afecc85d705e64b1c82e7cf96f Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Sun, 29 Aug 2021 20:21:00 +0200
Subject: [PATCH] Add awaitDispose (replaces disposeIO)
---
src/Quasar/Async.hs | 2 +-
src/Quasar/Disposable.hs | 9 ++++++---
src/Quasar/Timer.hs | 2 +-
test/Quasar/DisposableSpec.hs | 14 +++++++-------
test/Quasar/Observable/ObservableHashMapSpec.hs | 6 +++---
test/Quasar/Observable/ObservablePrioritySpec.hs | 8 ++++----
6 files changed, 22 insertions(+), 19 deletions(-)
diff --git a/src/Quasar/Async.hs b/src/Quasar/Async.hs
index 08a2dd8..b3efc4d 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 8929104..76e0f28 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 32a5ef6..6ffb81c 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 ad3ab96..ba961d3 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 147fb61..d69d1c1 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 d500d0f..003a0df 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
--
GitLab