@@ -22,6 +22,7 @@ module Reflex.Dynamic ( Dynamic -- Abstract so we can preserve the law that the
2222 , mconcatDyn
2323 , distributeDMapOverDyn
2424 , joinDyn
25+ , joinDynThroughMap
2526 , traceDyn
2627 , traceDynWith
2728 , splitDyn
@@ -42,6 +43,8 @@ import Control.Monad.Fix
4243import Control.Monad.Identity
4344import Data.These
4445import Data.Align
46+import Data.Map (Map)
47+import qualified Data.Map as Map
4548import Data.Dependent.Map (DMap)
4649import qualified Data.Dependent.Map as DMap
4750import Data.Dependent.Sum (DSum (..))
@@ -234,6 +237,21 @@ joinDyn dd =
234237 e' = leftmost [eBoth, eOuter, eInner]
235238 in Dynamic b' e'
236239
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
249+ That a -> return a
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]
253+ in Dynamic b' e'
254+
237255traceDyn :: (Reflex t, Show a) => String -> Dynamic t a -> Dynamic t a
238256traceDyn s = traceDynWith $ \x -> s <> ": " <> show x
239257