diff --git a/src/Quasar/Awaitable.hs b/src/Quasar/Awaitable.hs index f1b98532f420c8c167b879663043abc1ae360303..ff7ce9c99dba701f4220cdda981e52a0e50aed76 100644 --- a/src/Quasar/Awaitable.hs +++ b/src/Quasar/Awaitable.hs @@ -63,7 +63,7 @@ import GHC.IO (unsafeDupablePerformIO) import Quasar.Prelude -class (MonadCatch m, MonadFail m, MonadPlus m, MonadFix m) => MonadAwait m where +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 @@ -88,6 +88,15 @@ instance MonadAwait IO where \BlockedIndefinitelyOnSTM -> throwM BlockedIndefinitelyOnAwait unsafeAwaitSTM = atomically +-- | Experimental instance for `STM`. Using `await` in STM circumvents awaitable caching mechanics, so this only +-- exists as a test to estimate the usefulness of caching awaitables against the usefulness of awaiting in STM. +instance MonadAwait STM where + await awaitable = + runQueryT id (runAwaitable awaitable) + `catch` + \BlockedIndefinitelyOnSTM -> throwM BlockedIndefinitelyOnAwait + unsafeAwaitSTM = id + instance MonadAwait m => MonadAwait (ReaderT a m) where await = lift . await unsafeAwaitSTM = lift . unsafeAwaitSTM @@ -231,7 +240,7 @@ awaitableFromSTM :: forall m a. MonadIO m => STM a -> m (Awaitable a) awaitableFromSTM transaction = cacheAwaitableUnlessPrimitive (unsafeAwaitSTM transaction :: Awaitable a) -instance {-# OVERLAPS #-} (MonadCatch m, MonadFail m, MonadPlus m, MonadFix m) => MonadAwait (ReaderT (QueryFn m) m) where +instance {-# OVERLAPS #-} (MonadCatch m, MonadPlus m, MonadFix m) => MonadAwait (ReaderT (QueryFn m) m) where await = runAwaitable unsafeAwaitSTM transaction = do QueryFn querySTMFn <- ask