diff --git a/src/Quasar/Awaitable.hs b/src/Quasar/Awaitable.hs index e11bcd0f478f0e4f4e31680055e062977ed9238d..0c51aec57260571b29afc2778a75ca3c5df91636 100644 --- a/src/Quasar/Awaitable.hs +++ b/src/Quasar/Awaitable.hs @@ -73,8 +73,18 @@ class (MonadCatch m, MonadFail m, MonadPlus m, MonadFix m) => MonadAwait m where -- awaitable. unsafeAwaitSTM :: STM a -> m a +data BlockedIndefinitelyOnAwait = BlockedIndefinitelyOnAwait + deriving stock Show + +instance Exception BlockedIndefinitelyOnAwait where + displayException BlockedIndefinitelyOnAwait = "Thread blocked indefinitely in an 'await' operation" + + instance MonadAwait IO where - await awaitable = liftIO $ runQueryT atomically (runAwaitable awaitable) + await awaitable = liftIO do + runQueryT atomically (runAwaitable awaitable) + `catch` + \BlockedIndefinitelyOnSTM -> throwM BlockedIndefinitelyOnAwait unsafeAwaitSTM = atomically instance MonadAwait m => MonadAwait (ReaderT a m) where