From 5deae370371d8dd3ab76ab737f43877ba714149d Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Wed, 25 Aug 2021 02:43:47 +0200
Subject: [PATCH] Add instances to Awaitable (MonadThrow, MonadCatch and more)

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

diff --git a/src/Quasar/Awaitable.hs b/src/Quasar/Awaitable.hs
index 98f50d0..fd695fa 100644
--- a/src/Quasar/Awaitable.hs
+++ b/src/Quasar/Awaitable.hs
@@ -34,6 +34,7 @@ module Quasar.Awaitable (
   cacheAwaitableDefaultImplementation,
 ) where
 
+import Control.Applicative (empty)
 import Control.Concurrent.STM
 import Control.Monad.Catch
 import Control.Monad.Reader
@@ -93,6 +94,25 @@ instance Semigroup r => Semigroup (Awaitable r) where
 instance Monoid r => Monoid (Awaitable r) where
   mempty = pure mempty
 
+instance MonadThrow Awaitable where
+  throwM = failedAwaitable . toException
+
+instance MonadCatch Awaitable where
+  catch awaitable handler = toAwaitable $ FnAwaitable do
+    runAwaitable awaitable >>= \case
+      l@(Left ex) -> maybe (pure l) (runAwaitable . handler) $ fromException ex
+      Right value -> pure $ Right value
+
+instance MonadFail Awaitable where
+  fail = throwM . userError
+
+
+instance Alternative Awaitable where
+  x <|> y = x `catchAll` const y
+  empty = failedAwaitable $ toException $ userError "empty"
+
+instance MonadPlus Awaitable
+
 
 newtype FnAwaitable r = FnAwaitable (forall m. (MonadQuerySTM m) => m (Either SomeException r))
 
-- 
GitLab