diff --git a/src/Quasar/Observable.hs b/src/Quasar/Observable.hs index 941f45bcc23965c27a13786cec2e8ba122019e85..5efc5424e77500bf827095d2ccd7a2fb2ea0028b 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