on develop help sign in
Improve perf of coincidencePatch*
commitbf9e0b6489ea1f9af88bc44bd4ea3104e24ed426 authorRyan Trinkle <ryan@trinkle.org> dateSun 29 Sep 2019, 11:54 (7 years ago) parentd3a3059
1 file changed+25−17
src/Reflex/Class.hs+25−17
src/Reflex/Class.hs+25−17
@@ -1028,29 +1028,37 @@ switchHoldPromptOnly e0 e' = do
10281028
10291029-- | When the given outer event fires, condense the inner events into the contained patch. Non-firing inner events will be replaced with deletions.
10301030coincidencePatchMap :: (Reflex t, Ord k) => Event t (PatchMap k (Event t v)) -> Event t (PatchMap k v)
1031−coincidencePatchMap e = fmapCheap PatchMap $ coincidence $ fforCheap e $ \(PatchMap m) -> mergeMap $ ffor m $ \case
1032− Nothing -> fmapCheap (const Nothing) e
1033− Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
1031+coincidencePatchMap e = fmapCheap PatchMap $ coincidence $ fforCheap e $ \(PatchMap m) -> if Map.null m then never else
1032+ let firingNewItems = mergeMap $ fforMaybe m $ \case
1033+ Nothing -> Nothing
1034+ Just ev -> Just $ fmapCheap Just ev
1035+ oldItemMask = (Nothing <$ m) <$ e
1036+ in alignWith (mergeThese Map.union) firingNewItems oldItemMask -- Must be left-biased
10341037
10351038-- | See 'coincidencePatchMap'
10361039coincidencePatchIntMap :: Reflex t => Event t (PatchIntMap (Event t v)) -> Event t (PatchIntMap v)
1037−coincidencePatchIntMap e = fmapCheap PatchIntMap $ coincidence $ fforCheap e $ \(PatchIntMap m) -> mergeIntMap $ ffor m $ \case
1038− Nothing -> fmapCheap (const Nothing) e
1039− Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]
1040+coincidencePatchIntMap e = fmapCheap PatchIntMap $ coincidence $ fforCheap e $ \(PatchIntMap m) -> if IntMap.null m then never else
1041+ let firingNewItems = mergeIntMap $ fforMaybe m $ \case
1042+ Nothing -> Nothing
1043+ Just ev -> Just $ fmapCheap Just ev
1044+ oldItemMask = (Nothing <$ m) <$ e
1045+ in alignWith (mergeThese IntMap.union) firingNewItems oldItemMask -- Must be left-biased
10401046
10411047-- | See 'coincidencePatchMap'
10421048coincidencePatchMapWithMove :: (Reflex t, Ord k) => Event t (PatchMapWithMove k (Event t v)) -> Event t (PatchMapWithMove k v)
1043−coincidencePatchMapWithMove e = fmapCheap unsafePatchMapWithMove $ coincidence $ fforCheap e $ \p -> mergeMap $ ffor (unPatchMapWithMove p) $ \ni -> case PatchMapWithMove._nodeInfo_from ni of
1044− PatchMapWithMove.From_Delete -> fforCheap e $ \_ ->
1045− ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
1046− PatchMapWithMove.From_Move k -> fforCheap e $ \_ ->
1047− ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Move k }
1048− PatchMapWithMove.From_Insert ev -> leftmost
1049− [ fforCheap ev $ \v ->
1050− ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Insert v }
1051− , fforCheap e $ \_ ->
1052− ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
1053− ]
1049+coincidencePatchMapWithMove e = fmapCheap unsafePatchMapWithMove $ coincidence $ fforCheap e $ \p -> if Map.null (unPatchMapWithMove p) then never else
1050+ let firingNewItems = mergeMap $ fforMaybe (unPatchMapWithMove p) $ \ni -> case PatchMapWithMove._nodeInfo_from ni of
1051+ PatchMapWithMove.From_Insert ev -> Just $ fforCheap ev $ \v ->
1052+ ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Insert v }
1053+ _ -> Nothing
1054+ oldItemMask = fforCheap e $ \_ -> ffor (unPatchMapWithMove p) $ \ni -> case PatchMapWithMove._nodeInfo_from ni of
1055+ PatchMapWithMove.From_Delete ->
1056+ ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
1057+ PatchMapWithMove.From_Move k ->
1058+ ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Move k }
1059+ PatchMapWithMove.From_Insert _ ->
1060+ ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }
1061+ in alignWith (mergeThese Map.union) firingNewItems oldItemMask -- Must be left-biased
10541062
10551063-- | Given a 'PatchTarget' of events (e.g., a 'Map' with 'Event' values) and an event of 'Patch'es
10561064-- (e.g., a 'PatchMap' with 'Event' values), produce an 'Event' of the 'PatchTarget' type that