on develop help sign in
Distribute more generally
5feea42David Feuer
src/Reflex/Class.hs+14−4
@@ -88,6 +88,7 @@ module Reflex.Class
88 , gate
88 , gate
89 -- ** Combining 'Dynamic's
89 -- ** Combining 'Dynamic's
90 , distributeDMapOverDynPure
90 , distributeDMapOverDynPure
91+ , distributeDMapOverDynPureG
91 , distributeListOverDyn
92 , distributeListOverDyn
92 , distributeListOverDynWith
93 , distributeListOverDynWith
93 , zipDyn
94 , zipDyn
@@ -1091,12 +1092,21 @@ instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
1091-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
1092-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
1092-- through the use of multiple uses of 'zipDynWith' or 'Applicative' operators.
1093-- through the use of multiple uses of 'zipDynWith' or 'Applicative' operators.
1093distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
1094distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
1094−distributeDMapOverDynPure dm = case DMap.toList dm of
1095+distributeDMapOverDynPure = distributeDMapOverDynPureG coerceDynamic
1096+
1097+-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
1098+-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
1099+-- through the use of multiple uses of 'zipDynWith' or 'Applicative' operators.
1100+distributeDMapOverDynPureG
1101+ :: forall t k q v. (Reflex t, GCompare k)
1102+ => (forall a. q a -> Dynamic t (v a))
1103+ -> DMap k q -> Dynamic t (DMap k v)
1104+distributeDMapOverDynPureG nt dm = case DMap.toList dm of
1095 [] -> constDyn DMap.empty
1105 [] -> constDyn DMap.empty
1096− [k :=> v] -> fmap (DMap.singleton k . Identity) v
1106+ [k :=> v] -> DMap.singleton k <$> nt v
1097 _ ->
1107 _ ->
1098− let getInitial = DMap.traverseWithKey (\_ -> fmap Identity . sample . current) dm
1108+ let getInitial = DMap.traverseWithKey (\_ -> sample . current . nt) dm
1099− edmPre = merge $ DMap.map updated dm
1109+ edmPre = mergeG getCompose $ DMap.map (Compose . updated . nt) dm
1100 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
1110 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
1101 olds <- sample $ current result
1111 olds <- sample $ current result
1102 return $ DMap.unionWithKey (\_ _ new -> new) olds news
1112 return $ DMap.unionWithKey (\_ _ new -> new) olds news