@@ -84,7 +84,7 @@ deriving instance ( GCompare k
84data NodeInfo k p a = NodeInfo
84data NodeInfo k p a = NodeInfo
85 { _nodeInfo_from :: !(From k p a)
85 { _nodeInfo_from :: !(From k p a)
86 -- ^Change applying to the current key, be it an insert, move, or delete.
86 -- ^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))
88 -- ^Where this key is moving to, if involved in a move. Should only be @ComposeMaybe (Just k)@ when there is a corresponding 'From_Move'.
88 -- ^Where this key is moving to, if involved in a move. Should only be @ComposeMaybe (Just k)@ when there is a corresponding 'From_Move'.
@@ -170,20 +170,20 @@ validationErrorsForPatchDMapWithMove m =
170 noSelfMoves = mapMaybe selfMove . DMap.toAscList $ m
170 noSelfMoves = mapMaybe selfMove . DMap.toAscList $ m
171 selfMove (dst :=> NodeInfo (From_Move src _) _)
171 selfMove (dst :=> NodeInfo (From_Move src _) _)
172 | Just _ <- dst `geq` src = Just $ "self move of key " <> gshow src <> " at destination side"
172 | 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))))
174 | Just _ <- src `geq` dst = Just $ "self move of key " <> gshow dst <> " at source side"
174 | Just _ <- src `geq` dst = Just $ "self move of key " <> gshow dst <> " at source side"
175 selfMove _ = Nothing
175 selfMove _ = Nothing
176 movesBalanced = mapMaybe unbalancedMove . DMap.toAscList $ m
176 movesBalanced = mapMaybe unbalancedMove . DMap.toAscList $ m
177 unbalancedMove (dst :=> NodeInfo (From_Move src _) _) =
177 unbalancedMove (dst :=> NodeInfo (From_Move src _) _) =
178 case DMap.lookup src m of
178 case DMap.lookup src m of
179 Nothing -> Just $ "unbalanced move at destination key " <> gshow dst <> " supposedly from " <> gshow src <> " but source key is not in the patch"
179 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')))) ->
181 if isNothing (dst' `geq` dst)
181 if isNothing (dst' `geq` dst)
182 then Just $ "unbalanced move at destination key " <> gshow dst <> " from " <> gshow src <> " is going to " <> gshow dst' <> " instead"
182 then Just $ "unbalanced move at destination key " <> gshow dst <> " from " <> gshow src <> " is going to " <> gshow dst' <> " instead"
183 else Nothing
183 else Nothing
185 Just $ "unbalanced move at destination key " <> gshow dst <> " supposedly from " <> gshow src <> " but source key has no move to key"
185 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)))) =
187 case DMap.lookup dst m of
187 case DMap.lookup dst m of
188 Nothing -> Just $ " unbalanced move at source key " <> gshow src <> " supposedly going to " <> gshow dst <> " but destination key is not in the patch"
188 Nothing -> Just $ " unbalanced move at source key " <> gshow src <> " supposedly going to " <> gshow dst <> " but destination key is not in the patch"
189 Just (NodeInfo (From_Move src' _) _) ->
189 Just (NodeInfo (From_Move src' _) _) ->
@@ -198,6 +198,8 @@ validationErrorsForPatchDMapWithMove m =
198-- |Higher kinded 2-tuple, identical to @Data.Functor.Product@ from base ≥ 4.9
198-- |Higher kinded 2-tuple, identical to @Data.Functor.Product@ from base ≥ 4.9
199data Pair1 f g a = Pair1 (f a) (g a)
199data Pair1 f g a = Pair1 (f a) (g a)
201+data PairHalf a f b = PairHalf a (f b)
201-- |Helper data structure used for composing patches using the monoid instance.
203-- |Helper data structure used for composing patches using the monoid instance.
202data Fixup k v a
204data Fixup k v a
203 = Fixup_Delete
205 = Fixup_Delete
@@ -210,9 +212,12 @@ instance ( GCompare k
210 ) => Semigroup (PatchDMapWithMove k p) where
212 ) => Semigroup (PatchDMapWithMove k p) where
211 PatchDMapWithMove ma <> PatchDMapWithMove mb = PatchDMapWithMove m
213 PatchDMapWithMove ma <> PatchDMapWithMove mb = PatchDMapWithMove m
213− connections = DMap.toList $ DMap.intersectionWithKey (\_ a b -> Pair1 (_nodeInfo_to a) (_nodeInfo_from b)) ma mb
215+ connections = DMap.toList $ DMap.intersectionWithKey
216+ (\_ a b -> PairHalf (_nodeInfo_to a) (_nodeInfo_from b))
214− h :: DSum k (Pair1 (ComposeMaybe k) (From k v)) -> [DSum k (Fixup k v)]
219+ h :: DSum k (PairHalf (Some (ComposeMaybe k)) (From k v)) -> [DSum k (Fixup k v)]
215− h (_ :=> Pair1 (ComposeMaybe mToAfter) editBefore) = case (mToAfter, editBefore) of
220+ h (between :=> PairHalf (Some (ComposeMaybe mToAfter)) editBefore) = case (mToAfter, editBefore) of
216 (Just toAfter, From_Move fromBefore p)
221 (Just toAfter, From_Move fromBefore p)
217 | case fromBefore `geq` toAfter of
222 | case fromBefore `geq` toAfter of
218 Nothing -> False
223 Nothing -> False