From 9b98ffdb6011df46007c3e9677ae561b71808fc7 Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Wed, 6 Oct 2021 01:42:35 +0200
Subject: [PATCH] Add BlockedIndefinitelyOnAwait to signal hangups during await

---
 src/Quasar/Awaitable.hs | 12 +++++++++++-
 1 file changed, 11 insertions(+), 1 deletion(-)

diff --git a/src/Quasar/Awaitable.hs b/src/Quasar/Awaitable.hs
index e11bcd0..0c51aec 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
-- 
GitLab