diff --git a/src/Quasar/Async.hs b/src/Quasar/Async.hs index 76fd3483d4cf79cfdc3354f8cff66136c72ba793..a42dbe63415d51b67bb2d2bb30fd6aff6b4cf84b 100644 --- a/src/Quasar/Async.hs +++ b/src/Quasar/Async.hs @@ -31,13 +31,13 @@ import Quasar.Utils.ShortIO import Control.Monad.Reader -data Async a = Async (Awaitable a) Disposer +data Async a = Async (Future a) Disposer instance Resource (Async a) where getDisposer (Async _ disposer) = disposer -instance IsAwaitable a (Async a) where - toAwaitable (Async awaitable _) = awaitable +instance IsFuture a (Async a) where + toFuture (Async awaitable _) = awaitable async :: MonadQuasar m => QuasarIO a -> m (Async a) @@ -73,7 +73,7 @@ asyncWithUnmask' fn = maskIfRequired do resultVar <- newAsyncVarSTM threadIdVar <- newAsyncVarSTM -- Disposer is created first to ensure the resource can be safely attached - disposer <- newUnmanagedPrimitiveDisposer (disposeFn key resultVar (toAwaitable threadIdVar)) worker exChan + disposer <- newUnmanagedPrimitiveDisposer (disposeFn key resultVar (toFuture threadIdVar)) worker exChan pure (key, resultVar, threadIdVar, disposer) registerResource disposer @@ -82,7 +82,7 @@ asyncWithUnmask' fn = maskIfRequired do threadId <- forkWithUnmaskShortIO (runAndPut exChan key resultVar disposer) exChan putAsyncVarShortIO_ threadIdVar threadId - pure $ Async (toAwaitable resultVar) disposer + pure $ Async (toFuture resultVar) disposer where runAndPut :: ExceptionSink -> Unique -> AsyncVar a -> Disposer -> (forall b. IO b -> IO b) -> IO () runAndPut exChan key resultVar disposer unmask = do @@ -99,10 +99,10 @@ asyncWithUnmask' fn = maskIfRequired do Right retVal -> do putAsyncVar_ resultVar retVal atomically $ disposeEventuallySTM_ disposer - disposeFn :: Unique -> AsyncVar a -> Awaitable ThreadId -> ShortIO (Awaitable ()) - disposeFn key resultVar threadIdAwaitable = do + disposeFn :: Unique -> AsyncVar a -> Future ThreadId -> ShortIO (Future ()) + disposeFn key resultVar threadIdFuture = do -- Should not block or fail (unless the TIOWorker is broken) - threadId <- unsafeShortIO $ await threadIdAwaitable + threadId <- unsafeShortIO $ await threadIdFuture throwToShortIO threadId (CancelAsync key) -- Considered complete once a result (i.e. success or failure) has been stored pure (awaitSuccessOrFailure resultVar) diff --git a/src/Quasar/Async/Fork.hs b/src/Quasar/Async/Fork.hs index 17afe6ff62c949bf342d01132ac12c64f124e50f..87fad0530b4d768de51603da945b1601434e49ed 100644 --- a/src/Quasar/Async/Fork.hs +++ b/src/Quasar/Async/Fork.hs @@ -27,24 +27,24 @@ import Quasar.Utils.ShortIO -- * Fork in STM (with ExceptionSink) -forkSTM :: IO () -> TIOWorker -> ExceptionSink -> STM (Awaitable ThreadId) +forkSTM :: IO () -> TIOWorker -> ExceptionSink -> STM (Future ThreadId) forkSTM fn = forkWithUnmaskSTM (\unmask -> unmask fn) forkSTM_ :: IO () -> TIOWorker -> ExceptionSink -> STM () forkSTM_ fn worker exChan = void $ forkSTM fn worker exChan -forkWithUnmaskSTM :: ((forall a. IO a -> IO a) -> IO ()) -> TIOWorker -> ExceptionSink -> STM (Awaitable ThreadId) +forkWithUnmaskSTM :: ((forall a. IO a -> IO a) -> IO ()) -> TIOWorker -> ExceptionSink -> STM (Future ThreadId) forkWithUnmaskSTM fn worker exChan = startShortIOSTM (forkWithUnmaskShortIO fn exChan) worker exChan forkWithUnmaskSTM_ :: ((forall a. IO a -> IO a) -> IO ()) -> TIOWorker -> ExceptionSink -> STM () forkWithUnmaskSTM_ fn worker exChan = void $ forkWithUnmaskSTM fn worker exChan -forkAsyncSTM :: forall a. IO a -> TIOWorker -> ExceptionSink -> STM (Awaitable a) +forkAsyncSTM :: forall a. IO a -> TIOWorker -> ExceptionSink -> STM (Future a) forkAsyncSTM fn worker exChan = join <$> startShortIOSTM (forkAsyncShortIO fn exChan) worker exChan -forkAsyncWithUnmaskSTM :: forall a. ((forall b. IO b -> IO b) -> IO a) -> TIOWorker -> ExceptionSink -> STM (Awaitable a) +forkAsyncWithUnmaskSTM :: forall a. ((forall b. IO b -> IO b) -> IO a) -> TIOWorker -> ExceptionSink -> STM (Future a) forkAsyncWithUnmaskSTM fn worker exChan = join <$> startShortIOSTM (forkAsyncWithUnmaskShortIO fn exChan) worker exChan @@ -62,14 +62,14 @@ forkWithUnmaskShortIO_ fn exChan = void $ forkWithUnmaskShortIO fn exChan -- * Fork in ShortIO while collecting the result (with ExceptionSink) -forkAsyncShortIO :: forall a. IO a -> ExceptionSink -> ShortIO (Awaitable a) +forkAsyncShortIO :: forall a. IO a -> ExceptionSink -> ShortIO (Future a) forkAsyncShortIO fn = forkAsyncWithUnmaskShortIO ($ fn) -forkAsyncWithUnmaskShortIO :: forall a. ((forall b. IO b -> IO b) -> IO a) -> ExceptionSink -> ShortIO (Awaitable a) +forkAsyncWithUnmaskShortIO :: forall a. ((forall b. IO b -> IO b) -> IO a) -> ExceptionSink -> ShortIO (Future a) forkAsyncWithUnmaskShortIO fn exChan = do resultVar <- newAsyncVarShortIO forkWithUnmaskShortIO_ (runAndPut resultVar) exChan - pure $ toAwaitable resultVar + pure $ toFuture resultVar where runAndPut :: AsyncVar a -> (forall b. IO b -> IO b) -> IO () runAndPut resultVar unmask = do diff --git a/src/Quasar/Async/STMHelper.hs b/src/Quasar/Async/STMHelper.hs index aa5560f6b15862a85f6a0ffe06a0e7cffca94c3a..b0e421c6a91f0b1bad37ea3eb92ad2ed1391ccd8 100644 --- a/src/Quasar/Async/STMHelper.hs +++ b/src/Quasar/Async/STMHelper.hs @@ -19,11 +19,11 @@ import Quasar.Utils.ShortIO newtype TIOWorker = TIOWorker (TQueue (IO ())) -startShortIOSTM :: forall a. ShortIO a -> TIOWorker -> ExceptionSink -> STM (Awaitable a) +startShortIOSTM :: forall a. ShortIO a -> TIOWorker -> ExceptionSink -> STM (Future a) startShortIOSTM fn (TIOWorker jobQueue) exChan = do resultVar <- newAsyncVarSTM writeTQueue jobQueue $ job resultVar - pure $ toAwaitable resultVar + pure $ toFuture resultVar where job :: AsyncVar a -> IO () job resultVar = do diff --git a/src/Quasar/Future.hs b/src/Quasar/Future.hs index 3e1675d862ecdfc7443c00ad076b3a6e6c0ebfb2..f8517129978a7bb95a7744efff7f2ba65864b134 100644 --- a/src/Quasar/Future.hs +++ b/src/Quasar/Future.hs @@ -1,18 +1,18 @@ module Quasar.Future ( - -- * MonadAwaitable + -- * MonadAwait MonadAwait(..), - peekAwaitable, - peekAwaitableSTM, + peekFuture, + peekFutureSTM, awaitSTM, - -- * Awaitable - IsAwaitable(toAwaitable), - Awaitable, - successfulAwaitable, - failedAwaitable, - completedAwaitable, + -- * Future + IsFuture(toFuture), + Future, + successfulFuture, + failedFuture, + completedFuture, - -- * Awaitable helpers + -- * Future helpers afix, afix_, awaitSuccessOrFailure, @@ -46,7 +46,7 @@ module Quasar.Future ( tryReadAsyncVarSTM, -- ** Unsafe implementation helpers - unsafeSTMToAwaitable, + unsafeSTMToFuture, unsafeAwaitSTM, ) where @@ -63,7 +63,7 @@ import Quasar.Prelude class (MonadCatch m, MonadPlus m, MonadFix m) => MonadAwait m where -- | Wait until an awaitable is completed and then return it's value (or throw an exception). - await :: IsAwaitable r a => a -> m r + await :: IsFuture r a => a -> m r data BlockedIndefinitelyOnAwait = BlockedIndefinitelyOnAwait deriving stock Show @@ -73,15 +73,15 @@ instance Exception BlockedIndefinitelyOnAwait where instance MonadAwait IO where - await (toAwaitable -> Awaitable x) = + await (toFuture -> Future x) = atomically x `catch` \BlockedIndefinitelyOnSTM -> throwM BlockedIndefinitelyOnAwait --- | `awaitSTM` exists as an explicit alternative to an `Awaitable STM`-instance, to prevent code which creates- and +-- | `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 :: Awaitable a -> STM a -awaitSTM (toAwaitable -> Awaitable x) = +awaitSTM :: Future a -> STM a +awaitSTM (toFuture -> Future x) = x `catch` \BlockedIndefinitelyOnSTM -> throwM BlockedIndefinitelyOnAwait instance MonadAwait m => MonadAwait (ReaderT a m) where @@ -103,31 +103,31 @@ instance MonadAwait m => MonadAwait (MaybeT m) where -- | Returns the result (in a `Just`) when the awaitable is completed, throws an `Exception` when the awaitable is -- failed and returns `Nothing` otherwise. -peekAwaitable :: MonadIO m => Awaitable r -> m (Maybe r) -peekAwaitable awaitable = liftIO $ atomically $ (Just <$> awaitSTM awaitable) `orElse` pure Nothing +peekFuture :: MonadIO m => Future r -> m (Maybe r) +peekFuture awaitable = liftIO $ atomically $ (Just <$> awaitSTM awaitable) `orElse` pure Nothing -- | Returns the result (in a `Just`) when the awaitable is completed, throws an `Exception` when the awaitable is -- failed and returns `Nothing` otherwise. -peekAwaitableSTM :: Awaitable r -> STM (Maybe r) -peekAwaitableSTM awaitable = (Just <$> awaitSTM awaitable) `orElse` pure Nothing +peekFutureSTM :: Future r -> STM (Maybe r) +peekFutureSTM awaitable = (Just <$> awaitSTM awaitable) `orElse` pure Nothing -class IsAwaitable r a | a -> r where - toAwaitable :: a -> Awaitable r +class IsFuture r a | a -> r where + toFuture :: a -> Future r -unsafeSTMToAwaitable :: STM a -> Awaitable a -unsafeSTMToAwaitable = Awaitable +unsafeSTMToFuture :: STM a -> Future a +unsafeSTMToFuture = Future unsafeAwaitSTM :: MonadAwait m => STM a -> m a -unsafeAwaitSTM = await . unsafeSTMToAwaitable +unsafeAwaitSTM = await . unsafeSTMToFuture -newtype Awaitable r = Awaitable (STM r) +newtype Future r = Future (STM r) deriving newtype ( Functor, Applicative, @@ -140,43 +140,43 @@ newtype Awaitable r = Awaitable (STM r) ) -instance IsAwaitable r (Awaitable r) where - toAwaitable = id +instance IsFuture r (Future r) where + toFuture = id -instance MonadAwait Awaitable where - await = toAwaitable +instance MonadAwait Future where + await = toFuture -instance Semigroup r => Semigroup (Awaitable r) where +instance Semigroup r => Semigroup (Future r) where x <> y = liftA2 (<>) x y -instance Monoid r => Monoid (Awaitable r) where +instance Monoid r => Monoid (Future r) where mempty = pure mempty -instance MonadFail Awaitable where +instance MonadFail Future where fail = throwM . userError -completedAwaitable :: Either SomeException r -> Awaitable r -completedAwaitable = either throwM pure +completedFuture :: Either SomeException r -> Future r +completedFuture = either throwM pure -- | Alias for `pure`. -successfulAwaitable :: r -> Awaitable r -successfulAwaitable = pure +successfulFuture :: r -> Future r +successfulFuture = pure -failedAwaitable :: SomeException -> Awaitable r -failedAwaitable = throwM +failedFuture :: SomeException -> Future r +failedFuture = throwM -- ** AsyncVar --- | The default implementation for an `Awaitable` that can be fulfilled later. +-- | The default implementation for an `Future` that can be fulfilled later. newtype AsyncVar r = AsyncVar (TMVar (Either SomeException r)) -instance IsAwaitable r (AsyncVar r) where - toAwaitable (AsyncVar var) = unsafeSTMToAwaitable $ either throwM pure =<< readTMVar var +instance IsFuture r (AsyncVar r) where + toFuture (AsyncVar var) = unsafeSTMToFuture $ either throwM pure =<< readTMVar var newAsyncVarSTM :: STM (AsyncVar r) @@ -236,25 +236,25 @@ putAsyncVarEitherSTM_ var = void . putAsyncVarEitherSTM var -- * Utility functions -- | Await success or failure of another awaitable, then return `()`. -awaitSuccessOrFailure :: (IsAwaitable r a, MonadAwait m) => a -> m () -awaitSuccessOrFailure = await . fireAndForget . toAwaitable +awaitSuccessOrFailure :: (IsFuture r a, MonadAwait m) => a -> m () +awaitSuccessOrFailure = await . fireAndForget . toFuture where fireAndForget :: MonadCatch m => m r -> m () fireAndForget x = void x `catchAll` const (pure ()) -afix :: (MonadIO m, MonadCatch m) => (Awaitable a -> m a) -> m a +afix :: (MonadIO m, MonadCatch m) => (Future a -> m a) -> m a afix action = do var <- newAsyncVar catchAll do - result <- action (toAwaitable var) + result <- action (toFuture var) putAsyncVar_ var result pure result \ex -> do failAsyncVar_ var ex throwM ex -afix_ :: (MonadIO m, MonadCatch m) => (Awaitable a -> m a) -> m () +afix_ :: (MonadIO m, MonadCatch m) => (Future a -> m a) -> m () afix_ = void . afix @@ -262,8 +262,8 @@ afix_ = void . afix -- | Completes as soon as either awaitable completes. -awaitEither :: MonadAwait m => Awaitable ra -> Awaitable rb -> m (Either ra rb) -awaitEither (Awaitable x) (Awaitable y) = unsafeAwaitSTM (eitherSTM x y) +awaitEither :: MonadAwait m => Future ra -> Future rb -> m (Either ra rb) +awaitEither (Future x) (Future y) = unsafeAwaitSTM (eitherSTM x y) -- | Helper for `awaitEither` eitherSTM :: STM a -> STM b -> STM (Either a b) @@ -272,7 +272,7 @@ eitherSTM x y = fmap Left x `orElse` fmap Right y -- Completes as soon as any awaitable in the list is completed and then returns the left-most completed result -- (or exception). -awaitAny :: MonadAwait m => [Awaitable r] -> m r +awaitAny :: MonadAwait m => [Future r] -> m r awaitAny xs = unsafeAwaitSTM $ anySTM $ awaitSTM <$> xs -- | Helper for `awaitAny` @@ -282,5 +282,5 @@ anySTM (x:xs) = x `orElse` anySTM xs -- | Like `awaitAny` with two awaitables. -awaitAny2 :: MonadAwait m => Awaitable r -> Awaitable r -> m r -awaitAny2 x y = awaitAny [toAwaitable x, toAwaitable y] +awaitAny2 :: MonadAwait m => Future r -> Future r -> m r +awaitAny2 x y = awaitAny [toFuture x, toFuture y] diff --git a/src/Quasar/MonadQuasar.hs b/src/Quasar/MonadQuasar.hs index 372eadf21410e0c147097988cd03177cd1a9f289..aa598579c7ede4e88d88a7615215d0eab8c5c903 100644 --- a/src/Quasar/MonadQuasar.hs +++ b/src/Quasar/MonadQuasar.hs @@ -94,7 +94,7 @@ withResourceScope fn = bracket newQuasar dispose (`localQuasar` fn) class (MonadCatch m, MonadFix m) => MonadQuasar m where askQuasar :: m Quasar maskIfRequired :: m a -> m a - startShortIO :: ShortIO a -> m (Awaitable a) + startShortIO :: ShortIO a -> m (Future a) ensureSTM :: STM a -> m a ensureQuasarSTM :: QuasarSTM a -> m a localQuasar :: Quasar -> m a -> m a @@ -102,7 +102,7 @@ class (MonadCatch m, MonadFix m) => MonadQuasar m where type QuasarT = ReaderT Quasar type QuasarIO = QuasarT IO -newtype QuasarSTM a = QuasarSTM (ReaderT (Quasar, TVar (Awaitable ())) STM a) +newtype QuasarSTM a = QuasarSTM (ReaderT (Quasar, TVar (Future ())) STM a) deriving newtype (Functor, Applicative, Monad, MonadThrow, MonadCatch, MonadFix, Alternative) @@ -126,7 +126,7 @@ instance MonadQuasar QuasarSTM where ensureSTM fn = QuasarSTM (lift fn) maskIfRequired = id startShortIO fn = do - (quasar, effectAwaitableVar) <- QuasarSTM ask + (quasar, effectFutureVar) <- QuasarSTM ask let worker = quasarIOWorker quasar exChan = quasarExceptionSink quasar @@ -134,7 +134,7 @@ instance MonadQuasar QuasarSTM where ensureSTM do awaitable <- startShortIOSTM fn worker exChan -- Await in reverse order, so it is almost guaranteed this only retries once - modifyTVar effectAwaitableVar (awaitSuccessOrFailure awaitable *>) + modifyTVar effectFutureVar (awaitSuccessOrFailure awaitable *>) pure awaitable ensureQuasarSTM = id localQuasar quasar (QuasarSTM fn) = QuasarSTM (local (first (const quasar)) fn) @@ -182,9 +182,9 @@ quasarAtomically (QuasarSTM fn) = do quasar <- askQuasar liftIO do await =<< atomically do - effectAwaitableVar <- newTVar (pure ()) - result <- runReaderT fn (quasar, effectAwaitableVar) - (result <$) <$> readTVar effectAwaitableVar + effectFutureVar <- newTVar (pure ()) + result <- runReaderT fn (quasar, effectFutureVar) + (result <$) <$> readTVar effectFutureVar redirectExceptionToSink :: MonadQuasar m => m a -> m (Maybe a) diff --git a/src/Quasar/Observable.hs b/src/Quasar/Observable.hs index 85b05df48ff7e986c0303802ec00fec7729d5078..ab3b3b7c329659d119f861cfd8a8964fa3afde8b 100644 --- a/src/Quasar/Observable.hs +++ b/src/Quasar/Observable.hs @@ -72,7 +72,7 @@ module Quasar.Observable ( -- -- --class IsRetrievable v a | a -> v where --- retrieve :: (MonadResourceManager m, MonadIO m, MonadMask m) => a -> m (Awaitable v) +-- retrieve :: (MonadResourceManager m, MonadIO m, MonadMask m) => a -> m (Future v) -- --class IsRetrievable v o => IsObservable v o | o -> v where -- -- | Register a callback to observe changes. The callback is called when the value changes, but depending on the @@ -366,7 +366,7 @@ module Quasar.Observable ( -- -- --data FnObservable v = FnObservable { --- retrieveFn :: ResourceManagerIO (Awaitable v), +-- retrieveFn :: ResourceManagerIO (Future v), -- observeFn :: (ObservableMessage v -> ResourceManagerIO ()) -> ResourceManagerIO () --} --instance IsRetrievable v (FnObservable v) where @@ -381,7 +381,7 @@ module Quasar.Observable ( ---- | Implement an Observable by directly providing functions for `retrieve` and `subscribe`. --fnObservable -- :: ((ObservableMessage v -> ResourceManagerIO ()) -> ResourceManagerIO ()) --- -> ResourceManagerIO (Awaitable v) +-- -> ResourceManagerIO (Future v) -- -> Observable v --fnObservable observeFn retrieveFn = toObservable FnObservable{observeFn, retrieveFn} -- @@ -393,7 +393,7 @@ module Quasar.Observable ( -- -> Observable v --synchronousFnObservable observeFn synchronousRetrieveFn = fnObservable observeFn retrieveFn -- where --- retrieveFn :: ResourceManagerIO (Awaitable v) +-- retrieveFn :: ResourceManagerIO (Future v) -- retrieveFn = liftIO $ pure <$> synchronousRetrieveFn -- -- diff --git a/src/Quasar/Resources.hs b/src/Quasar/Resources.hs index 9125adfb46931a56874a3e43887209fe7ddedce5..867a11afd15520d5460545e1700e486a39d5c17e 100644 --- a/src/Quasar/Resources.hs +++ b/src/Quasar/Resources.hs @@ -52,7 +52,7 @@ newUnmanagedIODisposerSTM fn worker exChan = newUnmanagedPrimitiveDisposer (fork newUnmanagedSTMDisposerSTM :: STM () -> TIOWorker -> ExceptionSink -> STM Disposer newUnmanagedSTMDisposerSTM fn worker exChan = newUnmanagedPrimitiveDisposer disposeFn worker exChan where - disposeFn :: ShortIO (Awaitable ()) + disposeFn :: ShortIO (Future ()) disposeFn = unsafeShortIO $ atomically $ -- Spawn a thread only if the transaction retries (pure <$> fn) `orElse` forkAsyncSTM (atomically fn) worker exChan @@ -92,7 +92,7 @@ registerDisposeTransaction_ fn = void $ registerDisposeTransaction fn registerNewResource :: forall a m. (Resource a, MonadQuasar m) => m a -> m a registerNewResource fn = do rm <- askResourceManager - disposing <- isJust <$> ensureSTM (peekAwaitableSTM (isDisposing rm)) + disposing <- isJust <$> ensureSTM (peekFutureSTM (isDisposing rm)) -- Bail out before creating the resource _if possible_ when disposing $ throwM AlreadyDisposing @@ -107,7 +107,7 @@ registerNewResource fn = do pure resource -disposeEventually :: (Resource r, MonadQuasar m) => r -> m (Awaitable ()) +disposeEventually :: (Resource r, MonadQuasar m) => r -> m (Future ()) disposeEventually res = ensureSTM $ disposeEventuallySTM res disposeEventually_ :: (Resource r, MonadQuasar m) => r -> m () diff --git a/src/Quasar/Resources/Disposer.hs b/src/Quasar/Resources/Disposer.hs index 6d3a9bade2835985fd71bb900ca494777b379fad..12b8e95baf99bc10a838fdf2ee0b68afa256b0b6 100644 --- a/src/Quasar/Resources/Disposer.hs +++ b/src/Quasar/Resources/Disposer.hs @@ -37,7 +37,7 @@ class Resource a where getDisposer :: a -> Disposer -type DisposerState = TOnce DisposeFn (Awaitable ()) +type DisposerState = TOnce DisposeFn (Future ()) data Disposer = FnDisposer Unique TIOWorker ExceptionSink DisposerState Finalizers @@ -46,10 +46,10 @@ data Disposer instance Resource Disposer where getDisposer = id -type DisposeFn = ShortIO (Awaitable ()) +type DisposeFn = ShortIO (Future ()) -newUnmanagedPrimitiveDisposer :: ShortIO (Awaitable ()) -> TIOWorker -> ExceptionSink -> STM Disposer +newUnmanagedPrimitiveDisposer :: ShortIO (Future ()) -> TIOWorker -> ExceptionSink -> STM Disposer newUnmanagedPrimitiveDisposer fn worker exChan = do key <- newUniqueSTM FnDisposer key worker exChan <$> newTOnce fn <*> newFinalizers @@ -58,7 +58,7 @@ newUnmanagedPrimitiveDisposer fn worker exChan = do dispose :: (MonadIO m, Resource r) => r -> m () dispose resource = liftIO $ await =<< atomically (disposeEventuallySTM resource) -disposeEventuallySTM :: Resource r => r -> STM (Awaitable ()) +disposeEventuallySTM :: Resource r => r -> STM (Future ()) disposeEventuallySTM resource = case getDisposer resource of FnDisposer _ worker exChan state finalizers -> do @@ -70,13 +70,13 @@ disposeEventuallySTM_ :: Resource r => r -> STM () disposeEventuallySTM_ resource = void $ disposeEventuallySTM resource -isDisposed :: Resource a => a -> Awaitable () +isDisposed :: Resource a => a -> Future () isDisposed resource = case getDisposer resource of - FnDisposer _ _ _ state _ -> join (toAwaitable state) + FnDisposer _ _ _ state _ -> join (toFuture state) ResourceManagerDisposer resourceManager -> resourceManagerIsDisposed resourceManager -isDisposing :: Resource a => a -> Awaitable () +isDisposing :: Resource a => a -> Future () isDisposing resource = case getDisposer resource of FnDisposer _ _ _ state _ -> unsafeAwaitSTM (check . isRight =<< readTOnceState state) @@ -84,17 +84,17 @@ isDisposing resource = -beginDisposeFnDisposer :: TIOWorker -> ExceptionSink -> DisposerState -> Finalizers -> STM (Awaitable ()) +beginDisposeFnDisposer :: TIOWorker -> ExceptionSink -> DisposerState -> Finalizers -> STM (Future ()) beginDisposeFnDisposer worker exChan disposeState finalizers = mapFinalizeTOnce disposeState startDisposeFn where - startDisposeFn :: DisposeFn -> STM (Awaitable ()) + startDisposeFn :: DisposeFn -> STM (Future ()) startDisposeFn disposeFn = do awaitableVar <- newAsyncVarSTM startShortIOSTM_ (runDisposeFn awaitableVar disposeFn) worker exChan - pure $ join (toAwaitable awaitableVar) + pure $ join (toFuture awaitableVar) - runDisposeFn :: AsyncVar (Awaitable ()) -> DisposeFn -> ShortIO () + runDisposeFn :: AsyncVar (Future ()) -> DisposeFn -> ShortIO () runDisposeFn awaitableVar disposeFn = mask_ $ handleAll exceptionHandler do awaitable <- disposeFn putAsyncVarShortIO_ awaitableVar awaitable @@ -119,10 +119,10 @@ disposerFinalizers (ResourceManagerDisposer rm) = resourceManagerFinalizers rm data DisposeResult - = DisposeResultAwait (Awaitable ()) + = DisposeResultAwait (Future ()) | DisposeResultDependencies DisposeDependencies -data DisposeDependencies = DisposeDependencies Unique (Awaitable [DisposeDependencies]) +data DisposeDependencies = DisposeDependencies Unique (Future [DisposeDependencies]) -- * Resource manager @@ -135,7 +135,7 @@ data ResourceManager = ResourceManager { data ResourceManagerState = ResourceManagerNormal (TVar (HashMap Unique Disposer)) TIOWorker ExceptionSink - | ResourceManagerDisposing (Awaitable [DisposeDependencies]) + | ResourceManagerDisposing (Future [DisposeDependencies]) | ResourceManagerDisposed instance Resource ResourceManager where @@ -180,7 +180,7 @@ attachDisposer resourceManager disposer = do _ -> pure () -beginDisposeResourceManager :: ResourceManager -> STM (Awaitable ()) +beginDisposeResourceManager :: ResourceManager -> STM (Future ()) beginDisposeResourceManager rm = do void $ beginDisposeResourceManagerInternal rm pure $ resourceManagerIsDisposed rm @@ -190,10 +190,10 @@ beginDisposeResourceManagerInternal rm = do readTVar (resourceManagerState rm) >>= \case ResourceManagerNormal attachedResources worker exChan -> do dependenciesVar <- newAsyncVarSTM - writeTVar (resourceManagerState rm) (ResourceManagerDisposing (toAwaitable dependenciesVar)) + writeTVar (resourceManagerState rm) (ResourceManagerDisposing (toFuture dependenciesVar)) attachedDisposers <- HM.elems <$> readTVar attachedResources startShortIOSTM_ (void $ forkIOShortIO (disposeThread dependenciesVar attachedDisposers)) worker exChan - pure $ DisposeDependencies rmKey (toAwaitable dependenciesVar) + pure $ DisposeDependencies rmKey (toFuture dependenciesVar) ResourceManagerDisposing deps -> pure $ DisposeDependencies rmKey deps ResourceManagerDisposed -> pure $ DisposeDependencies rmKey mempty where @@ -221,7 +221,7 @@ beginDisposeResourceManagerInternal rm = do resourceManagerBeginDispose (ResourceManagerDisposer resourceManager) = DisposeResultDependencies <$> beginDisposeResourceManagerInternal resourceManager - collectDependencies :: [DisposeResult] -> Awaitable [DisposeDependencies] + collectDependencies :: [DisposeResult] -> Future [DisposeDependencies] collectDependencies (DisposeResultAwait awaitable : xs) = awaitable >> collectDependencies xs collectDependencies (DisposeResultDependencies deps : xs) = (deps : ) <$> collectDependencies xs collectDependencies [] = pure [] @@ -237,13 +237,13 @@ beginDisposeResourceManagerInternal rm = do foldM go (HashSet.insert key keys) dependencies -resourceManagerIsDisposed :: ResourceManager -> Awaitable () +resourceManagerIsDisposed :: ResourceManager -> Future () resourceManagerIsDisposed rm = unsafeAwaitSTM $ readTVar (resourceManagerState rm) >>= \case ResourceManagerDisposed -> pure () _ -> retry -resourceManagerIsDisposing :: ResourceManager -> Awaitable () +resourceManagerIsDisposing :: ResourceManager -> Future () resourceManagerIsDisposing rm = unsafeAwaitSTM $ readTVar (resourceManagerState rm) >>= \case ResourceManagerNormal {} -> retry @@ -276,10 +276,10 @@ runFinalizers (Finalizers finalizerVar) = do runFinalizersShortIO :: Finalizers -> ShortIO () runFinalizersShortIO finalizers = unsafeShortIO $ atomically $ runFinalizers finalizers -runFinalizersAfter :: Finalizers -> Awaitable () -> ShortIO () +runFinalizersAfter :: Finalizers -> Future () -> ShortIO () runFinalizersAfter finalizers awaitable = do -- Peek awaitable to ensure trivial disposables always run without forking - isCompleted <- isJust <$> peekAwaitableShortIO awaitable + isCompleted <- isJust <$> peekFutureShortIO awaitable if isCompleted then runFinalizersShortIO finalizers diff --git a/src/Quasar/Timer.hs b/src/Quasar/Timer.hs index 338f4d634cc24a4ff9614b02b108b8c61c80ae96..d7d6fafe49717926f6a1ebbdf2c6fb79273f6aae 100644 --- a/src/Quasar/Timer.hs +++ b/src/Quasar/Timer.hs @@ -53,8 +53,8 @@ instance Ord Timer where instance Resource Timer where getDisposer Timer{disposer} = disposer -instance IsAwaitable () Timer where - toAwaitable Timer{completed} = toAwaitable completed +instance IsFuture () Timer where + toFuture Timer{completed} = toFuture completed data TimerScheduler = TimerScheduler { @@ -125,7 +125,7 @@ startSchedulerThread scheduler = getDisposer <$> async (schedulerThread `finally awaitAny2 (await delay) nextTimerChanged dispose delay where - nextTimerChanged :: Awaitable () + nextTimerChanged :: Future () nextTimerChanged = unsafeAwaitSTM do minTimer <- Data.Heap.minimum <$> readTMVar heap' unless (minTimer /= nextTimer) retry @@ -200,14 +200,14 @@ sleepUntil :: MonadIO m => TimerScheduler -> UTCTime -> m () sleepUntil scheduler time = liftIO $ bracketOnError (newUnmanagedTimer scheduler time) dispose await --- | Provides an `IsAwaitable` instance that can be awaited successfully after a given number of microseconds. +-- | Provides an `IsFuture` instance that can be awaited successfully after a given number of microseconds. -- --- Based on `threadDelay`. Provides a `IsAwaitable` and a `IsDisposable` instance. +-- Based on `threadDelay`. Provides a `IsFuture` and a `IsDisposable` instance. newtype Delay = Delay (Async ()) deriving newtype Resource -instance IsAwaitable () Delay where - toAwaitable (Delay task) = toAwaitable task `catch` \AsyncDisposed -> throwM TimerCancelled +instance IsFuture () Delay where + toFuture (Delay task) = toFuture task `catch` \AsyncDisposed -> throwM TimerCancelled newDelay :: MonadQuasar m => Int -> m Delay newDelay microseconds = Delay <$> async (liftIO (threadDelay microseconds)) diff --git a/src/Quasar/Utils/ShortIO.hs b/src/Quasar/Utils/ShortIO.hs index 22b8ad7bebf97b349617a0c290651b977b817177..045a92144f9ac2d68fdf27b5574f2c5f84f22a65 100644 --- a/src/Quasar/Utils/ShortIO.hs +++ b/src/Quasar/Utils/ShortIO.hs @@ -9,7 +9,7 @@ module Quasar.Utils.ShortIO ( newUniqueShortIO, -- ** Some specific functions required internally - peekAwaitableShortIO, + peekFutureShortIO, newAsyncVarShortIO, putAsyncVarShortIO_, ) where @@ -42,8 +42,8 @@ newUniqueShortIO :: ShortIO Unique newUniqueShortIO = ShortIO newUnique -peekAwaitableShortIO :: Awaitable r -> ShortIO (Maybe r) -peekAwaitableShortIO awaitable = ShortIO $ peekAwaitable awaitable +peekFutureShortIO :: Future r -> ShortIO (Maybe r) +peekFutureShortIO awaitable = ShortIO $ peekFuture awaitable newAsyncVarShortIO :: ShortIO (AsyncVar a) newAsyncVarShortIO = ShortIO newAsyncVar diff --git a/src/Quasar/Utils/TOnce.hs b/src/Quasar/Utils/TOnce.hs index 5850e7210613722a46357a91a31d38b648b8b88c..7eef16bd8c77926797a7757752c131f01c1ac2fb 100644 --- a/src/Quasar/Utils/TOnce.hs +++ b/src/Quasar/Utils/TOnce.hs @@ -18,8 +18,8 @@ data TOnceAlreadyFinalized = TOnceAlreadyFinalized newtype TOnce a b = TOnce (TVar (Either a b)) -instance IsAwaitable b (TOnce a b) where - toAwaitable = unsafeAwaitSTM . readTOnceResult +instance IsFuture b (TOnce a b) where + toFuture = unsafeAwaitSTM . readTOnceResult newTOnce :: a -> STM (TOnce a b) newTOnce initial = TOnce <$> newTVar (Left initial) diff --git a/test/Quasar/AsyncSpec.hs b/test/Quasar/AsyncSpec.hs index 43a1d6081638e07c2aa3759e073148cc812f735f..3844c7a539c9975a114e2593e257c2f6f11d36be 100644 --- a/test/Quasar/AsyncSpec.hs +++ b/test/Quasar/AsyncSpec.hs @@ -29,7 +29,7 @@ spec = describe "async" $ it "async" $ pendingWith "moving to new implementation -- await avar -- -- it "can fmap the result of an already finished async" $ do --- await (pure () :: Awaitable ()) :: IO () +-- await (pure () :: Future ()) :: IO () -- -- it "can terminate when encountering an asynchronous exception" $ do -- never <- newAsyncVar :: IO (AsyncVar ()) diff --git a/test/Quasar/AwaitableSpec.hs b/test/Quasar/AwaitableSpec.hs index 60386673eb593d9fb9d9edf6cbc5ac0d5349673b..99ca91b878e193e67b797a4160e37704b4b16910 100644 --- a/test/Quasar/AwaitableSpec.hs +++ b/test/Quasar/AwaitableSpec.hs @@ -15,9 +15,9 @@ instance Exception TestException spec :: Spec spec = parallel $ do - describe "Awaitable" $ do + describe "Future" $ do it "can await pure values" $ do - await $ (pure () :: Awaitable ()) :: IO () + await $ (pure () :: Future ()) :: IO () describe "AsyncVar" $ do it "can be created" $ do @@ -45,7 +45,7 @@ spec = parallel $ do describe "awaitAny" $ do it "works with completed awaitables" $ do - awaitAny2 (pure () :: Awaitable ()) (pure () :: Awaitable ()) :: IO () + awaitAny2 (pure () :: Future ()) (pure () :: Future ()) :: IO () it "can be completed later" $ do avar1 <- newAsyncVar :: IO (AsyncVar ()) diff --git a/test/Quasar/ResourcesSpec.hs b/test/Quasar/ResourcesSpec.hs index 7ccd6733c3ba9970215d6081167f66afddaf7f58..7f3b31bed0b8ebee07606674f94c55ba677f1c56 100644 --- a/test/Quasar/ResourcesSpec.hs +++ b/test/Quasar/ResourcesSpec.hs @@ -30,7 +30,7 @@ spec = pure () -- it "is disposed when exiting withRootResourceManager" $ io do -- resourceManager <- withRootResourceManager askResourceManager -- --- peekAwaitable (isDisposed resourceManager) `shouldReturn` Just () +-- peekFuture (isDisposed resourceManager) `shouldReturn` Just () -- -- it "can be created and disposed with a delay" $ io do -- withRootResourceManager $ liftIO $ threadDelay 100000