diff --git a/src/Quasar/Awaitable.hs b/src/Quasar/Awaitable.hs index a595221e601880c5b3c2ee815d95ca7e3adbaba7..3d24bbd37173250da085fd599cce5f93e0024c8a 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 2c1182461d7f9e91aa9ccc72d68a7eb641fcc24f..86d46e9735829940c2659b15b133fc64f4312225 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 ad20f2ff473dce58d604977522c4ce3bc0ede316..b05bfaa1222837542bf2d2f64b8c169931bccc69 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 1e4666b89eac24cb60d54fcc2c3f0d9e6ecf6b19..e2b7c45ed76d491cf989693ff3e8f53a5b4d625d 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