From 377b180727e7fa86b9cfd34b4071ca46c8fd8518 Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Sun, 29 Aug 2021 17:26:49 +0200
Subject: [PATCH] Generalize `await*` utility functions
---
src/Quasar/Awaitable.hs | 16 +++++++++-------
src/Quasar/Disposable.hs | 2 +-
src/Quasar/Timer.hs | 2 +-
test/Quasar/AwaitableSpec.hs | 6 +++---
4 files changed, 14 insertions(+), 12 deletions(-)
diff --git a/src/Quasar/Awaitable.hs b/src/Quasar/Awaitable.hs
index a595221..3d24bbd 100644
--- a/src/Quasar/Awaitable.hs
+++ b/src/Quasar/Awaitable.hs
@@ -144,8 +144,8 @@ instance IsAwaitable r (MonadicAwaitable r) where
runAwaitable (MonadicAwaitable x) = x
cacheAwaitable = cacheAwaitableDefaultImplementation
-mkMonadicAwaitable :: (forall m. (MonadQuerySTM m) => m r) -> Awaitable r
-mkMonadicAwaitable fn = toAwaitable $ MonadicAwaitable fn
+mkMonadicAwaitable :: MonadAwait m => (forall m. (MonadQuerySTM m) => m r) -> m r
+mkMonadicAwaitable fn = await $ MonadicAwaitable fn
newtype CompletedAwaitable r = CompletedAwaitable (Either SomeException r)
@@ -328,15 +328,17 @@ putAsyncVarEitherSTM_ var = void . putAsyncVarEitherSTM var
-- * Utility functions
-- | Create an awaitable that is completed successfully when the input awaitable is successful or failed.
-awaitSuccessOrFailure :: IsAwaitable r a => a -> Awaitable ()
-awaitSuccessOrFailure = fireAndForget . toAwaitable
+awaitSuccessOrFailure :: (IsAwaitable r a, MonadAwait m) => a -> m ()
+awaitSuccessOrFailure = await . fireAndForget . toAwaitable
where
fireAndForget :: MonadCatch m => m r -> m ()
fireAndForget x = void x `catchAll` const (pure ())
-- ** Awaiting multiple awaitables
-awaitEither :: (IsAwaitable ra a, IsAwaitable rb b) => a -> b -> Awaitable (Either ra rb)
+
+
+awaitEither :: (IsAwaitable ra a, IsAwaitable rb b, MonadAwait m) => a -> b -> m (Either ra rb)
awaitEither x y = mkMonadicAwaitable $ stepBoth (runAwaitable x) (runAwaitable y)
where
stepBoth :: MonadQuerySTM m => AwaitableStepM ra -> AwaitableStepM rb -> m (Either ra rb)
@@ -350,7 +352,7 @@ awaitEither x y = mkMonadicAwaitable $ stepBoth (runAwaitable x) (runAwaitable y
Right resultY -> stepBoth stepX (nextY resultY)
-awaitAny :: IsAwaitable r a => NonEmpty a -> Awaitable r
+awaitAny :: (IsAwaitable r a, MonadAwait m) => NonEmpty a -> m r
awaitAny xs = mkMonadicAwaitable $ stepAll Empty Empty $ runAwaitable <$> fromList (toList xs)
where
stepAll
@@ -371,7 +373,7 @@ awaitAny xs = mkMonadicAwaitable $ stepAll Empty Empty $ runAwaitable <$> fromLi
stepAll Empty Empty newAwaitableSteps
-awaitAny2 :: IsAwaitable r a => a -> a -> Awaitable r
+awaitAny2 :: (IsAwaitable r a, MonadAwait m) => a -> a -> m r
awaitAny2 x y = awaitAny (x :| [y])
diff --git a/src/Quasar/Disposable.hs b/src/Quasar/Disposable.hs
index 2c11824..86d46e9 100644
--- a/src/Quasar/Disposable.hs
+++ b/src/Quasar/Disposable.hs
@@ -297,7 +297,7 @@ collectGarbage resourceManager = go
-- Wait for any entry to complete or until a new entry is added
let awaitables = (toAwaitable <$> toList snapshot)
-- GC fails here when an waitable throws an exception
- void $ await if Quasar.Prelude.null awaitables
+ void if Quasar.Prelude.null awaitables
then awaitAny2 listChanged isDisposing
else awaitAny (listChanged :| awaitables)
diff --git a/src/Quasar/Timer.hs b/src/Quasar/Timer.hs
index ad20f2f..b05bfaa 100644
--- a/src/Quasar/Timer.hs
+++ b/src/Quasar/Timer.hs
@@ -136,7 +136,7 @@ startSchedulerThread scheduler = do
wait :: Timer -> Int -> IO ()
wait nextTimer microseconds = do
delay <- toAwaitable <$> newDelay resourceManager' microseconds
- await $ awaitAny2 delay nextTimerChanged
+ awaitAny2 delay nextTimerChanged
where
nextTimerChanged :: Awaitable ()
nextTimerChanged = unsafeAwaitSTM do
diff --git a/test/Quasar/AwaitableSpec.hs b/test/Quasar/AwaitableSpec.hs
index 1e4666b..e2b7c45 100644
--- a/test/Quasar/AwaitableSpec.hs
+++ b/test/Quasar/AwaitableSpec.hs
@@ -38,7 +38,7 @@ spec = parallel $ do
describe "awaitAny" $ do
it "works with completed awaitables" $ do
- await (awaitAny2 (pure () :: Awaitable ()) (pure () :: Awaitable ())) :: IO ()
+ awaitAny2 (pure () :: Awaitable ()) (pure () :: Awaitable ()) :: IO ()
it "can be completed later" $ do
avar1 <- newAsyncVar :: IO (AsyncVar ())
@@ -46,7 +46,7 @@ spec = parallel $ do
void $ forkIO $ do
threadDelay 100000
putAsyncVar_ avar1 ()
- await (awaitAny2 avar1 avar2)
+ awaitAny2 avar1 avar2
it "can be completed later by the second parameter" $ do
avar1 <- newAsyncVar :: IO (AsyncVar ())
@@ -54,4 +54,4 @@ spec = parallel $ do
void $ forkIO $ do
threadDelay 100000
putAsyncVar_ avar2 ()
- await (awaitAny2 avar1 avar2)
+ awaitAny2 avar1 avar2
--
GitLab