From 2eb06abfdd67de75ac54057124df0f743cf8d347 Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Wed, 1 Sep 2021 00:39:49 +0200
Subject: [PATCH] Add MonadFail constraint to MonadAwait
---
src/Quasar/Awaitable.hs | 7 +++++--
1 file changed, 5 insertions(+), 2 deletions(-)
diff --git a/src/Quasar/Awaitable.hs b/src/Quasar/Awaitable.hs
index acf4d24..401c01d 100644
--- a/src/Quasar/Awaitable.hs
+++ b/src/Quasar/Awaitable.hs
@@ -59,7 +59,7 @@ import Data.Sequence
import Quasar.Prelude
-class (MonadCatch m, MonadPlus m) => MonadAwait m where
+class (MonadCatch m, MonadFail m, MonadPlus 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
@@ -194,7 +194,7 @@ awaitableFromSTM :: forall m a. MonadIO m => STM a -> m (Awaitable a)
awaitableFromSTM transaction = cacheAwaitable (unsafeAwaitSTM transaction :: Awaitable a)
-instance {-# OVERLAPS #-} (MonadCatch m, MonadPlus m) => MonadAwait (ReaderT (QueryFn m) m) where
+instance {-# OVERLAPS #-} (MonadCatch m, MonadFail m, MonadPlus m) => MonadAwait (ReaderT (QueryFn m) m) where
await = runAwaitable
unsafeAwaitSTM transaction = do
QueryFn querySTMFn <- ask
@@ -271,6 +271,9 @@ instance MonadCatch AwaitableStepM where
catch result@(AwaitableFailed ex) handler = maybe result handler $ fromException ex
catch (AwaitableStep query next) handler = AwaitableStep query (\x -> next x `catch` handler)
+instance MonadFail AwaitableStepM where
+ fail = throwM . userError
+
instance Alternative AwaitableStepM where
x <|> y = x `catchAll` const y
empty = throwM $ toException $ userError "empty"
--
GitLab