@@ -1,5 +1,4 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2−{-# LANGUAGE ConstraintKinds #-}
3{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE GADTs #-}
4{-# LANGUAGE GADTs #-}
@@ -9,11 +8,8 @@
9{-# LANGUAGE PolyKinds #-}
8{-# LANGUAGE PolyKinds #-}
10{-# LANGUAGE Rank2Types #-}
9{-# LANGUAGE Rank2Types #-}
11{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE ScopedTypeVariables #-}
12−{-# LANGUAGE StandaloneDeriving #-}
13−{-# LANGUAGE TypeApplications #-}
14{-# LANGUAGE TypeFamilies #-}
11{-# LANGUAGE TypeFamilies #-}
15{-# LANGUAGE UndecidableInstances #-}
12{-# LANGUAGE UndecidableInstances #-}
16−{-# LANGUAGE UndecidableSuperClasses #-}
18-- |Module containing @'PatchDMapWithMove' k v@ and associated functions, which represents a 'Patch' to a @'DMap' k v@ which can insert, update, delete, and
14-- |Module containing @'PatchDMapWithMove' k v@ and associated functions, which represents a 'Patch' to a @'DMap' k v@ which can insert, update, delete, and
19-- move values between keys.
15-- move values between keys.
@@ -24,34 +20,22 @@ import Data.Patch.MapWithMove (PatchMapWithMove (..))
24import qualified Data.Patch.MapWithMove as MapWithMove
20import qualified Data.Patch.MapWithMove as MapWithMove
26import Data.Constraint.Extras
22import Data.Constraint.Extras
27−import Data.Constraint.Compose
28−import Data.Dependent.Map (DMap, DSum (..), GCompare (..))
23+import Data.Dependent.Map (DMap)
24+import Data.Dependent.Sum (DSum (..))
29import qualified Data.Dependent.Map as DMap
25import qualified Data.Dependent.Map as DMap
30import Data.Functor.Constant
26import Data.Functor.Constant
31import Data.Functor.Misc
27import Data.Functor.Misc
32import Data.Functor.Product
28import Data.Functor.Product
33−import Data.GADT.Compare (GEq (..), GCompare)
29+import Data.GADT.Compare (GEq (..), GCompare (..))
34−import Data.GADT.Show (GRead, GShow, gshow)
30+import Data.GADT.Show (GShow, gshow)
35import qualified Data.Map as Map
31import qualified Data.Map as Map
36import Data.Maybe
32import Data.Maybe
37import Data.Monoid.DecidablyEmpty
33import Data.Monoid.DecidablyEmpty
34+#if !MIN_VERSION_base(4,11,0)
38−import Data.Semigroup (Semigroup (..), (<>))
35+import Data.Semigroup (Semigroup (..))
39−import Data.Some (Some(Some))
37+import Data.Some (Some, mkSome)
41import Data.These
38import 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)
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
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
57-- destinations.
41-- destinations.
@@ -62,131 +46,63 @@ type HasZip (c :: k -> Constraint) f (g :: k' -> k' -> k) =
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)@)
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)@)
63newtype PatchDMapWithMove k v = PatchDMapWithMove (DMap k (NodeInfo k v))
47newtype PatchDMapWithMove k v = PatchDMapWithMove (DMap k (NodeInfo k v))
65−deriving instance ( GShow k
49+-- It won't let me derive for some reason
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)
77−deriving instance ( GCompare k
50+instance GCompare k => DecidablyEmpty (PatchDMapWithMove k v) where
79− , Has' Ord k (PatchTarget1 p)
80− ) => Ord (PatchDMapWithMove k p)
51+ isEmpty (PatchDMapWithMove m) = DMap.null m
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
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
83-- the current key is moving from, while @_nodeInfo_to@ specifies what key the current key is moving to if involved in a move.
54-- the current key is moving from, while @_nodeInfo_to@ specifies what key the current key is moving to if involved in a move.
84−data NodeInfo k p a = NodeInfo
55+data NodeInfo k v a = NodeInfo
85− { _nodeInfo_from :: !(From k p a)
56+ { _nodeInfo_from :: !(From k v a)
86 -- ^Change applying to the current key, be it an insert, move, or delete.
57 -- ^Change applying to the current key, be it an insert, move, or delete.
87− , _nodeInfo_to :: !(Some (To k))
58+ , _nodeInfo_to :: !(To k a)
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'.
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'.
91−deriving instance ( Show (k a)
61+ deriving (Show)
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)
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
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
109-- key (@From_Delete@), or moving a key (@From_Move@).
64-- key (@From_Delete@), or moving a key (@From_Move@).
110−data From (k :: a -> *) (p :: a -> a -> *) :: a -> * where
65+data From (k :: a -> *) (v :: a -> *) :: a -> * where
111− -- |Insert a new or update an existing key with the given value @PatchTarget1 p a@
66+ -- |Insert a new or update an existing key with the given value @v a@
112− From_Insert :: PatchTarget1 p a -> From k p a
67+ From_Insert :: v a -> From k v a
113 -- |Delete the existing key
68 -- |Delete the existing key
114− From_Delete :: From k p a
69+ From_Delete :: From k v a
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@,
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@,
116 -- usually but not necessarily with @From_Delete@.
71 -- usually but not necessarily with @From_Delete@.
117− From_Move :: !(k a0) -> p a0 a1 -> From k p a1
72+ From_Move :: !(k a) -> From k v a
118−
73+ deriving (Show, Read, Eq, Ord)
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
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
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
150-- operation.
76-- operation.
151type To = ComposeMaybe
77type To = ComposeMaybe
153-- |Test whether a 'PatchDMapWithMove' satisfies its invariants.
79-- |Test whether a 'PatchDMapWithMove' satisfies its invariants.
154−validPatchDMapWithMove
80+validPatchDMapWithMove :: forall k v. (GCompare k, GShow k) => DMap k (NodeInfo k v) -> Bool
156− . (GCompare k, GShow k)
157− => DMap k (NodeInfo k v)
159validPatchDMapWithMove = not . null . validationErrorsForPatchDMapWithMove
81validPatchDMapWithMove = not . null . validationErrorsForPatchDMapWithMove
161-- |Enumerate what reasons a 'PatchDMapWithMove' doesn't satisfy its invariants, returning @[]@ if it's valid.
83-- |Enumerate what reasons a 'PatchDMapWithMove' doesn't satisfy its invariants, returning @[]@ if it's valid.
162−validationErrorsForPatchDMapWithMove
84+validationErrorsForPatchDMapWithMove :: forall k v. (GCompare k, GShow k) => DMap k (NodeInfo k v) -> [String]
164− . (GCompare k, GShow k)
165− => DMap k (NodeInfo k v)
167validationErrorsForPatchDMapWithMove m =
85validationErrorsForPatchDMapWithMove m =
168 noSelfMoves <> movesBalanced
86 noSelfMoves <> movesBalanced
170 noSelfMoves = mapMaybe selfMove . DMap.toAscList $ m
88 noSelfMoves = mapMaybe selfMove . DMap.toAscList $ m
171− selfMove (dst :=> NodeInfo (From_Move src _) _)
172− | Just _ <- dst `geq` src = Just $ "self move of key " <> gshow src <> " at destination side"
89+ selfMove (dst :=> NodeInfo (From_Move src) _) | Just _ <- dst `geq` src = Just $ "self move of key " <> gshow src <> " at destination side"
173− selfMove (src :=> NodeInfo _ (Some (ComposeMaybe (Just dst))))
174− | Just _ <- src `geq` dst = Just $ "self move of key " <> gshow dst <> " at source side"
90+ selfMove (src :=> NodeInfo _ (ComposeMaybe (Just dst))) | Just _ <- src `geq` dst = Just $ "self move of key " <> gshow dst <> " at source side"
175 selfMove _ = Nothing
91 selfMove _ = Nothing
176 movesBalanced = mapMaybe unbalancedMove . DMap.toAscList $ m
92 movesBalanced = mapMaybe unbalancedMove . DMap.toAscList $ m
177− unbalancedMove (dst :=> NodeInfo (From_Move src _) _) =
93+ unbalancedMove (dst :=> NodeInfo (From_Move src) _) =
178 case DMap.lookup src m of
94 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"
95 Nothing -> Just $ "unbalanced move at destination key " <> gshow dst <> " supposedly from " <> gshow src <> " but source key is not in the patch"
180− Just (NodeInfo _ (Some (ComposeMaybe (Just dst')))) ->
96+ Just (NodeInfo _ (ComposeMaybe (Just dst'))) ->
181 if isNothing (dst' `geq` dst)
97 if isNothing (dst' `geq` dst)
182 then Just $ "unbalanced move at destination key " <> gshow dst <> " from " <> gshow src <> " is going to " <> gshow dst' <> " instead"
98 then Just $ "unbalanced move at destination key " <> gshow dst <> " from " <> gshow src <> " is going to " <> gshow dst' <> " instead"
183 else Nothing
99 else Nothing
185 Just $ "unbalanced move at destination key " <> gshow dst <> " supposedly from " <> gshow src <> " but source key has no move to key"
101 Just $ "unbalanced move at destination key " <> gshow dst <> " supposedly from " <> gshow src <> " but source key has no move to key"
186− unbalancedMove (src :=> NodeInfo _ (Some (ComposeMaybe (Just dst)))) =
102+ unbalancedMove (src :=> NodeInfo _ (ComposeMaybe (Just dst))) =
187 case DMap.lookup dst m of
103 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"
104 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' _) _) ->
105+ Just (NodeInfo (From_Move src') _) ->
190 if isNothing (src' `geq` src)
106 if isNothing (src' `geq` src)
191 then Just $ "unbalanced move at source key " <> gshow src <> " to " <> gshow dst <> " is coming from " <> gshow src' <> " instead"
107 then Just $ "unbalanced move at source key " <> gshow src <> " to " <> gshow dst <> " is coming from " <> gshow src' <> " instead"
192 else Nothing
108 else Nothing
@@ -195,39 +111,33 @@ validationErrorsForPatchDMapWithMove m =
195 Just $ "unbalanced move at source key " <> gshow src <> " supposedly going to " <> gshow dst <> " but destination key is not moving"
111 Just $ "unbalanced move at source key " <> gshow src <> " supposedly going to " <> gshow dst <> " but destination key is not moving"
196 unbalancedMove _ = Nothing
112 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
198-- |Higher kinded 2-tuple, identical to @Data.Functor.Product@ from base ≥ 4.9
118-- |Higher kinded 2-tuple, identical to @Data.Functor.Product@ from base ≥ 4.9
199data Pair1 f g a = Pair1 (f a) (g a)
119data Pair1 f g a = Pair1 (f a) (g a)
201−data PairHalf a f b = PairHalf a (f b)
203-- |Helper data structure used for composing patches using the monoid instance.
121-- |Helper data structure used for composing patches using the monoid instance.
204data Fixup k v a
122data Fixup k v a
205 = Fixup_Delete
123 = Fixup_Delete
206 | Fixup_Update (These (From k v a) (To k a))
124 | Fixup_Update (These (From k v a) (To k a))
208-- |Compose patches having the same effect as applying the patches in turn: @'applyAlways' (p <> q) == 'applyAlways' p . 'applyAlways' q@
126-- |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
212− ) => Semigroup (PatchDMapWithMove k p) where
127+instance GCompare k => Semigroup (PatchDMapWithMove k v) where
213 PatchDMapWithMove ma <> PatchDMapWithMove mb = PatchDMapWithMove m
128 PatchDMapWithMove ma <> PatchDMapWithMove mb = PatchDMapWithMove m
215− connections = DMap.toList $ DMap.intersectionWithKey
130+ connections = DMap.toList $ DMap.intersectionWithKey (\_ a b -> Pair1 (_nodeInfo_to a) (_nodeInfo_from b)) ma mb
216− (\_ a b -> PairHalf (_nodeInfo_to a) (_nodeInfo_from b))
219− h :: DSum k (PairHalf (Some (ComposeMaybe k)) (From k v)) -> [DSum k (Fixup k v)]
131+ h :: DSum k (Pair1 (ComposeMaybe k) (From k v)) -> [DSum k (Fixup k v)]
220− h (between :=> PairHalf (Some (ComposeMaybe mToAfter)) editBefore) = case (mToAfter, editBefore) of
132+ h (_ :=> Pair1 (ComposeMaybe mToAfter) editBefore) = case (mToAfter, editBefore) of
221− (Just toAfter, From_Move fromBefore p)
133+ (Just toAfter, From_Move fromBefore)
222− | case fromBefore `geq` toAfter of
134+ | isJust $ fromBefore `geq` toAfter
224− Just Refl -> isNull p
225 -> [toAfter :=> Fixup_Delete]
135 -> [toAfter :=> Fixup_Delete]
226 | otherwise
136 | otherwise
227 -> [ toAfter :=> Fixup_Update (This editBefore)
137 -> [ toAfter :=> Fixup_Update (This editBefore)
228 , fromBefore :=> Fixup_Update (That (ComposeMaybe mToAfter))
138 , fromBefore :=> Fixup_Update (That (ComposeMaybe mToAfter))
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
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
231 (Just toAfter, _) -> [toAfter :=> Fixup_Update (This editBefore)]
141 (Just toAfter, _) -> [toAfter :=> Fixup_Update (This editBefore)]
232 (Nothing, _) -> []
142 (Nothing, _) -> []
233 mergeFixups _ Fixup_Delete Fixup_Delete = Fixup_Delete
143 mergeFixups _ Fixup_Delete Fixup_Delete = Fixup_Delete
@@ -245,13 +155,7 @@ instance ( GCompare k
245 applyFixup _ ni = \case
155 applyFixup _ ni = \case
246 Fixup_Delete -> Nothing
156 Fixup_Delete -> Nothing
247 Fixup_Update u -> Just $ NodeInfo
157 Fixup_Update u -> Just $ NodeInfo
248− { _nodeInfo_from = case _nodeInfo_from ni of
158+ { _nodeInfo_from = fromMaybe (_nodeInfo_from ni) $ getHere u
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"
255 , _nodeInfo_to = fromMaybe (_nodeInfo_to ni) $ getThere u
159 , _nodeInfo_to = fromMaybe (_nodeInfo_to ni) $ getThere u
257 m = DMap.differenceWithKey applyFixup (DMap.unionWithKey combineNodeInfos ma mb) fixups
161 m = DMap.differenceWithKey applyFixup (DMap.unionWithKey combineNodeInfos ma mb) fixups
@@ -272,7 +176,7 @@ instance GCompare k => Monoid (PatchDMapWithMove k v) where
272 mappend = (<>)
176 mappend = (<>)
275−mappendPatchDMapWithMoveSlow :: forall k v. (ShowTag k v, GCompare k) => PatchDMapWithMove k v -> PatchDMapWithMove k v -> PatchDMapWithMove k v
179+mappendPatchDMapWithMoveSlow :: forall k v. (ShowTag k v, GCompare k) => PatchDMapWithMove k v -> PatchDMapWithMove k v -> PatchDMapWithMove k v
276PatchDMapWithMove dstAfter srcAfter `mappendPatchDMapWithMoveSlow` PatchDMapWithMove dstBefore srcBefore = PatchDMapWithMove dst src
180PatchDMapWithMove dstAfter srcAfter `mappendPatchDMapWithMoveSlow` PatchDMapWithMove dstBefore srcBefore = PatchDMapWithMove dst src
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
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
@@ -293,8 +197,8 @@ PatchDMapWithMove dstAfter srcAfter `mappendPatchDMapWithMoveSlow` PatchDMapWith
293 src = DMap.mapMaybeWithKey g $ DMap.union srcAfter srcBefore
197 src = DMap.mapMaybeWithKey g $ DMap.union srcAfter srcBefore
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'.
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'.
297−insertDMapKey :: k a -> PatchTarget1 p a -> PatchDMapWithMove k p
201+insertDMapKey :: k a -> v a -> PatchDMapWithMove k v
298insertDMapKey k v =
202insertDMapKey k v =
299 PatchDMapWithMove . DMap.singleton k $ NodeInfo (From_Insert v) (ComposeMaybe Nothing)
203 PatchDMapWithMove . DMap.singleton k $ NodeInfo (From_Insert v) (ComposeMaybe Nothing)
@@ -316,8 +220,8 @@ moveDMapKey src dst = case src `geq` dst of
317-- let aMay = DMap.lookup a dmap
221-- let aMay = DMap.lookup a dmap
318-- bMay = DMap.lookup b dmap
222-- bMay = DMap.lookup b dmap
319−-- in maybe id (DMap.insert a) (bMay `mplus` aMay)
223+-- in maybe id (DMap.insert a) (bMay <> aMay)
320−-- . maybe id (DMap.insert b) (aMay `mplus` bMay)
224+-- . maybe id (DMap.insert b) (aMay <> bMay)
321-- . DMap.delete a . DMap.delete b $ dmap
225-- . DMap.delete a . DMap.delete b $ dmap
323swapDMapKey :: GCompare k => k a -> k a -> PatchDMapWithMove k v
227swapDMapKey :: GCompare k => k a -> k a -> PatchDMapWithMove k v
@@ -375,123 +279,88 @@ patchDMapWithMove dm =
375 errs -> Left errs
279 errs -> Left errs
377-- |Map a natural transform @v -> v'@ over the given patch, transforming @'PatchDMapWithMove' k v@ into @'PatchDMapWithMove' k v'@.
281-- |Map a natural transform @v -> v'@ over the given patch, transforming @'PatchDMapWithMove' k v@ into @'PatchDMapWithMove' k v'@.
378−mapPatchDMapWithMove
282+mapPatchDMapWithMove :: forall k v v'. (forall a. v a -> v' a) -> PatchDMapWithMove k v -> PatchDMapWithMove k v'
380− . (forall a. PatchTarget1 p a -> PatchTarget1 p' a)
381− -> PatchDMapWithMove k p
382− -> PatchDMapWithMove k p'
383mapPatchDMapWithMove f (PatchDMapWithMove p) = PatchDMapWithMove $
283mapPatchDMapWithMove f (PatchDMapWithMove p) = PatchDMapWithMove $
384 DMap.map (\ni -> ni { _nodeInfo_from = g $ _nodeInfo_from ni }) p
284 DMap.map (\ni -> ni { _nodeInfo_from = g $ _nodeInfo_from ni }) p
385− where g :: forall a. From k PatchTarget1 p a -> From k PatchTarget1 p' a
285+ where g :: forall a. From k v a -> From k v' a
386 g = \case
286 g = \case
387 From_Insert v -> From_Insert $ f v
287 From_Insert v -> From_Insert $ f v
388 From_Delete -> From_Delete
288 From_Delete -> From_Delete
389 From_Move k -> From_Move k
289 From_Move k -> From_Move k
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')@.
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')@.
392−traversePatchDMapWithMove
292+traversePatchDMapWithMove :: forall m k v v'. Applicative m => (forall a. v a -> m (v' a)) -> PatchDMapWithMove k v -> m (PatchDMapWithMove k v')
395− => (forall a. PatchTarget1 p a -> m (PatchTarget1 p' a))
396− -> PatchDMapWithMove k p
397− -> m (PatchDMapWithMove k p')
398traversePatchDMapWithMove f = traversePatchDMapWithMoveWithKey $ const f
293traversePatchDMapWithMove f = traversePatchDMapWithMoveWithKey $ const f
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')@.
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')@.
401−traversePatchDMapWithMoveWithKey
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')
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) =
408− PatchDMapWithMove <$> DMap.traverseWithKey (nodeInfoMapFromM . g) p
297+traversePatchDMapWithMoveWithKey f (PatchDMapWithMove p) = PatchDMapWithMove <$> DMap.traverseWithKey (nodeInfoMapFromM . g) p
409− where g :: forall a. k a -> From k PatchTarget1 p a -> m (From k PatchTarget1 p' a)
298+ where g :: forall a. k a -> From k v a -> m (From k v' a)
410 g k = \case
299 g k = \case
411 From_Insert v -> From_Insert <$> f k v
300 From_Insert v -> From_Insert <$> f k v
412 From_Delete -> pure From_Delete
301 From_Delete -> pure From_Delete
413 From_Move fromKey -> pure $ From_Move fromKey
302 From_Move fromKey -> pure $ From_Move fromKey
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@.
304+-- |Map a function which transforms @'From' k v a@ into a @'From' k v' a@ over a @'NodeInfo' k v a@.
416−nodeInfoMapFrom
305+nodeInfoMapFrom :: (From k v a -> From k v' a) -> NodeInfo k v a -> NodeInfo k v' a
417− :: (From k p a -> From k p' a)
420nodeInfoMapFrom f ni = ni { _nodeInfo_from = f $ _nodeInfo_from ni }
306nodeInfoMapFrom f ni = ni { _nodeInfo_from = f $ _nodeInfo_from ni }
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@.
308+-- |Map an effectful function which transforms @'From' k v a@ into a @f ('From' k v' a)@ over a @'NodeInfo' k v a@.
423−nodeInfoMapFromM
309+nodeInfoMapFromM :: Functor f => (From k v a -> f (From k v' a)) -> NodeInfo k v a -> f (NodeInfo k v' a)
425− => (From k p a -> f (From k p' a))
427− -> f (NodeInfo k p' a)
428nodeInfoMapFromM f ni = fmap (\result -> ni { _nodeInfo_from = result }) $ f $ _nodeInfo_from ni
310nodeInfoMapFromM f ni = fmap (\result -> ni { _nodeInfo_from = result }) $ f $ _nodeInfo_from ni
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
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
431-- values.
313-- values.
432−weakenPatchDMapWithMoveWith
314+weakenPatchDMapWithMoveWith :: forall k v v'. (forall a. v a -> v') -> PatchDMapWithMove k v -> PatchMapWithMove (Some k) v'
434− . (forall a. PatchTarget1 p a -> v')
435− -> PatchDMapWithMove k p
436− -> PatchMapWithMove (Some k) (Proxy v')
437weakenPatchDMapWithMoveWith f (PatchDMapWithMove p) = PatchMapWithMove $ weakenDMapWith g p
315weakenPatchDMapWithMoveWith f (PatchDMapWithMove p) = PatchMapWithMove $ weakenDMapWith g p
438− where g :: forall a. NodeInfo k PatchTarget1 p a -> MapWithMove.NodeInfo (Some k) (Proxy v')
316+ where g :: forall a. NodeInfo k v a -> MapWithMove.NodeInfo (Some k) v'
439 g ni = MapWithMove.NodeInfo
317 g ni = MapWithMove.NodeInfo
440 { MapWithMove._nodeInfo_from = case _nodeInfo_from ni of
318 { MapWithMove._nodeInfo_from = case _nodeInfo_from ni of
441 From_Insert v -> MapWithMove.From_Insert $ f v
319 From_Insert v -> MapWithMove.From_Insert $ f v
442 From_Delete -> MapWithMove.From_Delete
320 From_Delete -> MapWithMove.From_Delete
443− From_Move k -> MapWithMove.From_Move (Some k) Proxy
321+ From_Move k -> MapWithMove.From_Move $ mkSome k
444− , MapWithMove._nodeInfo_to = Some <$> getComposeMaybe (_nodeInfo_to ni)
322+ , MapWithMove._nodeInfo_to = mkSome <$> getComposeMaybe (_nodeInfo_to ni)
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
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
448-- dependency in the typing and all points are already @a@, hence the function to map each value to @v'@ is not higher rank.
326-- dependency in the typing and all points are already @a@, hence the function to map each value to @v'@ is not higher rank.
449−patchDMapWithMoveToPatchMapWithMoveWith
327+patchDMapWithMoveToPatchMapWithMoveWith :: forall k v v' a. (v a -> v') -> PatchDMapWithMove (Const2 k a) v -> PatchMapWithMove k v'
450− :: forall k p v' a. (PatchTarget1 p a -> v')
451− -> PatchDMapWithMove (Const2 k a) p
452− -> PatchMapWithMove k (Proxy v')
453patchDMapWithMoveToPatchMapWithMoveWith f (PatchDMapWithMove p) = PatchMapWithMove $ dmapToMapWith g p
328patchDMapWithMoveToPatchMapWithMoveWith f (PatchDMapWithMove p) = PatchMapWithMove $ dmapToMapWith g p
454− where g :: NodeInfo (Const2 k a) PatchTarget1 p a -> MapWithMove.NodeInfo k (Proxy v')
329+ where g :: NodeInfo (Const2 k a) v a -> MapWithMove.NodeInfo k v'
455 g ni = MapWithMove.NodeInfo
330 g ni = MapWithMove.NodeInfo
456 { MapWithMove._nodeInfo_from = case _nodeInfo_from ni of
331 { MapWithMove._nodeInfo_from = case _nodeInfo_from ni of
457 From_Insert v -> MapWithMove.From_Insert $ f v
332 From_Insert v -> MapWithMove.From_Insert $ f v
458 From_Delete -> MapWithMove.From_Delete
333 From_Delete -> MapWithMove.From_Delete
459− From_Move (Const2 k) -> MapWithMove.From_Move k Proxy
334+ From_Move (Const2 k) -> MapWithMove.From_Move k
460 , MapWithMove._nodeInfo_to = unConst2 <$> getComposeMaybe (_nodeInfo_to ni)
335 , MapWithMove._nodeInfo_to = unConst2 <$> getComposeMaybe (_nodeInfo_to ni)
463-- |"Strengthen" a @'PatchMapWithMove' k v@ into a @'PatchDMapWithMove ('Const2' k a)@; that is, turn a non-dependently-typed patch into a dependently typed
338-- |"Strengthen" a @'PatchMapWithMove' k v@ into a @'PatchDMapWithMove ('Const2' k a)@; that is, turn a non-dependently-typed patch into a dependently typed
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@.
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@.
465-- Completemented by 'patchDMapWithMoveToPatchMapWithMoveWith'
340-- Completemented by 'patchDMapWithMoveToPatchMapWithMoveWith'
466−const2PatchDMapWithMoveWith
341+const2PatchDMapWithMoveWith :: forall k v v' a. (v -> v' a) -> PatchMapWithMove k v -> PatchDMapWithMove (Const2 k a) v'
468− . (v -> PatchTarget1 p' a)
469− -> PatchMapWithMove k (Proxy v)
470− -> PatchDMapWithMove (Const2 k a) p'
471const2PatchDMapWithMoveWith f (PatchMapWithMove p) = PatchDMapWithMove $ DMap.fromDistinctAscList $ g <$> Map.toAscList p
342const2PatchDMapWithMoveWith f (PatchMapWithMove p) = PatchDMapWithMove $ DMap.fromDistinctAscList $ g <$> Map.toAscList p
472− where g :: (k, MapWithMove.NodeInfo k (Proxy v)) -> DSum (Const2 k a) (NodeInfo (Const2 k a) v')
343+ where g :: (k, MapWithMove.NodeInfo k v) -> DSum (Const2 k a) (NodeInfo (Const2 k a) v')
473 g (k, ni) = Const2 k :=> NodeInfo
344 g (k, ni) = Const2 k :=> NodeInfo
474 { _nodeInfo_from = case MapWithMove._nodeInfo_from ni of
345 { _nodeInfo_from = case MapWithMove._nodeInfo_from ni of
475 MapWithMove.From_Insert v -> From_Insert $ f v
346 MapWithMove.From_Insert v -> From_Insert $ f v
476 MapWithMove.From_Delete -> From_Delete
347 MapWithMove.From_Delete -> From_Delete
477− MapWithMove.From_Move fromKey Proxy -> From_Move $ Const2 fromKey
348+ MapWithMove.From_Move fromKey -> From_Move $ Const2 fromKey
478 , _nodeInfo_to = ComposeMaybe $ Const2 <$> MapWithMove._nodeInfo_to ni
349 , _nodeInfo_to = ComposeMaybe $ Const2 <$> MapWithMove._nodeInfo_to ni
481-- | Apply the insertions, deletions, and moves to a given 'DMap'.
352-- | Apply the insertions, deletions, and moves to a given 'DMap'.
482−instance GCompare k => PatchHet (PatchDMapWithMove k p) where
483− type PatchSource (PatchDMapWithMove k p) = DMap k (PatchSource1 p)
484− type PatchTarget (PatchDMapWithMove k p) = DMap k (PatchTarget1 p)
485−instance GCompare k => Patch (PatchDMapWithMove k p) where
353+instance GCompare k => Patch (PatchDMapWithMove k v) where
354+ type PatchTarget (PatchDMapWithMove k v) = DMap k v
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?
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?
487 where insertions = DMap.mapMaybeWithKey insertFunc p
356 where insertions = DMap.mapMaybeWithKey insertFunc p
488− insertFunc :: forall a. k a -> NodeInfo k p a -> Maybe (PatchTarget1 p a)
357+ insertFunc :: forall a. k a -> NodeInfo k v a -> Maybe (v a)
489 insertFunc _ ni = case _nodeInfo_from ni of
358 insertFunc _ ni = case _nodeInfo_from ni of
490 From_Insert v -> Just v
359 From_Insert v -> Just v
491 From_Move k -> DMap.lookup k old
360 From_Move k -> DMap.lookup k old
492 From_Delete -> Nothing
361 From_Delete -> Nothing
493 deletions = DMap.mapMaybeWithKey deleteFunc p
362 deletions = DMap.mapMaybeWithKey deleteFunc p
494− deleteFunc :: forall a. k a -> NodeInfo k p a -> Maybe (Constant () a)
363+ deleteFunc :: forall a. k a -> NodeInfo k v a -> Maybe (Constant () a)
495 deleteFunc _ ni = case _nodeInfo_from ni of
364 deleteFunc _ ni = case _nodeInfo_from ni of
496 From_Delete -> Just $ Constant ()
365 From_Delete -> Just $ Constant ()
497 _ -> Nothing
366 _ -> Nothing