@@ -150,21 +150,43 @@ instance (Reflex t, MonadAdjust t m, MonadHold t m) => MonadAdjust t (StaticDomB
150150 o <- hold (snd result0) $ fmapCheap snd result'
151151 StaticDomBuilderT $ modify $ (:) $ join o
152152 return (fst result0, fmapCheap fst result')
153− traverseDMapWithKeyWithAdjust f (dm0 :: DMap k v) dm' = do
154− e <- StaticDomBuilderT ask
155− (children0, children') <- lift $ traverseDMapWithKeyWithAdjust (\k v -> fmap (Compose . swap) (runStaticDomBuilderT (f k v) e)) dm0 dm'
156− let result0 = DMap.map (snd . getCompose) children0
157− result' = ffor children' $ mapPatchDMap $ snd . getCompose
158− outputs0 :: DMap k (Constant (Behavior t Builder))
159− outputs0 = DMap.map (Constant . fst . getCompose) children0
160− outputs' :: Event t (PatchDMap k (Constant (Behavior t Builder)))
161− outputs' = ffor children' $ mapPatchDMap $ Constant . fst . getCompose
162− outputs <- holdIncremental outputs0 outputs'
163− StaticDomBuilderT $ modify $ (:) $ pull $ do
164− os <- sample $ currentIncremental outputs
165− fmap mconcat $ forM (DMap.toList os) $ \(_ :=> Constant o) -> do
166− sample o
167− return (result0, result')
153+ traverseDMapWithKeyWithAdjust = hoistDMapWithKeyWithAdjust traverseDMapWithKeyWithAdjust mapPatchDMap
154+ traverseDMapWithKeyWithAdjustWithMove = hoistDMapWithKeyWithAdjust traverseDMapWithKeyWithAdjustWithMove mapPatchDMapWithMove
155+
156+hoistDMapWithKeyWithAdjust :: forall (k :: * -> *) v v' t m p.
157+ ( MonadAdjust t m
158+ , MonadHold t m
159+ , DMap.GCompare k
160+ , Patch (p k v)
161+ , PatchTarget (p k (Constant (Behavior t Builder))) ~ DMap k (Constant (Behavior t Builder))
162+ , Patch (p k (Constant (Behavior t Builder)))
163+ )
164+ => (forall vv vv'.
165+ (forall a. k a -> vv a -> m (vv' a))
166+ -> DMap k vv
167+ -> Event t (p k vv)
168+ -> m (DMap k vv', Event t (p k vv'))
169+ ) -- ^ The base monad's traversal
170+ -> (forall vv vv'. (forall a. vv a -> vv' a) -> p k vv -> p k vv') -- ^ A way of mapping over the patch type
171+ -> (forall a. k a -> v a -> StaticDomBuilderT t m (v' a))
172+ -> DMap k v
173+ -> Event t (p k v)
174+ -> StaticDomBuilderT t m (DMap k v', Event t (p k v'))
175+hoistDMapWithKeyWithAdjust base mapPatch f dm0 dm' = do
176+ e <- StaticDomBuilderT ask
177+ (children0, children') <- lift $ base (\k v -> fmap (Compose . swap) (runStaticDomBuilderT (f k v) e)) dm0 dm'
178+ let result0 = DMap.map (snd . getCompose) children0
179+ result' = ffor children' $ mapPatch $ snd . getCompose
180+ outputs0 :: DMap k (Constant (Behavior t Builder))
181+ outputs0 = DMap.map (Constant . fst . getCompose) children0
182+ outputs' :: Event t (p k (Constant (Behavior t Builder)))
183+ outputs' = ffor children' $ mapPatch $ Constant . fst . getCompose
184+ outputs <- holdIncremental outputs0 outputs'
185+ StaticDomBuilderT $ modify $ (:) $ pull $ do
186+ os <- sample $ currentIncremental outputs
187+ fmap mconcat $ forM (DMap.toList os) $ \(_ :=> Constant o) -> do
188+ sample o
189+ return (result0, result')
168190
169191-- TODO: the uses of illegal lenses in this instance causes it to be somewhat less efficient than it can be. replacing them with explicit cases to get the underlying Maybe Event and working with those is ideal.
170192instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) where