on develop help sign in
Try making the "to" field at a potentially different index

This isn't good enough. I think there is a bug in that we don't store enough information in the two field: we need both inner patches with the join so we can combine them together. In the non-dependent case, nothing stops us from making this misake, but in the dependent case we would need to use a `Category` instance on the inner move patches. We plainly aren't combining two inner patches in the double move case, and the types let us know.

commitd72221c4c76887d8a32ef8830280a6dcee9f2220 authorJohn Ericson <git@JohnEricson.me> dateSat 11 Jan 2020, 04:11 (7 years ago) parentaa7311b
1 file changed+12−7
src/Data/Patch/DMapWithMove.hs+12−7
src/Data/Patch/DMapWithMove.hs+12−7
@@ -84,7 +84,7 @@ deriving instance ( GCompare k
8484data NodeInfo k p a = NodeInfo
8585 { _nodeInfo_from :: !(From k p a)
8686 -- ^Change applying to the current key, be it an insert, move, or delete.
87− , _nodeInfo_to :: !(To k a)
87+ , _nodeInfo_to :: !(Some (To k))
8888 -- ^Where this key is moving to, if involved in a move. Should only be @ComposeMaybe (Just k)@ when there is a corresponding 'From_Move'.
8989 }
9090
@@ -170,20 +170,20 @@ validationErrorsForPatchDMapWithMove m =
170170 noSelfMoves = mapMaybe selfMove . DMap.toAscList $ m
171171 selfMove (dst :=> NodeInfo (From_Move src _) _)
172172 | Just _ <- dst `geq` src = Just $ "self move of key " <> gshow src <> " at destination side"
173− selfMove (src :=> NodeInfo _ (ComposeMaybe (Just dst)))
173+ selfMove (src :=> NodeInfo _ (Some (ComposeMaybe (Just dst))))
174174 | Just _ <- src `geq` dst = Just $ "self move of key " <> gshow dst <> " at source side"
175175 selfMove _ = Nothing
176176 movesBalanced = mapMaybe unbalancedMove . DMap.toAscList $ m
177177 unbalancedMove (dst :=> NodeInfo (From_Move src _) _) =
178178 case DMap.lookup src m of
179179 Nothing -> Just $ "unbalanced move at destination key " <> gshow dst <> " supposedly from " <> gshow src <> " but source key is not in the patch"
180− Just (NodeInfo _ (ComposeMaybe (Just dst'))) ->
180+ Just (NodeInfo _ (Some (ComposeMaybe (Just dst')))) ->
181181 if isNothing (dst' `geq` dst)
182182 then Just $ "unbalanced move at destination key " <> gshow dst <> " from " <> gshow src <> " is going to " <> gshow dst' <> " instead"
183183 else Nothing
184184 _ ->
185185 Just $ "unbalanced move at destination key " <> gshow dst <> " supposedly from " <> gshow src <> " but source key has no move to key"
186− unbalancedMove (src :=> NodeInfo _ (ComposeMaybe (Just dst))) =
186+ unbalancedMove (src :=> NodeInfo _ (Some (ComposeMaybe (Just dst)))) =
187187 case DMap.lookup dst m of
188188 Nothing -> Just $ " unbalanced move at source key " <> gshow src <> " supposedly going to " <> gshow dst <> " but destination key is not in the patch"
189189 Just (NodeInfo (From_Move src' _) _) ->
@@ -198,6 +198,8 @@ validationErrorsForPatchDMapWithMove m =
198198-- |Higher kinded 2-tuple, identical to @Data.Functor.Product@ from base ≥ 4.9
199199data Pair1 f g a = Pair1 (f a) (g a)
200200
201+data PairHalf a f b = PairHalf a (f b)
202+
201203-- |Helper data structure used for composing patches using the monoid instance.
202204data Fixup k v a
203205 = Fixup_Delete
@@ -210,9 +212,12 @@ instance ( GCompare k
210212 ) => Semigroup (PatchDMapWithMove k p) where
211213 PatchDMapWithMove ma <> PatchDMapWithMove mb = PatchDMapWithMove m
212214 where
213− connections = DMap.toList $ DMap.intersectionWithKey (\_ a b -> Pair1 (_nodeInfo_to a) (_nodeInfo_from b)) ma mb
214− h :: DSum k (Pair1 (ComposeMaybe k) (From k v)) -> [DSum k (Fixup k v)]
215− h (_ :=> Pair1 (ComposeMaybe mToAfter) editBefore) = case (mToAfter, editBefore) of
215+ connections = DMap.toList $ DMap.intersectionWithKey
216+ (\_ a b -> PairHalf (_nodeInfo_to a) (_nodeInfo_from b))
217+ ma
218+ mb
219+ h :: DSum k (PairHalf (Some (ComposeMaybe k)) (From k v)) -> [DSum k (Fixup k v)]
220+ h (between :=> PairHalf (Some (ComposeMaybe mToAfter)) editBefore) = case (mToAfter, editBefore) of
216221 (Just toAfter, From_Move fromBefore p)
217222 | case fromBefore `geq` toAfter of
218223 Nothing -> False