@@ -1,4 +1,5 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2+{-# LANGUAGE ConstraintKinds #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE GADTs #-}
5{-# LANGUAGE GADTs #-}
@@ -8,8 +9,11 @@
8{-# LANGUAGE PolyKinds #-}
9{-# LANGUAGE PolyKinds #-}
9{-# LANGUAGE Rank2Types #-}
10{-# LANGUAGE Rank2Types #-}
10{-# LANGUAGE ScopedTypeVariables #-}
11{-# LANGUAGE ScopedTypeVariables #-}
12+{-# LANGUAGE StandaloneDeriving #-}
13+{-# LANGUAGE TypeApplications #-}
11{-# LANGUAGE TypeFamilies #-}
14{-# LANGUAGE TypeFamilies #-}
12{-# LANGUAGE UndecidableInstances #-}
15{-# LANGUAGE UndecidableInstances #-}
16+{-# LANGUAGE UndecidableSuperClasses #-}
14-- |Module containing @'PatchDMapWithMove' k v@ and associated functions, which represents a 'Patch' to a @'DMap' k v@ which can insert, update, delete, and
18-- |Module containing @'PatchDMapWithMove' k v@ and associated functions, which represents a 'Patch' to a @'DMap' k v@ which can insert, update, delete, and
15-- move values between keys.
19-- move values between keys.
@@ -20,22 +24,34 @@ import Data.Patch.MapWithMove (PatchMapWithMove (..))
20import qualified Data.Patch.MapWithMove as MapWithMove
24import qualified Data.Patch.MapWithMove as MapWithMove
22import Data.Constraint.Extras
26import Data.Constraint.Extras
27+import Data.Constraint.Compose
23−import Data.Dependent.Map (DMap)
28+import Data.Dependent.Map (DMap, DSum (..), GCompare (..))
24−import Data.Dependent.Sum (DSum (..))
25import qualified Data.Dependent.Map as DMap
29import qualified Data.Dependent.Map as DMap
26import Data.Functor.Constant
30import Data.Functor.Constant
27import Data.Functor.Misc
31import Data.Functor.Misc
28import Data.Functor.Product
32import Data.Functor.Product
29−import Data.GADT.Compare (GEq (..), GCompare (..))
33+import Data.GADT.Compare (GEq (..), GCompare)
30−import Data.GADT.Show (GShow, gshow)
34+import Data.GADT.Show (GRead, GShow, gshow)
31import qualified Data.Map as Map
35import qualified Data.Map as Map
32import Data.Maybe
36import Data.Maybe
33import Data.Monoid.DecidablyEmpty
37import Data.Monoid.DecidablyEmpty
34−#if !MIN_VERSION_base(4,11,0)
35−import Data.Semigroup (Semigroup (..))
38+import Data.Semigroup (Semigroup (..), (<>))
37−import Data.Some (Some, mkSome)
39+import Data.Some (Some(Some))
38import Data.These
41import Data.These
42+import Data.Type.Equality ((:~:) (..))
43+import Data.Kind (Constraint)
46+-- | Composition for constraints.
47+class p (f a a) => DupC (p :: k2 -> Constraint) (f :: k1 -> k1 -> k2) (a :: k1)
48+instance p (f a a) => DupC p f a
50+type ConstraintsForZip f (c :: k -> Constraint) (g :: k' -> k' -> k) =
51+ ConstraintsFor f (DupC c g)
53+type HasZip (c :: k -> Constraint) f (g :: k' -> k' -> k) =
54+ (ArgDict (DupC c g) f, ConstraintsForZip f c g)
40-- | Like 'PatchMapWithMove', but for 'DMap'. Each key carries a 'NodeInfo' which describes how it will be changed by the patch and connects move sources and
56-- | Like 'PatchMapWithMove', but for 'DMap'. Each key carries a 'NodeInfo' which describes how it will be changed by the patch and connects move sources and
41-- destinations.
57-- destinations.
@@ -46,63 +62,131 @@ import Data.These
46-- * A move should always be represented with both the destination key (as a 'From_Move') and the source key (as a @'ComposeMaybe' ('Just' destination)@)
62-- * A move should always be represented with both the destination key (as a 'From_Move') and the source key (as a @'ComposeMaybe' ('Just' destination)@)
47newtype PatchDMapWithMove k v = PatchDMapWithMove (DMap k (NodeInfo k v))
63newtype PatchDMapWithMove k v = PatchDMapWithMove (DMap k (NodeInfo k v))
49−-- It won't let me derive for some reason
65+deriving instance ( GShow k
67+ , Has' Show k (PatchTarget1 p)
68+ ) => Show (PatchDMapWithMove k p)
69+deriving instance ( GRead k
71+ , Has' Read k (PatchTarget1 p)
72+ ) => Read (PatchDMapWithMove k p)
73+deriving instance ( GEq k
75+ , Has' Eq k (PatchTarget1 p)
76+ ) => Eq (PatchDMapWithMove k p)
50−instance GCompare k => DecidablyEmpty (PatchDMapWithMove k v) where
77+deriving instance ( GCompare k
51− isEmpty (PatchDMapWithMove m) = DMap.null m
78+ , HasZip Ord k p
79+ , Has' Ord k (PatchTarget1 p)
80+ ) => Ord (PatchDMapWithMove k p)
53-- |Structure which represents what changes apply to a particular key. @_nodeInfo_from@ specifies what happens to this key, and in particular what other key
82-- |Structure which represents what changes apply to a particular key. @_nodeInfo_from@ specifies what happens to this key, and in particular what other key
54-- the current key is moving from, while @_nodeInfo_to@ specifies what key the current key is moving to if involved in a move.
83-- the current key is moving from, while @_nodeInfo_to@ specifies what key the current key is moving to if involved in a move.
55−data NodeInfo k v a = NodeInfo
84+data NodeInfo k p a = NodeInfo
56− { _nodeInfo_from :: !(From k v a)
85+ { _nodeInfo_from :: !(From k p a)
57 -- ^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.
58− , _nodeInfo_to :: !(To k a)
87+ , _nodeInfo_to :: !(Some (To k))
59 -- ^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'.
61− deriving (Show)
91+deriving instance ( Show (k a)
93+ , Show (PatchTarget1 p a)
94+ ) => Show (NodeInfo k p a)
95+deriving instance ( Read (k a)
97+ , Read (PatchTarget1 p a)
98+ ) => Read (NodeInfo k p a)
99+deriving instance ( Eq (k a)
101+ , Eq (PatchTarget1 p a)
102+ ) => Eq (NodeInfo k p a)
103+deriving instance ( Ord (k a)
105+ , Ord (PatchTarget1 p a)
106+ ) => Ord (NodeInfo k p a)
63-- |Structure describing a particular change to a key, be it inserting a new key (@From_Insert@), updating an existing key (@From_Insert@ again), deleting a
108-- |Structure describing a particular change to a key, be it inserting a new key (@From_Insert@), updating an existing key (@From_Insert@ again), deleting a
64-- key (@From_Delete@), or moving a key (@From_Move@).
109-- key (@From_Delete@), or moving a key (@From_Move@).
65−data From (k :: a -> *) (v :: a -> *) :: a -> * where
110+data From (k :: a -> *) (p :: a -> a -> *) :: a -> * where
66− -- |Insert a new or update an existing key with the given value @v a@
111+ -- |Insert a new or update an existing key with the given value @PatchTarget1 p a@
67− From_Insert :: v a -> From k v a
112+ From_Insert :: PatchTarget1 p a -> From k p a
68 -- |Delete the existing key
113 -- |Delete the existing key
69− From_Delete :: From k v a
114+ From_Delete :: From k p a
70 -- |Move the value from the given key @k a@ to this key. The source key should also have an entry in the patch giving the current key as @_nodeInfo_to@,
115 -- |Move the value from the given key @k a@ to this key. The source key should also have an entry in the patch giving the current key as @_nodeInfo_to@,
71 -- usually but not necessarily with @From_Delete@.
116 -- usually but not necessarily with @From_Delete@.
72− From_Move :: !(k a) -> From k v a
117+ From_Move :: !(k a0) -> p a0 a1 -> From k p a1
73− deriving (Show, Read, Eq, Ord)
118+
119+deriving instance ( Show (k a)
121+ , Show (PatchTarget1 p a)
122+ ) => Show (From k p a)
123+deriving instance ( Read (k a)
125+ , Read (PatchTarget1 p a)
126+ ) => Read (From k p a)
130+ , Eq (PatchTarget1 p a)
131+ ) => Eq (From k p a) where
132+ From_Insert p0 == From_Insert p1 = p0 == p1
133+ From_Delete == From_Delete = True
134+ From_Move k0 p0 == From_Move k1 p1 = case geq k0 k1 of
136+ Just Refl -> has @(DupC Eq p) k0 $ p0 == p1
138+instance ( GCompare k
140+ , Ord (PatchTarget1 p a)
141+ ) => Ord (From k p a) where
142+ From_Insert p0 `compare` From_Insert p1 = p0 `compare` p1
143+ From_Delete `compare` From_Delete = EQ
144+ From_Move k0 p0 `compare` From_Move k1 p1 = case gcompare k0 k1 of
146+ DMap.GEQ -> has @(DupC Ord p) k0 $ p0 `compare` p1
75-- |Type alias for the "to" part of a 'NodeInfo'. @'ComposeMaybe' ('Just' k)@ means the key is moving to another key, @ComposeMaybe Nothing@ for any other
149-- |Type alias for the "to" part of a 'NodeInfo'. @'ComposeMaybe' ('Just' k)@ means the key is moving to another key, @ComposeMaybe Nothing@ for any other
76-- operation.
150-- operation.
77type To = ComposeMaybe
151type To = ComposeMaybe
79-- |Test whether a 'PatchDMapWithMove' satisfies its invariants.
153-- |Test whether a 'PatchDMapWithMove' satisfies its invariants.
80−validPatchDMapWithMove :: forall k v. (GCompare k, GShow k) => DMap k (NodeInfo k v) -> Bool
154+validPatchDMapWithMove
156+ . (GCompare k, GShow k)
157+ => DMap k (NodeInfo k v)
81validPatchDMapWithMove = not . null . validationErrorsForPatchDMapWithMove
159validPatchDMapWithMove = not . null . validationErrorsForPatchDMapWithMove
83-- |Enumerate what reasons a 'PatchDMapWithMove' doesn't satisfy its invariants, returning @[]@ if it's valid.
161-- |Enumerate what reasons a 'PatchDMapWithMove' doesn't satisfy its invariants, returning @[]@ if it's valid.
84−validationErrorsForPatchDMapWithMove :: forall k v. (GCompare k, GShow k) => DMap k (NodeInfo k v) -> [String]
162+validationErrorsForPatchDMapWithMove
164+ . (GCompare k, GShow k)
165+ => DMap k (NodeInfo k v)
85validationErrorsForPatchDMapWithMove m =
167validationErrorsForPatchDMapWithMove m =
86 noSelfMoves <> movesBalanced
168 noSelfMoves <> movesBalanced
88 noSelfMoves = mapMaybe selfMove . DMap.toAscList $ m
170 noSelfMoves = mapMaybe selfMove . DMap.toAscList $ m
171+ selfMove (dst :=> NodeInfo (From_Move src _) _)
89− selfMove (dst :=> NodeInfo (From_Move src) _) | 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 _ (Some (ComposeMaybe (Just dst))))
90− selfMove (src :=> NodeInfo _ (ComposeMaybe (Just dst))) | 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"
91 selfMove _ = Nothing
175 selfMove _ = Nothing
92 movesBalanced = mapMaybe unbalancedMove . DMap.toAscList $ m
176 movesBalanced = mapMaybe unbalancedMove . DMap.toAscList $ m
93− unbalancedMove (dst :=> NodeInfo (From_Move src) _) =
177+ unbalancedMove (dst :=> NodeInfo (From_Move src _) _) =
94 case DMap.lookup src m of
178 case DMap.lookup src m of
95 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"
96− Just (NodeInfo _ (ComposeMaybe (Just dst'))) ->
180+ Just (NodeInfo _ (Some (ComposeMaybe (Just dst')))) ->
97 if isNothing (dst' `geq` dst)
181 if isNothing (dst' `geq` dst)
98 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"
99 else Nothing
183 else Nothing
101 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"
102− unbalancedMove (src :=> NodeInfo _ (ComposeMaybe (Just dst))) =
186+ unbalancedMove (src :=> NodeInfo _ (Some (ComposeMaybe (Just dst)))) =
103 case DMap.lookup dst m of
187 case DMap.lookup dst m of
104 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"
105− Just (NodeInfo (From_Move src') _) ->
189+ Just (NodeInfo (From_Move src' _) _) ->
106 if isNothing (src' `geq` src)
190 if isNothing (src' `geq` src)
107 then Just $ "unbalanced move at source key " <> gshow src <> " to " <> gshow dst <> " is coming from " <> gshow src' <> " instead"
191 then Just $ "unbalanced move at source key " <> gshow src <> " to " <> gshow dst <> " is coming from " <> gshow src' <> " instead"
108 else Nothing
192 else Nothing
@@ -111,33 +195,39 @@ validationErrorsForPatchDMapWithMove m =
111 Just $ "unbalanced move at source key " <> gshow src <> " supposedly going to " <> gshow dst <> " but destination key is not moving"
195 Just $ "unbalanced move at source key " <> gshow src <> " supposedly going to " <> gshow dst <> " but destination key is not moving"
112 unbalancedMove _ = Nothing
196 unbalancedMove _ = Nothing
114−-- |Test whether two @'PatchDMapWithMove' k v@ contain the same patch operations.
115−instance (GEq k, Has' Eq k (NodeInfo k v)) => Eq (PatchDMapWithMove k v) where
116− PatchDMapWithMove a == PatchDMapWithMove b = a == b
118-- |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
119data 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)
121-- |Helper data structure used for composing patches using the monoid instance.
203-- |Helper data structure used for composing patches using the monoid instance.
122data Fixup k v a
204data Fixup k v a
123 = Fixup_Delete
205 = Fixup_Delete
124 | Fixup_Update (These (From k v a) (To k a))
206 | Fixup_Update (These (From k v a) (To k a))
126-- |Compose patches having the same effect as applying the patches in turn: @'applyAlways' (p <> q) == 'applyAlways' p . 'applyAlways' q@
208-- |Compose patches having the same effect as applying the patches in turn: @'applyAlways' (p <> q) == 'applyAlways' p . 'applyAlways' q@
209+instance ( GCompare k
210+ -- , DecidablyEmpty p
127−instance GCompare k => Semigroup (PatchDMapWithMove k v) where
212+ ) => Semigroup (PatchDMapWithMove k p) where
128 PatchDMapWithMove ma <> PatchDMapWithMove mb = PatchDMapWithMove m
213 PatchDMapWithMove ma <> PatchDMapWithMove mb = PatchDMapWithMove m
130− 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))
131− 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)]
132− h (_ :=> Pair1 (ComposeMaybe mToAfter) editBefore) = case (mToAfter, editBefore) of
220+ h (between :=> PairHalf (Some (ComposeMaybe mToAfter)) editBefore) = case (mToAfter, editBefore) of
133− (Just toAfter, From_Move fromBefore)
221+ (Just toAfter, From_Move fromBefore p)
134− | isJust $ fromBefore `geq` toAfter
222+ | case fromBefore `geq` toAfter of
224+ Just Refl -> isNull p
135 -> [toAfter :=> Fixup_Delete]
225 -> [toAfter :=> Fixup_Delete]
136 | otherwise
226 | otherwise
137 -> [ toAfter :=> Fixup_Update (This editBefore)
227 -> [ toAfter :=> Fixup_Update (This editBefore)
138 , fromBefore :=> Fixup_Update (That (ComposeMaybe mToAfter))
228 , fromBefore :=> Fixup_Update (That (ComposeMaybe mToAfter))
140− (Nothing, From_Move fromBefore) -> [fromBefore :=> Fixup_Update (That (ComposeMaybe mToAfter))] -- The item is destroyed in the second patch, so indicate that it is destroyed in the source map
230+ (Nothing, From_Move fromBefore _) -> [fromBefore :=> Fixup_Update (That (ComposeMaybe mToAfter))] -- The item is destroyed in the second patch, so indicate that it is destroyed in the source map
141 (Just toAfter, _) -> [toAfter :=> Fixup_Update (This editBefore)]
231 (Just toAfter, _) -> [toAfter :=> Fixup_Update (This editBefore)]
142 (Nothing, _) -> []
232 (Nothing, _) -> []
143 mergeFixups _ Fixup_Delete Fixup_Delete = Fixup_Delete
233 mergeFixups _ Fixup_Delete Fixup_Delete = Fixup_Delete
@@ -155,7 +245,13 @@ instance GCompare k => Semigroup (PatchDMapWithMove k v) where
155 applyFixup _ ni = \case
245 applyFixup _ ni = \case
156 Fixup_Delete -> Nothing
246 Fixup_Delete -> Nothing
157 Fixup_Update u -> Just $ NodeInfo
247 Fixup_Update u -> Just $ NodeInfo
158− { _nodeInfo_from = fromMaybe (_nodeInfo_from ni) $ getHere u
248+ { _nodeInfo_from = case _nodeInfo_from ni of
249+ f@(From_Move _ p') -> case getHere u of -- The `from` fixup comes from the "old" patch
250+ Nothing -> f -- If there's no `from` fixup, just use the "new" `from`
251+ Just (From_Insert v) -> From_Insert $ applyAlways p' v
252+ Just From_Delete -> From_Delete
253+ Just (From_Move oldKey p) -> From_Move oldKey $ p' <> p
254+ _ -> error "DPatchMapWithMove: fixup for non-move From"
159 , _nodeInfo_to = fromMaybe (_nodeInfo_to ni) $ getThere u
255 , _nodeInfo_to = fromMaybe (_nodeInfo_to ni) $ getThere u
161 m = DMap.differenceWithKey applyFixup (DMap.unionWithKey combineNodeInfos ma mb) fixups
257 m = DMap.differenceWithKey applyFixup (DMap.unionWithKey combineNodeInfos ma mb) fixups
@@ -176,7 +272,7 @@ instance GCompare k => Monoid (PatchDMapWithMove k v) where
176 mappend = (<>)
272 mappend = (<>)
179−mappendPatchDMapWithMoveSlow :: forall k v. (ShowTag k v, GCompare k) => PatchDMapWithMove k v -> PatchDMapWithMove k v -> PatchDMapWithMove k v
275+mappendPatchDMapWithMoveSlow :: forall k v. (ShowTag k v, GCompare k) => PatchDMapWithMove k v -> PatchDMapWithMove k v -> PatchDMapWithMove k v
180PatchDMapWithMove dstAfter srcAfter `mappendPatchDMapWithMoveSlow` PatchDMapWithMove dstBefore srcBefore = PatchDMapWithMove dst src
276PatchDMapWithMove dstAfter srcAfter `mappendPatchDMapWithMoveSlow` PatchDMapWithMove dstBefore srcBefore = PatchDMapWithMove dst src
182 getDstAction k m = fromMaybe (From_Move k) $ DMap.lookup k m -- Any key that isn't present is treated as that key moving to itself
278 getDstAction k m = fromMaybe (From_Move k) $ DMap.lookup k m -- Any key that isn't present is treated as that key moving to itself
@@ -197,8 +293,8 @@ PatchDMapWithMove dstAfter srcAfter `mappendPatchDMapWithMoveSlow` PatchDMapWith
197 src = DMap.mapMaybeWithKey g $ DMap.union srcAfter srcBefore
293 src = DMap.mapMaybeWithKey g $ DMap.union srcAfter srcBefore
200−-- |Make a @'PatchDMapWithMove' k v@ which has the effect of inserting or updating a value @v a@ to the given key @k a@, like 'DMap.insert'.
296+-- |Make a @'PatchDMapWithMove' k v@ which has the effect of inserting or updating a value @PatchTarget1 p a@ to the given key @k a@, like 'DMap.insert'.
201−insertDMapKey :: k a -> v a -> PatchDMapWithMove k v
297+insertDMapKey :: k a -> PatchTarget1 p a -> PatchDMapWithMove k p
202insertDMapKey k v =
298insertDMapKey k v =
203 PatchDMapWithMove . DMap.singleton k $ NodeInfo (From_Insert v) (ComposeMaybe Nothing)
299 PatchDMapWithMove . DMap.singleton k $ NodeInfo (From_Insert v) (ComposeMaybe Nothing)
@@ -220,8 +316,8 @@ moveDMapKey src dst = case src `geq` dst of
221-- let aMay = DMap.lookup a dmap
317-- let aMay = DMap.lookup a dmap
222-- bMay = DMap.lookup b dmap
318-- bMay = DMap.lookup b dmap
223−-- in maybe id (DMap.insert a) (bMay <> aMay)
319+-- in maybe id (DMap.insert a) (bMay `mplus` aMay)
224−-- . maybe id (DMap.insert b) (aMay <> bMay)
320+-- . maybe id (DMap.insert b) (aMay `mplus` bMay)
225-- . DMap.delete a . DMap.delete b $ dmap
321-- . DMap.delete a . DMap.delete b $ dmap
227swapDMapKey :: GCompare k => k a -> k a -> PatchDMapWithMove k v
323swapDMapKey :: GCompare k => k a -> k a -> PatchDMapWithMove k v
@@ -279,88 +375,123 @@ patchDMapWithMove dm =
279 errs -> Left errs
375 errs -> Left errs
281-- |Map a natural transform @v -> v'@ over the given patch, transforming @'PatchDMapWithMove' k v@ into @'PatchDMapWithMove' k v'@.
377-- |Map a natural transform @v -> v'@ over the given patch, transforming @'PatchDMapWithMove' k v@ into @'PatchDMapWithMove' k v'@.
282−mapPatchDMapWithMove :: forall k v v'. (forall a. v a -> v' a) -> PatchDMapWithMove k v -> PatchDMapWithMove k v'
378+mapPatchDMapWithMove
380+ . (forall a. PatchTarget1 p a -> PatchTarget1 p' a)
381+ -> PatchDMapWithMove k p
382+ -> PatchDMapWithMove k p'
283mapPatchDMapWithMove f (PatchDMapWithMove p) = PatchDMapWithMove $
383mapPatchDMapWithMove f (PatchDMapWithMove p) = PatchDMapWithMove $
284 DMap.map (\ni -> ni { _nodeInfo_from = g $ _nodeInfo_from ni }) p
384 DMap.map (\ni -> ni { _nodeInfo_from = g $ _nodeInfo_from ni }) p
285− where g :: forall a. From k v a -> From k v' a
385+ where g :: forall a. From k PatchTarget1 p a -> From k PatchTarget1 p' a
286 g = \case
386 g = \case
287 From_Insert v -> From_Insert $ f v
387 From_Insert v -> From_Insert $ f v
288 From_Delete -> From_Delete
388 From_Delete -> From_Delete
289 From_Move k -> From_Move k
389 From_Move k -> From_Move k
291−-- |Traverse an effectful function @forall a. v a -> m (v ' a)@ over the given patch, transforming @'PatchDMapWithMove' k v@ into @m ('PatchDMapWithMove' k v')@.
391+-- |Traverse an effectful function @forall a. PatchTarget1 p a -> m (v ' a)@ over the given patch, transforming @'PatchDMapWithMove' k v@ into @m ('PatchDMapWithMove' k v')@.
292−traversePatchDMapWithMove :: forall m k v v'. Applicative m => (forall a. v a -> m (v' a)) -> PatchDMapWithMove k v -> m (PatchDMapWithMove k v')
392+traversePatchDMapWithMove
395+ => (forall a. PatchTarget1 p a -> m (PatchTarget1 p' a))
396+ -> PatchDMapWithMove k p
397+ -> m (PatchDMapWithMove k p')
293traversePatchDMapWithMove f = traversePatchDMapWithMoveWithKey $ const f
398traversePatchDMapWithMove f = traversePatchDMapWithMoveWithKey $ const f
295−-- |Map an effectful function @forall a. k a -> v a -> m (v ' a)@ over the given patch, transforming @'PatchDMapWithMove' k v@ into @m ('PatchDMapWithMove' k v')@.
400+-- |Map an effectful function @forall a. k a -> PatchTarget1 p a -> m (v ' a)@ over the given patch, transforming @'PatchDMapWithMove' k v@ into @m ('PatchDMapWithMove' k v')@.
296−traversePatchDMapWithMoveWithKey :: forall m k v v'. Applicative m => (forall a. k a -> v a -> m (v' a)) -> PatchDMapWithMove k v -> m (PatchDMapWithMove k v')
401+traversePatchDMapWithMoveWithKey
404+ => (forall a. k a -> PatchTarget1 p a -> m (PatchTarget1 p' a))
405+ -> PatchDMapWithMove k p
406+ -> m (PatchDMapWithMove k p')
407+traversePatchDMapWithMoveWithKey f (PatchDMapWithMove p) =
297−traversePatchDMapWithMoveWithKey f (PatchDMapWithMove p) = PatchDMapWithMove <$> DMap.traverseWithKey (nodeInfoMapFromM . g) p
408+ PatchDMapWithMove <$> DMap.traverseWithKey (nodeInfoMapFromM . g) p
298− where g :: forall a. k a -> From k v a -> m (From k v' a)
409+ where g :: forall a. k a -> From k PatchTarget1 p a -> m (From k PatchTarget1 p' a)
299 g k = \case
410 g k = \case
300 From_Insert v -> From_Insert <$> f k v
411 From_Insert v -> From_Insert <$> f k v
301 From_Delete -> pure From_Delete
412 From_Delete -> pure From_Delete
302 From_Move fromKey -> pure $ From_Move fromKey
413 From_Move fromKey -> pure $ From_Move fromKey
304−-- |Map a function which transforms @'From' k v a@ into a @'From' k v' a@ over a @'NodeInfo' k v a@.
415+-- |Map a function which transforms @'From' k PatchTarget1 p a@ into a @'From' k PatchTarget1 p' a@ over a @'NodeInfo' k PatchTarget1 p a@.
305−nodeInfoMapFrom :: (From k v a -> From k v' a) -> NodeInfo k v a -> NodeInfo k v' a
416+nodeInfoMapFrom
417+ :: (From k p a -> From k p' a)
306nodeInfoMapFrom f ni = ni { _nodeInfo_from = f $ _nodeInfo_from ni }
420nodeInfoMapFrom f ni = ni { _nodeInfo_from = f $ _nodeInfo_from ni }
308−-- |Map an effectful function which transforms @'From' k v a@ into a @f ('From' k v' a)@ over a @'NodeInfo' k v a@.
422+-- |Map an effectful function which transforms @'From' k PatchTarget1 p a@ into a @f ('From' k PatchTarget1 p' a)@ over a @'NodeInfo' k PatchTarget1 p a@.
309−nodeInfoMapFromM :: Functor f => (From k v a -> f (From k v' a)) -> NodeInfo k v a -> f (NodeInfo k v' a)
423+nodeInfoMapFromM
425+ => (From k p a -> f (From k p' a))
427+ -> f (NodeInfo k p' a)
310nodeInfoMapFromM f ni = fmap (\result -> ni { _nodeInfo_from = result }) $ f $ _nodeInfo_from ni
428nodeInfoMapFromM f ni = fmap (\result -> ni { _nodeInfo_from = result }) $ f $ _nodeInfo_from ni
312−-- |Weaken a 'PatchDMapWithMove' to a 'PatchMapWithMove' by weakening the keys from @k a@ to @'Some' k@ and applying a given weakening function @v a -> v'@ to
430+-- |Weaken a 'PatchDMapWithMove' to a 'PatchMapWithMove' by weakening the keys from @k a@ to @'Some' k@ and applying a given weakening function @PatchTarget1 p a -> v'@ to
313-- values.
431-- values.
314−weakenPatchDMapWithMoveWith :: forall k v v'. (forall a. v a -> v') -> PatchDMapWithMove k v -> PatchMapWithMove (Some k) v'
432+weakenPatchDMapWithMoveWith
434+ . (forall a. PatchTarget1 p a -> v')
435+ -> PatchDMapWithMove k p
436+ -> PatchMapWithMove (Some k) (Proxy v')
315weakenPatchDMapWithMoveWith f (PatchDMapWithMove p) = PatchMapWithMove $ weakenDMapWith g p
437weakenPatchDMapWithMoveWith f (PatchDMapWithMove p) = PatchMapWithMove $ weakenDMapWith g p
316− where g :: forall a. NodeInfo k v a -> MapWithMove.NodeInfo (Some k) v'
438+ where g :: forall a. NodeInfo k PatchTarget1 p a -> MapWithMove.NodeInfo (Some k) (Proxy v')
317 g ni = MapWithMove.NodeInfo
439 g ni = MapWithMove.NodeInfo
318 { MapWithMove._nodeInfo_from = case _nodeInfo_from ni of
440 { MapWithMove._nodeInfo_from = case _nodeInfo_from ni of
319 From_Insert v -> MapWithMove.From_Insert $ f v
441 From_Insert v -> MapWithMove.From_Insert $ f v
320 From_Delete -> MapWithMove.From_Delete
442 From_Delete -> MapWithMove.From_Delete
321− From_Move k -> MapWithMove.From_Move $ mkSome k
443+ From_Move k -> MapWithMove.From_Move (Some k) Proxy
322− , MapWithMove._nodeInfo_to = mkSome <$> getComposeMaybe (_nodeInfo_to ni)
444+ , MapWithMove._nodeInfo_to = Some <$> getComposeMaybe (_nodeInfo_to ni)
325-- |"Weaken" a @'PatchDMapWithMove' (Const2 k a) v@ to a @'PatchMapWithMove' k v'@. Weaken is in scare quotes because the 'Const2' has already disabled any
447-- |"Weaken" a @'PatchDMapWithMove' (Const2 k a) v@ to a @'PatchMapWithMove' k v'@. Weaken is in scare quotes because the 'Const2' has already disabled any
326-- dependency in the typing and all points are already @a@, hence the function to map each value to @v'@ is not higher rank.
448-- dependency in the typing and all points are already @a@, hence the function to map each value to @v'@ is not higher rank.
327−patchDMapWithMoveToPatchMapWithMoveWith :: forall k v v' a. (v a -> v') -> PatchDMapWithMove (Const2 k a) v -> PatchMapWithMove k v'
449+patchDMapWithMoveToPatchMapWithMoveWith
450+ :: forall k p v' a. (PatchTarget1 p a -> v')
451+ -> PatchDMapWithMove (Const2 k a) p
452+ -> PatchMapWithMove k (Proxy v')
328patchDMapWithMoveToPatchMapWithMoveWith f (PatchDMapWithMove p) = PatchMapWithMove $ dmapToMapWith g p
453patchDMapWithMoveToPatchMapWithMoveWith f (PatchDMapWithMove p) = PatchMapWithMove $ dmapToMapWith g p
329− where g :: NodeInfo (Const2 k a) v a -> MapWithMove.NodeInfo k v'
454+ where g :: NodeInfo (Const2 k a) PatchTarget1 p a -> MapWithMove.NodeInfo k (Proxy v')
330 g ni = MapWithMove.NodeInfo
455 g ni = MapWithMove.NodeInfo
331 { MapWithMove._nodeInfo_from = case _nodeInfo_from ni of
456 { MapWithMove._nodeInfo_from = case _nodeInfo_from ni of
332 From_Insert v -> MapWithMove.From_Insert $ f v
457 From_Insert v -> MapWithMove.From_Insert $ f v
333 From_Delete -> MapWithMove.From_Delete
458 From_Delete -> MapWithMove.From_Delete
334− From_Move (Const2 k) -> MapWithMove.From_Move k
459+ From_Move (Const2 k) -> MapWithMove.From_Move k Proxy
335 , MapWithMove._nodeInfo_to = unConst2 <$> getComposeMaybe (_nodeInfo_to ni)
460 , MapWithMove._nodeInfo_to = unConst2 <$> getComposeMaybe (_nodeInfo_to ni)
338-- |"Strengthen" a @'PatchMapWithMove' k v@ into a @'PatchDMapWithMove ('Const2' k a)@; that is, turn a non-dependently-typed patch into a dependently typed
463-- |"Strengthen" a @'PatchMapWithMove' k v@ into a @'PatchDMapWithMove ('Const2' k a)@; that is, turn a non-dependently-typed patch into a dependently typed
339−-- one but which always has a constant key type represented by 'Const2'. Apply the given function to each @v@ to produce a @v' a@.
464+-- one but which always has a constant key type represented by 'Const2'. Apply the given function to each @v@ to produce a @PatchTarget1 p' a@.
340-- Completemented by 'patchDMapWithMoveToPatchMapWithMoveWith'
465-- Completemented by 'patchDMapWithMoveToPatchMapWithMoveWith'
341−const2PatchDMapWithMoveWith :: forall k v v' a. (v -> v' a) -> PatchMapWithMove k v -> PatchDMapWithMove (Const2 k a) v'
466+const2PatchDMapWithMoveWith
468+ . (v -> PatchTarget1 p' a)
469+ -> PatchMapWithMove k (Proxy v)
470+ -> PatchDMapWithMove (Const2 k a) p'
342const2PatchDMapWithMoveWith f (PatchMapWithMove p) = PatchDMapWithMove $ DMap.fromDistinctAscList $ g <$> Map.toAscList p
471const2PatchDMapWithMoveWith f (PatchMapWithMove p) = PatchDMapWithMove $ DMap.fromDistinctAscList $ g <$> Map.toAscList p
343− where g :: (k, MapWithMove.NodeInfo k v) -> DSum (Const2 k a) (NodeInfo (Const2 k a) v')
472+ where g :: (k, MapWithMove.NodeInfo k (Proxy v)) -> DSum (Const2 k a) (NodeInfo (Const2 k a) v')
344 g (k, ni) = Const2 k :=> NodeInfo
473 g (k, ni) = Const2 k :=> NodeInfo
345 { _nodeInfo_from = case MapWithMove._nodeInfo_from ni of
474 { _nodeInfo_from = case MapWithMove._nodeInfo_from ni of
346 MapWithMove.From_Insert v -> From_Insert $ f v
475 MapWithMove.From_Insert v -> From_Insert $ f v
347 MapWithMove.From_Delete -> From_Delete
476 MapWithMove.From_Delete -> From_Delete
348− MapWithMove.From_Move fromKey -> From_Move $ Const2 fromKey
477+ MapWithMove.From_Move fromKey Proxy -> From_Move $ Const2 fromKey
349 , _nodeInfo_to = ComposeMaybe $ Const2 <$> MapWithMove._nodeInfo_to ni
478 , _nodeInfo_to = ComposeMaybe $ Const2 <$> MapWithMove._nodeInfo_to ni
352-- | Apply the insertions, deletions, and moves to a given 'DMap'.
481-- | Apply the insertions, deletions, and moves to a given 'DMap'.
353−instance GCompare k => Patch (PatchDMapWithMove k v) where
482+instance GCompare k => PatchHet (PatchDMapWithMove k p) where
483+ type PatchSource (PatchDMapWithMove k p) = DMap k (PatchSource1 p)
354− type PatchTarget (PatchDMapWithMove k v) = DMap k v
484+ type PatchTarget (PatchDMapWithMove k p) = DMap k (PatchTarget1 p)
485+instance GCompare k => Patch (PatchDMapWithMove k p) where
355 apply (PatchDMapWithMove p) old = Just $! insertions `DMap.union` (old `DMap.difference` deletions) --TODO: return Nothing sometimes --Note: the strict application here is critical to ensuring that incremental merges don't hold onto all their prerequisite events forever; can we make this more robust?
486 apply (PatchDMapWithMove p) old = Just $! insertions `DMap.union` (old `DMap.difference` deletions) --TODO: return Nothing sometimes --Note: the strict application here is critical to ensuring that incremental merges don't hold onto all their prerequisite events forever; can we make this more robust?
356 where insertions = DMap.mapMaybeWithKey insertFunc p
487 where insertions = DMap.mapMaybeWithKey insertFunc p
357− insertFunc :: forall a. k a -> NodeInfo k v a -> Maybe (v a)
488+ insertFunc :: forall a. k a -> NodeInfo k p a -> Maybe (PatchTarget1 p a)
358 insertFunc _ ni = case _nodeInfo_from ni of
489 insertFunc _ ni = case _nodeInfo_from ni of
359 From_Insert v -> Just v
490 From_Insert v -> Just v
360 From_Move k -> DMap.lookup k old
491 From_Move k -> DMap.lookup k old
361 From_Delete -> Nothing
492 From_Delete -> Nothing
362 deletions = DMap.mapMaybeWithKey deleteFunc p
493 deletions = DMap.mapMaybeWithKey deleteFunc p
363− deleteFunc :: forall a. k a -> NodeInfo k v a -> Maybe (Constant () a)
494+ deleteFunc :: forall a. k a -> NodeInfo k p a -> Maybe (Constant () a)
364 deleteFunc _ ni = case _nodeInfo_from ni of
495 deleteFunc _ ni = case _nodeInfo_from ni of
365 From_Delete -> Just $ Constant ()
496 From_Delete -> Just $ Constant ()
366 _ -> Nothing
497 _ -> Nothing