@@ -22,6 +22,7 @@ module Reflex.Dynamic ( Dynamic -- Abstract so we can preserve the law that the
22 , mconcatDyn
22 , mconcatDyn
23 , distributeDMapOverDyn
23 , distributeDMapOverDyn
25 , traceDyn
26 , traceDyn
26 , traceDynWith
27 , traceDynWith
27 , splitDyn
28 , splitDyn
@@ -42,6 +43,8 @@ import Control.Monad.Fix
42import Control.Monad.Identity
43import Control.Monad.Identity
43import Data.These
44import Data.These
44import Data.Align
45import Data.Align
47+import qualified Data.Map as Map
45import Data.Dependent.Map (DMap)
48import Data.Dependent.Map (DMap)
46import qualified Data.Dependent.Map as DMap
49import qualified Data.Dependent.Map as DMap
47import Data.Dependent.Sum (DSum (..))
50import Data.Dependent.Sum (DSum (..))
@@ -234,6 +237,21 @@ joinDyn dd =
234 e' = leftmost [eBoth, eOuter, eInner]
237 e' = leftmost [eBoth, eOuter, eInner]
235 in Dynamic b' e'
238 in Dynamic b' e'
240+--TODO: Generalize this to functors other than Maps
241+joinDynThroughMap :: forall t k a. (Reflex t, Ord k) => Dynamic t (Map k (Dynamic t a)) -> Dynamic t (Map k a)
242+joinDynThroughMap dd =
243+ let b' = pull $ mapM (sample . current) =<< sample (current dd)
244+ eOuter :: Event t (Map k a) = pushAlways (mapM (sample . current)) $ updated dd
245+ eInner :: Event t (Map k a) = attachWith (flip Map.union) b' $ switch $ fmap (mergeMap . fmap updated) (current dd) --Note: the flip is important because Map.union is left-biased
246+ readNonFiring :: MonadSample t m => These (Dynamic t a) a -> m a
247+ readNonFiring = \case
248+ This d -> sample $ current d
250+ These _ a -> return a
251+ eBoth :: Event t (Map k a) = coincidence $ fmap (\m -> pushAlways (mapM readNonFiring . align m) $ mergeMap $ fmap updated m) (updated dd)
252+ e' = leftmost [eBoth, eOuter, eInner]
237traceDyn :: (Reflex t, Show a) => String -> Dynamic t a -> Dynamic t a
255traceDyn :: (Reflex t, Show a) => String -> Dynamic t a -> Dynamic t a
238traceDyn s = traceDynWith $ \x -> s <> ": " <> show x
256traceDyn s = traceDynWith $ \x -> s <> ": " <> show x