From 92836008362c93b70eb954e52e64b3bec5e3566f Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Sun, 27 Feb 2022 03:19:17 +0100
Subject: [PATCH] Rename AsyncVar to Promise
Co-authored-by: Jan Beinke <git@janbeinke.com>
---
src/Quasar/Async.hs | 16 ++--
src/Quasar/Async/Fork.hs | 8 +-
src/Quasar/Async/STMHelper.hs | 8 +-
src/Quasar/Exceptions.hs | 7 ++
src/Quasar/Future.hs | 128 ++++++++++++++++---------------
src/Quasar/Resources/Disposer.hs | 14 ++--
src/Quasar/Timer.hs | 12 +--
src/Quasar/Utils/ShortIO.hs | 12 +--
test/Quasar/AsyncSpec.hs | 6 +-
test/Quasar/AwaitableSpec.hs | 28 +++----
10 files changed, 124 insertions(+), 115 deletions(-)
diff --git a/src/Quasar/Async.hs b/src/Quasar/Async.hs
index a42dbe6..42ec041 100644
--- a/src/Quasar/Async.hs
+++ b/src/Quasar/Async.hs
@@ -70,8 +70,8 @@ asyncWithUnmask' fn = maskIfRequired do
(key, resultVar, threadIdVar, disposer) <- ensureSTM do
key <- newUniqueSTM
- resultVar <- newAsyncVarSTM
- threadIdVar <- newAsyncVarSTM
+ resultVar <- newPromiseSTM
+ threadIdVar <- newPromiseSTM
-- Disposer is created first to ensure the resource can be safely attached
disposer <- newUnmanagedPrimitiveDisposer (disposeFn key resultVar (toFuture threadIdVar)) worker exChan
pure (key, resultVar, threadIdVar, disposer)
@@ -80,26 +80,26 @@ asyncWithUnmask' fn = maskIfRequired do
startShortIO_ do
threadId <- forkWithUnmaskShortIO (runAndPut exChan key resultVar disposer) exChan
- putAsyncVarShortIO_ threadIdVar threadId
+ fulfillPromiseShortIO threadIdVar threadId
pure $ Async (toFuture resultVar) disposer
where
- runAndPut :: ExceptionSink -> Unique -> AsyncVar a -> Disposer -> (forall b. IO b -> IO b) -> IO ()
+ runAndPut :: ExceptionSink -> Unique -> Promise a -> Disposer -> (forall b. IO b -> IO b) -> IO ()
runAndPut exChan key resultVar disposer unmask = do
-- Called in masked state by `forkWithUnmask`
result <- try $ fn unmask
case result of
Left (fromException -> Just (CancelAsync ((== key) -> True))) ->
- failAsyncVar_ resultVar AsyncDisposed
+ breakPromise resultVar AsyncDisposed
Left ex -> do
atomically (throwToExceptionSink exChan ex)
`finally` do
- failAsyncVar_ resultVar (AsyncException ex)
+ breakPromise resultVar (AsyncException ex)
atomically $ disposeEventuallySTM_ disposer
Right retVal -> do
- putAsyncVar_ resultVar retVal
+ fulfillPromise resultVar retVal
atomically $ disposeEventuallySTM_ disposer
- disposeFn :: Unique -> AsyncVar a -> Future ThreadId -> ShortIO (Future ())
+ disposeFn :: Unique -> Promise a -> Future ThreadId -> ShortIO (Future ())
disposeFn key resultVar threadIdFuture = do
-- Should not block or fail (unless the TIOWorker is broken)
threadId <- unsafeShortIO $ await threadIdFuture
diff --git a/src/Quasar/Async/Fork.hs b/src/Quasar/Async/Fork.hs
index 87fad05..6bfee5d 100644
--- a/src/Quasar/Async/Fork.hs
+++ b/src/Quasar/Async/Fork.hs
@@ -67,11 +67,11 @@ forkAsyncShortIO fn = forkAsyncWithUnmaskShortIO ($ fn)
forkAsyncWithUnmaskShortIO :: forall a. ((forall b. IO b -> IO b) -> IO a) -> ExceptionSink -> ShortIO (Future a)
forkAsyncWithUnmaskShortIO fn exChan = do
- resultVar <- newAsyncVarShortIO
+ resultVar <- newPromiseShortIO
forkWithUnmaskShortIO_ (runAndPut resultVar) exChan
pure $ toFuture resultVar
where
- runAndPut :: AsyncVar a -> (forall b. IO b -> IO b) -> IO ()
+ runAndPut :: Promise a -> (forall b. IO b -> IO b) -> IO ()
runAndPut resultVar unmask = do
-- Called in masked state by `forkWithUnmaskShortIO`
result <- try $ fn unmask
@@ -79,6 +79,6 @@ forkAsyncWithUnmaskShortIO fn exChan = do
Left ex ->
atomically (throwToExceptionSink exChan ex)
`finally`
- failAsyncVar_ resultVar (AsyncException ex)
+ breakPromise resultVar (AsyncException ex)
Right retVal -> do
- putAsyncVar_ resultVar retVal
+ fulfillPromise resultVar retVal
diff --git a/src/Quasar/Async/STMHelper.hs b/src/Quasar/Async/STMHelper.hs
index b0e421c..b042a91 100644
--- a/src/Quasar/Async/STMHelper.hs
+++ b/src/Quasar/Async/STMHelper.hs
@@ -21,17 +21,17 @@ newtype TIOWorker = TIOWorker (TQueue (IO ()))
startShortIOSTM :: forall a. ShortIO a -> TIOWorker -> ExceptionSink -> STM (Future a)
startShortIOSTM fn (TIOWorker jobQueue) exChan = do
- resultVar <- newAsyncVarSTM
+ resultVar <- newPromiseSTM
writeTQueue jobQueue $ job resultVar
pure $ toFuture resultVar
where
- job :: AsyncVar a -> IO ()
+ job :: Promise a -> IO ()
job resultVar = do
try (runShortIO fn) >>= \case
Left ex -> do
atomically $ throwToExceptionSink exChan ex
- failAsyncVar_ resultVar $ toException $ AsyncException ex
- Right result -> putAsyncVar_ resultVar result
+ breakPromise resultVar $ toException $ AsyncException ex
+ Right result -> fulfillPromise resultVar result
startShortIOSTM_ :: ShortIO () -> TIOWorker -> ExceptionSink -> STM ()
startShortIOSTM_ x y z = void $ startShortIOSTM x y z
diff --git a/src/Quasar/Exceptions.hs b/src/Quasar/Exceptions.hs
index bda0705..f87969d 100644
--- a/src/Quasar/Exceptions.hs
+++ b/src/Quasar/Exceptions.hs
@@ -16,6 +16,7 @@ module Quasar.Exceptions (
isFailedToAttachResource,
AlreadyDisposing(..),
isAlreadyDisposing,
+ PromiseAlreadyCompleted(..),
) where
import Control.Concurrent.STM
@@ -100,3 +101,9 @@ instance Exception AlreadyDisposing where
isAlreadyDisposing :: SomeException -> Bool
isAlreadyDisposing (fromException @AlreadyDisposing -> Just _) = True
isAlreadyDisposing _ = False
+
+
+
+data PromiseAlreadyCompleted = PromiseAlreadyCompleted
+ deriving stock Show
+ deriving anyclass Exception
diff --git a/src/Quasar/Future.hs b/src/Quasar/Future.hs
index f851712..8fc4d06 100644
--- a/src/Quasar/Future.hs
+++ b/src/Quasar/Future.hs
@@ -22,28 +22,29 @@ module Quasar.Future (
awaitAny2,
awaitEither,
- -- * AsyncVar
- AsyncVar,
-
- -- ** Manage `AsyncVar`s in IO
- newAsyncVar,
- putAsyncVarEither,
- putAsyncVar,
- putAsyncVar_,
- failAsyncVar,
- failAsyncVar_,
- putAsyncVarEither_,
-
- -- ** Manage `AsyncVar`s in STM
- newAsyncVarSTM,
- putAsyncVarEitherSTM,
- putAsyncVarSTM,
- putAsyncVarSTM_,
- failAsyncVarSTM,
- failAsyncVarSTM_,
- putAsyncVarEitherSTM_,
- readAsyncVarSTM,
- tryReadAsyncVarSTM,
+ -- * Promise
+ Promise,
+
+ -- ** Manage `Promise`s in IO
+ newPromise,
+ fulfillPromise,
+ breakPromise,
+ completePromise,
+
+ tryFulfillPromise,
+ tryBreakPromise,
+ tryCompletePromise,
+
+ -- ** Manage `Promise`s in STM
+ newPromiseSTM,
+ fulfillPromiseSTM,
+ breakPromiseSTM,
+ completePromiseSTM,
+ peekPromiseSTM,
+
+ tryFulfillPromiseSTM,
+ tryBreakPromiseSTM,
+ tryCompletePromiseSTM,
-- ** Unsafe implementation helpers
unsafeSTMToFuture,
@@ -59,6 +60,7 @@ import Control.Monad.State (StateT)
import Control.Monad.RWS (RWST)
import Control.Monad.Trans.Maybe
import Quasar.Prelude
+import Quasar.Exceptions
class (MonadCatch m, MonadPlus m, MonadFix m) => MonadAwait m where
@@ -80,7 +82,7 @@ instance MonadAwait IO where
-- | `awaitSTM` exists as an explicit alternative to a `Future STM`-instance, to prevent code which creates- and
-- then awaits resources without knowing it's running in STM (which would block indefinitely when run in STM).
-awaitSTM :: Future a -> STM a
+awaitSTM :: IsFuture r a => a -> STM r
awaitSTM (toFuture -> Future x) =
x `catch` \BlockedIndefinitelyOnSTM -> throwM BlockedIndefinitelyOnAwait
@@ -170,66 +172,66 @@ failedFuture = throwM
--- ** AsyncVar
+-- ** Promise
-- | The default implementation for an `Future` that can be fulfilled later.
-newtype AsyncVar r = AsyncVar (TMVar (Either SomeException r))
+newtype Promise r = Promise (TMVar (Either SomeException r))
-instance IsFuture r (AsyncVar r) where
- toFuture (AsyncVar var) = unsafeSTMToFuture $ either throwM pure =<< readTMVar var
+instance IsFuture r (Promise r) where
+ toFuture (Promise var) = unsafeSTMToFuture $ either throwM pure =<< readTMVar var
-newAsyncVarSTM :: STM (AsyncVar r)
-newAsyncVarSTM = AsyncVar <$> newEmptyTMVar
+newPromiseSTM :: STM (Promise r)
+newPromiseSTM = Promise <$> newEmptyTMVar
-newAsyncVar :: MonadIO m => m (AsyncVar r)
-newAsyncVar = liftIO $ AsyncVar <$> newEmptyTMVarIO
+newPromise :: MonadIO m => m (Promise r)
+newPromise = liftIO $ Promise <$> newEmptyTMVarIO
-putAsyncVarEither :: forall a m. MonadIO m => AsyncVar a -> Either SomeException a -> m Bool
-putAsyncVarEither var = liftIO . atomically . putAsyncVarEitherSTM var
+completePromiseSTM :: Promise a -> Either SomeException a -> STM ()
+completePromiseSTM var result = do
+ success <- tryCompletePromiseSTM var result
+ unless success $ throwM PromiseAlreadyCompleted
-putAsyncVarEitherSTM :: AsyncVar a -> Either SomeException a -> STM Bool
-putAsyncVarEitherSTM (AsyncVar var) = tryPutTMVar var
+tryCompletePromiseSTM :: Promise a -> Either SomeException a -> STM Bool
+tryCompletePromiseSTM (Promise var) = tryPutTMVar var
--- | Get the value of an `AsyncVar` in `STM`. Will retry until the AsyncVar is fulfilled.
-readAsyncVarSTM :: AsyncVar a -> STM a
-readAsyncVarSTM (AsyncVar var) = either throwM pure =<< readTMVar var
+peekPromiseSTM :: forall a. Promise a -> STM (Maybe a)
+peekPromiseSTM (Promise var) = mapM (either throwM pure) =<< tryReadTMVar var
-tryReadAsyncVarSTM :: forall a. AsyncVar a -> STM (Maybe a)
-tryReadAsyncVarSTM (AsyncVar var) = mapM (either throwM pure) =<< tryReadTMVar var
+fulfillPromise :: MonadIO m => Promise a -> a -> m ()
+fulfillPromise var result = liftIO $ atomically $ fulfillPromiseSTM var result
-putAsyncVar :: MonadIO m => AsyncVar a -> a -> m Bool
-putAsyncVar var = putAsyncVarEither var . Right
+fulfillPromiseSTM :: Promise a -> a -> STM ()
+fulfillPromiseSTM var result = completePromiseSTM var (Right result)
-putAsyncVarSTM :: AsyncVar a -> a -> STM Bool
-putAsyncVarSTM var = putAsyncVarEitherSTM var . Right
+breakPromise :: (Exception e, MonadIO m) => Promise a -> e -> m ()
+breakPromise var result = liftIO $ atomically $ breakPromiseSTM var result
-putAsyncVar_ :: MonadIO m => AsyncVar a -> a -> m ()
-putAsyncVar_ var = void . putAsyncVar var
+breakPromiseSTM :: Exception e => Promise a -> e -> STM ()
+breakPromiseSTM var result = completePromiseSTM var (Left (toException result))
-putAsyncVarSTM_ :: AsyncVar a -> a -> STM ()
-putAsyncVarSTM_ var = void . putAsyncVarSTM var
+completePromise :: MonadIO m => Promise a -> Either SomeException a -> m ()
+completePromise var result = liftIO $ atomically $ completePromiseSTM var result
-failAsyncVar :: (Exception e, MonadIO m) => AsyncVar a -> e -> m Bool
-failAsyncVar var = putAsyncVarEither var . Left . toException
-failAsyncVarSTM :: Exception e => AsyncVar a -> e -> STM Bool
-failAsyncVarSTM var = putAsyncVarEitherSTM var . Left . toException
-failAsyncVar_ :: (Exception e, MonadIO m) => AsyncVar a -> e -> m ()
-failAsyncVar_ var = void . failAsyncVar var
+tryFulfillPromise :: MonadIO m => Promise a -> a -> m Bool
+tryFulfillPromise var result = liftIO $ atomically $ tryFulfillPromiseSTM var result
-failAsyncVarSTM_ :: Exception e => AsyncVar a -> e -> STM ()
-failAsyncVarSTM_ var = void . failAsyncVarSTM var
+tryFulfillPromiseSTM :: Promise a -> a -> STM Bool
+tryFulfillPromiseSTM var result = tryCompletePromiseSTM var (Right result)
-putAsyncVarEither_ :: MonadIO m => AsyncVar a -> Either SomeException a -> m ()
-putAsyncVarEither_ var = void . putAsyncVarEither var
+tryBreakPromise :: (Exception e, MonadIO m) => Promise a -> e -> m Bool
+tryBreakPromise var result = liftIO $ atomically $ tryBreakPromiseSTM var result
-putAsyncVarEitherSTM_ :: AsyncVar a -> Either SomeException a -> STM ()
-putAsyncVarEitherSTM_ var = void . putAsyncVarEitherSTM var
+tryBreakPromiseSTM :: Exception e => Promise a -> e -> STM Bool
+tryBreakPromiseSTM var result = tryCompletePromiseSTM var (Left (toException result))
+
+tryCompletePromise :: MonadIO m => Promise a -> Either SomeException a -> m Bool
+tryCompletePromise var result = liftIO $ atomically $ tryCompletePromiseSTM var result
@@ -244,14 +246,14 @@ awaitSuccessOrFailure = await . fireAndForget . toFuture
afix :: (MonadIO m, MonadCatch m) => (Future a -> m a) -> m a
afix action = do
- var <- newAsyncVar
+ var <- newPromise
catchAll
do
result <- action (toFuture var)
- putAsyncVar_ var result
+ fulfillPromise var result
pure result
\ex -> do
- failAsyncVar_ var ex
+ breakPromise var ex
throwM ex
afix_ :: (MonadIO m, MonadCatch m) => (Future a -> m a) -> m ()
diff --git a/src/Quasar/Resources/Disposer.hs b/src/Quasar/Resources/Disposer.hs
index 12b8e95..665a440 100644
--- a/src/Quasar/Resources/Disposer.hs
+++ b/src/Quasar/Resources/Disposer.hs
@@ -90,20 +90,20 @@ beginDisposeFnDisposer worker exChan disposeState finalizers =
where
startDisposeFn :: DisposeFn -> STM (Future ())
startDisposeFn disposeFn = do
- awaitableVar <- newAsyncVarSTM
+ awaitableVar <- newPromiseSTM
startShortIOSTM_ (runDisposeFn awaitableVar disposeFn) worker exChan
pure $ join (toFuture awaitableVar)
- runDisposeFn :: AsyncVar (Future ()) -> DisposeFn -> ShortIO ()
+ runDisposeFn :: Promise (Future ()) -> DisposeFn -> ShortIO ()
runDisposeFn awaitableVar disposeFn = mask_ $ handleAll exceptionHandler do
awaitable <- disposeFn
- putAsyncVarShortIO_ awaitableVar awaitable
+ fulfillPromiseShortIO awaitableVar awaitable
runFinalizersAfter finalizers awaitable
where
-- In case of an exception mark disposable as completed to prevent resource managers from being stuck indefinitely
exceptionHandler :: SomeException -> ShortIO ()
exceptionHandler ex = do
- putAsyncVarShortIO_ awaitableVar (pure ())
+ fulfillPromiseShortIO awaitableVar (pure ())
runFinalizersShortIO finalizers
throwM $ DisposeException ex
@@ -189,7 +189,7 @@ beginDisposeResourceManagerInternal :: ResourceManager -> STM DisposeDependencie
beginDisposeResourceManagerInternal rm = do
readTVar (resourceManagerState rm) >>= \case
ResourceManagerNormal attachedResources worker exChan -> do
- dependenciesVar <- newAsyncVarSTM
+ dependenciesVar <- newPromiseSTM
writeTVar (resourceManagerState rm) (ResourceManagerDisposing (toFuture dependenciesVar))
attachedDisposers <- HM.elems <$> readTVar attachedResources
startShortIOSTM_ (void $ forkIOShortIO (disposeThread dependenciesVar attachedDisposers)) worker exChan
@@ -197,14 +197,14 @@ beginDisposeResourceManagerInternal rm = do
ResourceManagerDisposing deps -> pure $ DisposeDependencies rmKey deps
ResourceManagerDisposed -> pure $ DisposeDependencies rmKey mempty
where
- disposeThread :: AsyncVar [DisposeDependencies] -> [Disposer] -> IO ()
+ disposeThread :: Promise [DisposeDependencies] -> [Disposer] -> IO ()
disposeThread dependenciesVar attachedDisposers = do
-- Begin to dispose all attached resources
results <- mapM (atomically . resourceManagerBeginDispose) attachedDisposers
-- Await direct resource awaitables and collect indirect dependencies
dependencies <- await (collectDependencies results)
-- Publish "direct dependencies complete"-status
- putAsyncVar_ dependenciesVar dependencies
+ fulfillPromise dependenciesVar dependencies
-- Await indirect dependencies
awaitDisposeDependencies $ DisposeDependencies rmKey (pure dependencies)
-- Set state to disposed and run finalizers
diff --git a/src/Quasar/Timer.hs b/src/Quasar/Timer.hs
index d7d6faf..44e359b 100644
--- a/src/Quasar/Timer.hs
+++ b/src/Quasar/Timer.hs
@@ -39,7 +39,7 @@ instance Exception TimerCancelled
data Timer = Timer {
key :: Unique,
time :: UTCTime,
- completed :: AsyncVar (),
+ completed :: Promise (),
disposer :: Disposer,
scheduler :: TimerScheduler
}
@@ -149,7 +149,7 @@ startSchedulerThread scheduler = getDisposer <$> async (schedulerThread `finally
fireTimer :: Timer -> STM ()
fireTimer Timer{completed, disposer} = do
- result <- putAsyncVarSTM completed ()
+ result <- tryFulfillPromiseSTM completed ()
modifyTVar (if result then activeCount' else cancelledCount') (+ (-1))
disposeEventuallySTM_ disposer
@@ -158,7 +158,7 @@ startSchedulerThread scheduler = getDisposer <$> async (schedulerThread `finally
cleanupTimer :: Timer -> STM (Maybe Timer)
cleanupTimer timer = do
- cancelled <- ((False <$ readAsyncVarSTM (completed timer)) `catch` \TimerCancelled -> pure True) `orElse` pure False
+ cancelled <- ((False <$ awaitSTM (completed timer)) `catch` \TimerCancelled -> pure True) `orElse` pure False
if cancelled
then do
modifyTVar cancelledCount' (+ (-1))
@@ -178,7 +178,7 @@ newTimer scheduler time = registerNewResource $ newUnmanagedTimer scheduler time
newUnmanagedTimer :: MonadIO m => TimerScheduler -> UTCTime -> m Timer
newUnmanagedTimer scheduler time = liftIO do
key <- newUnique
- completed <- newAsyncVar
+ completed <- newPromise
atomically do
disposer <- newUnmanagedSTMDisposerSTM (disposeFn completed) (ioWorker scheduler) (exceptionSink scheduler)
let timer = Timer { key, time, completed, disposer, scheduler }
@@ -188,9 +188,9 @@ newUnmanagedTimer scheduler time = liftIO do
modifyTVar (activeCount scheduler) (+ 1)
pure timer
where
- disposeFn :: AsyncVar () -> STM ()
+ disposeFn :: Promise () -> STM ()
disposeFn completed = do
- cancelled <- failAsyncVarSTM completed TimerCancelled
+ cancelled <- tryBreakPromiseSTM completed TimerCancelled
when cancelled do
modifyTVar (activeCount scheduler) (+ (-1))
modifyTVar (cancelledCount scheduler) (+ 1)
diff --git a/src/Quasar/Utils/ShortIO.hs b/src/Quasar/Utils/ShortIO.hs
index 045a921..87d1123 100644
--- a/src/Quasar/Utils/ShortIO.hs
+++ b/src/Quasar/Utils/ShortIO.hs
@@ -10,8 +10,8 @@ module Quasar.Utils.ShortIO (
-- ** Some specific functions required internally
peekFutureShortIO,
- newAsyncVarShortIO,
- putAsyncVarShortIO_,
+ newPromiseShortIO,
+ fulfillPromiseShortIO,
) where
import Control.Monad.Catch
@@ -45,8 +45,8 @@ newUniqueShortIO = ShortIO newUnique
peekFutureShortIO :: Future r -> ShortIO (Maybe r)
peekFutureShortIO awaitable = ShortIO $ peekFuture awaitable
-newAsyncVarShortIO :: ShortIO (AsyncVar a)
-newAsyncVarShortIO = ShortIO newAsyncVar
+newPromiseShortIO :: ShortIO (Promise a)
+newPromiseShortIO = ShortIO newPromise
-putAsyncVarShortIO_ :: AsyncVar a -> a -> ShortIO ()
-putAsyncVarShortIO_ var value = ShortIO $ putAsyncVar_ var value
+fulfillPromiseShortIO :: Promise a -> a -> ShortIO ()
+fulfillPromiseShortIO var value = ShortIO $ fulfillPromise var value
diff --git a/test/Quasar/AsyncSpec.hs b/test/Quasar/AsyncSpec.hs
index 3844c7a..32e6bc7 100644
--- a/test/Quasar/AsyncSpec.hs
+++ b/test/Quasar/AsyncSpec.hs
@@ -22,17 +22,17 @@ spec = describe "async" $ it "async" $ pendingWith "moving to new implementation
--
-- describe "await" $ do
-- it "can await the result of an async that is completed later" $ do
--- avar <- newAsyncVar :: IO (AsyncVar ())
+-- avar <- newPromise :: IO (Promise ())
-- void $ forkIO $ do
-- threadDelay 100000
--- putAsyncVar_ avar ()
+-- fulfillPromise avar ()
-- await avar
--
-- it "can fmap the result of an already finished async" $ do
-- await (pure () :: Future ()) :: IO ()
--
-- it "can terminate when encountering an asynchronous exception" $ do
--- never <- newAsyncVar :: IO (AsyncVar ())
+-- never <- newPromise :: IO (Promise ())
--
-- result <- timeout 100000 $ withRootResourceManager $
-- await never
diff --git a/test/Quasar/AwaitableSpec.hs b/test/Quasar/AwaitableSpec.hs
index 99ca91b..e526396 100644
--- a/test/Quasar/AwaitableSpec.hs
+++ b/test/Quasar/AwaitableSpec.hs
@@ -19,26 +19,26 @@ spec = parallel $ do
it "can await pure values" $ do
await $ (pure () :: Future ()) :: IO ()
- describe "AsyncVar" $ do
+ describe "Promise" $ do
it "can be created" $ do
- _ <- newAsyncVar :: IO (AsyncVar ())
+ _ <- newPromise :: IO (Promise ())
pure ()
it "accepts a value" $ do
- avar <- newAsyncVar :: IO (AsyncVar ())
- putAsyncVar_ avar ()
+ avar <- newPromise :: IO (Promise ())
+ fulfillPromise avar ()
it "can be awaited" $ do
- avar <- newAsyncVar :: IO (AsyncVar ())
- putAsyncVar_ avar ()
+ avar <- newPromise :: IO (Promise ())
+ fulfillPromise avar ()
await avar
it "can be awaited when completed asynchronously" $ do
- avar <- newAsyncVar :: IO (AsyncVar ())
+ avar <- newPromise :: IO (Promise ())
void $ forkIO $ do
threadDelay 100000
- putAsyncVar_ avar ()
+ fulfillPromise avar ()
await avar
@@ -48,17 +48,17 @@ spec = parallel $ do
awaitAny2 (pure () :: Future ()) (pure () :: Future ()) :: IO ()
it "can be completed later" $ do
- avar1 <- newAsyncVar :: IO (AsyncVar ())
- avar2 <- newAsyncVar :: IO (AsyncVar ())
+ avar1 <- newPromise :: IO (Promise ())
+ avar2 <- newPromise :: IO (Promise ())
void $ forkIO $ do
threadDelay 100000
- putAsyncVar_ avar1 ()
+ fulfillPromise avar1 ()
awaitAny2 (await avar1) (await avar2)
it "can be completed later by the second parameter" $ do
- avar1 <- newAsyncVar :: IO (AsyncVar ())
- avar2 <- newAsyncVar :: IO (AsyncVar ())
+ avar1 <- newPromise :: IO (Promise ())
+ avar2 <- newPromise :: IO (Promise ())
void $ forkIO $ do
threadDelay 100000
- putAsyncVar_ avar2 ()
+ fulfillPromise avar2 ()
awaitAny2 (await avar1) (await avar2)
--
GitLab