@@ -186,7 +186,7 @@ data Fixup k v
186 | Fixup_Update (These (From k v) (To k))
186 | Fixup_Update (These (From k v) (To k))
188-- |Compose patches having the same effect as applying the patches in turn: @'applyAlways' (p <> q) == 'applyAlways' p . 'applyAlways' q@
188-- |Compose patches having the same effect as applying the patches in turn: @'applyAlways' (p <> q) == 'applyAlways' p . 'applyAlways' q@
189−instance (Ord k, Monoid p, Eq p) => Semigroup (PatchMapWithMove2 k p) where
189+instance (Ord k, Monoid p, Eq p, Patch p) => Semigroup (PatchMapWithMove2 k p) where
190 PatchMapWithMove2 ma <> PatchMapWithMove2 mb = PatchMapWithMove2 m
190 PatchMapWithMove2 ma <> PatchMapWithMove2 mb = PatchMapWithMove2 m
192 connections = Map.toList $ Map.intersectionWithKey (\_ a b -> (_nodeInfo_to a, _nodeInfo_from b)) ma mb
192 connections = Map.toList $ Map.intersectionWithKey (\_ a b -> (_nodeInfo_to a, _nodeInfo_from b)) ma mb
@@ -217,13 +217,13 @@ instance (Ord k, Monoid p, Eq p) => Semigroup (PatchMapWithMove2 k p) where
217 applyFixup _ ni = \case
217 applyFixup _ ni = \case
218 Fixup_Delete -> Nothing
218 Fixup_Delete -> Nothing
219 Fixup_Update u -> Just $ NodeInfo
219 Fixup_Update u -> Just $ NodeInfo
220+ { _nodeInfo_from = case _nodeInfo_from ni of
220− { _nodeInfo_from = case getHere u of -- The `from` fixup comes from the "old" patch
221+ f@(From_Move _ p') -> case getHere u of -- The `from` fixup comes from the "old" patch
221− Nothing -> _nodeInfo_from ni -- If there's no `from` fixup, just use the "new" `from`
222+ Nothing -> f -- If there's no `from` fixup, just use the "new" `from`
222− Just (From_Insert v) -> From_Insert v
223+ Just (From_Insert v) -> From_Insert $ applyAlways p' v
223− Just From_Delete -> From_Delete
224+ Just From_Delete -> From_Delete
224− Just (From_Move oldKey p) -> case _nodeInfo_from ni of
225− From_Move _ p' -> From_Move oldKey $ p' <> p
225+ Just (From_Move oldKey p) -> From_Move oldKey $ p' <> p
226− _ -> error "PatchMapWithMove2: fixup for non-move From"
226+ _ -> error "PatchMapWithMove2: fixup for non-move From"
227 , _nodeInfo_to = fromMaybe (_nodeInfo_to ni) $ getThere u
227 , _nodeInfo_to = fromMaybe (_nodeInfo_to ni) $ getThere u
229 m = Map.differenceWithKey applyFixup (Map.unionWithKey combineNodeInfos ma mb) fixups
229 m = Map.differenceWithKey applyFixup (Map.unionWithKey combineNodeInfos ma mb) fixups
@@ -240,6 +240,6 @@ instance (Ord k, Monoid p, Eq p) => Semigroup (PatchMapWithMove2 k p) where
241--TODO: Figure out how to implement this in terms of PatchDMapWithMove rather than duplicating it here
241--TODO: Figure out how to implement this in terms of PatchDMapWithMove rather than duplicating it here
242-- |Compose patches having the same effect as applying the patches in turn: @'applyAlways' (p <> q) == 'applyAlways' p . 'applyAlways' q@
242-- |Compose patches having the same effect as applying the patches in turn: @'applyAlways' (p <> q) == 'applyAlways' p . 'applyAlways' q@
243−instance (Ord k, Monoid p, Eq p) => Monoid (PatchMapWithMove2 k p) where
243+instance (Ord k, Monoid p, Eq p, Patch p) => Monoid (PatchMapWithMove2 k p) where
244 mempty = PatchMapWithMove2 mempty
244 mempty = PatchMapWithMove2 mempty
245 mappend = (<>)
245 mappend = (<>)