From 796be3c170c379ae366b725807093a1ecb8c81aa Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Sun, 29 Aug 2021 22:27:16 +0200
Subject: [PATCH] Add MonadObserve constraint alias
Co-authored-by: Jan Beinke <git@janbeinke.com>
---
src/Quasar/Observable.hs | 9 ++++++---
1 file changed, 6 insertions(+), 3 deletions(-)
diff --git a/src/Quasar/Observable.hs b/src/Quasar/Observable.hs
index 941f45b..5efc542 100644
--- a/src/Quasar/Observable.hs
+++ b/src/Quasar/Observable.hs
@@ -4,6 +4,7 @@ module Quasar.Observable (
-- * Observable core types
IsRetrievable(..),
retrieveIO,
+ MonadObserve,
IsObservable(..),
Observable(..),
ObservableMessage(..),
@@ -72,9 +73,11 @@ class IsRetrievable v a | a -> v where
retrieveIO :: IsRetrievable v a => a -> IO v
retrieveIO x = withOnResourceManager $ await =<< retrieve x
+type MonadObserve m = (MonadAwait m, MonadResourceManager m)
+
{-# DEPRECATED unsafeAsyncObserveIO "Old implementation of `observe`." #-}
class IsRetrievable v o => IsObservable v o | o -> v where
- observe :: (MonadAwait m, MonadCatch m, MonadResourceManager m) => o -> (ObservableMessage v -> m ()) -> m a
+ observe :: MonadObserve m => o -> (ObservableMessage v -> m ()) -> m a
observe observable callback = do
msgVar <- liftIO $ newTVarIO ObservableLoading
idVar <- liftIO $ newTVarIO (0 :: Word64)
@@ -124,7 +127,7 @@ data ObserveWhileCompleted = ObserveWhileCompleted
instance Exception ObserveWhileCompleted
-- | Observe until the callback returns `Just`.
-observeWhile :: (IsObservable v o, MonadAwait m, MonadResourceManager m) => o -> (ObservableMessage v -> m (Maybe a)) -> m a
+observeWhile :: (IsObservable v o, MonadObserve m) => o -> (ObservableMessage v -> m (Maybe a)) -> m a
observeWhile observable callback = do
resultVar <- liftIO $ newIORef impossibleCodePath
observeWhile_ observable \msg -> do
@@ -138,7 +141,7 @@ observeWhile observable callback = do
-- | Observe until the callback returns `False`.
-observeWhile_ :: (IsObservable v o, MonadAwait m, MonadResourceManager m) => o -> (ObservableMessage v -> m Bool) -> m ()
+observeWhile_ :: (IsObservable v o, MonadObserve m) => o -> (ObservableMessage v -> m Bool) -> m ()
observeWhile_ observable callback =
catch
do
--
GitLab