diff --git a/src/Quasar/Awaitable.hs b/src/Quasar/Awaitable.hs index acf4d24daa14308776604d177b90524e9158c85a..401c01d2433de3fa3620457ea05b01972f9b0188 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"