From 598207f8797fd5e489789b0f612d9efc82e05381 Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Sun, 13 Mar 2022 03:46:52 +0100
Subject: [PATCH] Simplify MappedObservable; add fmap optimization for
liftA2-Observable
---
src/Quasar/Observable.hs | 9 +++++----
1 file changed, 5 insertions(+), 4 deletions(-)
diff --git a/src/Quasar/Observable.hs b/src/Quasar/Observable.hs
index e5ed131..c5816f7 100644
--- a/src/Quasar/Observable.hs
+++ b/src/Quasar/Observable.hs
@@ -100,7 +100,7 @@ class IsRetrievable r a => IsObservable r a | a -> r where
toObservable = Observable
mapObservable :: (r -> r2) -> a -> Observable r2
- mapObservable f = Observable . MappedObservable f
+ mapObservable f = Observable . MappedObservable f . toObservable
{-# MINIMAL toObservable | observe, pingObservable #-}
@@ -220,20 +220,20 @@ instance IsObservable r (ConstObservable r) where
pingObservable _ = pure ()
-data MappedObservable r = forall r2 a. IsObservable r2 a => MappedObservable (r2 -> r) a
+data MappedObservable r = forall a. MappedObservable (a -> r) (Observable a)
instance IsRetrievable r (MappedObservable r) where
retrieve (MappedObservable f observable) = f <$> retrieve observable
instance IsObservable r (MappedObservable r) where
observe (MappedObservable fn observable) callback = observe observable (callback . fmap fn)
- mapObservable f1 (MappedObservable f2 upstream) = Observable $ MappedObservable (f1 . f2) upstream
pingObservable (MappedObservable _ observable) = pingObservable observable
+ mapObservable f1 (MappedObservable f2 upstream) = Observable $ MappedObservable (f1 . f2) upstream
-- | Merge two observables using a given merge function. Whenever one of the inputs is updated, the resulting
-- observable updates according to the merge function.
--
-- There is no caching involed, every subscriber effectively subscribes to both input observables.
-data LiftA2Observable r = forall r0 r1. LiftA2Observable (r0 -> r1 -> r) (Observable r0) (Observable r1)
+data LiftA2Observable r = forall a b. LiftA2Observable (a -> b -> r) (Observable a) (Observable b)
instance IsRetrievable r (LiftA2Observable r) where
retrieve (LiftA2Observable fn fx fy) = liftQuasarIO do
@@ -258,6 +258,7 @@ instance IsObservable r (LiftA2Observable r) where
pingObservable fx
await future
+ mapObservable f1 (LiftA2Observable f2 fx fy) = Observable $ LiftA2Observable (\x y -> f1 (f2 x y)) fx fy
--data BindObservable r = forall a. BindObservable (Observable a) (a -> Observable r)
--
--
GitLab