@@ -1,4 +1,5 @@
11{-# LANGUAGE CPP #-}
2+{-# LANGUAGE ConstraintKinds #-}
23{-# LANGUAGE FlexibleContexts #-}
34{-# LANGUAGE FlexibleInstances #-}
45{-# LANGUAGE GADTs #-}
@@ -8,8 +9,11 @@
89{-# LANGUAGE PolyKinds #-}
910{-# LANGUAGE Rank2Types #-}
1011{-# LANGUAGE ScopedTypeVariables #-}
12+{-# LANGUAGE StandaloneDeriving #-}
13+{-# LANGUAGE TypeApplications #-}
1114{-# LANGUAGE TypeFamilies #-}
1215{-# LANGUAGE UndecidableInstances #-}
16+{-# LANGUAGE UndecidableSuperClasses #-}
1317
1418-- |Module containing @'PatchDMapWithMove' k v@ and associated functions, which represents a 'Patch' to a @'DMap' k v@ which can insert, update, delete, and
1519-- move values between keys.
@@ -20,19 +24,34 @@ import Data.Patch.MapWithMove (PatchMapWithMove (..))
2024import qualified Data.Patch.MapWithMove as MapWithMove
2125
2226import Data.Constraint.Extras
27+import Data.Constraint.Compose
2328import Data.Dependent.Map (DMap, DSum (..), GCompare (..))
2429import qualified Data.Dependent.Map as DMap
2530import Data.Functor.Constant
2631import Data.Functor.Misc
2732import Data.Functor.Product
28−import Data.GADT.Compare (GEq (..))
29−import Data.GADT.Show (GShow, gshow)
33+import Data.GADT.Compare (GEq (..), GCompare)
34+import Data.GADT.Show (GRead, GShow, gshow)
3035import qualified Data.Map as Map
3136import Data.Maybe
37+import Data.Monoid.DecidablyEmpty
3238import Data.Semigroup (Semigroup (..), (<>))
3339import Data.Some (Some(Some))
3440import Data.Proxy
3541import Data.These
42+import Data.Type.Equality ((:~:) (..))
43+import Data.Kind (Constraint)
44+
45+
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
49+
50+type ConstraintsForZip f (c :: k -> Constraint) (g :: k' -> k' -> k) =
51+ ConstraintsFor f (DupC c g)
52+
53+type HasZip (c :: k -> Constraint) f (g :: k' -> k' -> k) =
54+ (ArgDict (DupC c g) f, ConstraintsForZip f c g)
3655
3756-- | 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
3857-- destinations.
@@ -43,47 +62,119 @@ import Data.These
4362-- * A move should always be represented with both the destination key (as a 'From_Move') and the source key (as a @'ComposeMaybe' ('Just' destination)@)
4463newtype PatchDMapWithMove k v = PatchDMapWithMove (DMap k (NodeInfo k v))
4564
65+deriving instance ( GShow k
66+ , HasZip Show k p
67+ , Has' Show k (PatchTarget1 p)
68+ ) => Show (PatchDMapWithMove k p)
69+deriving instance ( GRead k
70+ , HasZip Read k p
71+ , Has' Read k (PatchTarget1 p)
72+ ) => Read (PatchDMapWithMove k p)
73+deriving instance ( GEq k
74+ , HasZip Eq k p
75+ , Has' Eq k (PatchTarget1 p)
76+ ) => Eq (PatchDMapWithMove k p)
77+deriving instance ( GCompare k
78+ , HasZip Ord k p
79+ , Has' Ord k (PatchTarget1 p)
80+ ) => Ord (PatchDMapWithMove k p)
81+
4682-- |Structure which represents what changes apply to a particular key. @_nodeInfo_from@ specifies what happens to this key, and in particular what other key
4783-- the current key is moving from, while @_nodeInfo_to@ specifies what key the current key is moving to if involved in a move.
48−data NodeInfo k v a = NodeInfo
49− { _nodeInfo_from :: !(From k v a)
84+data NodeInfo k p a = NodeInfo
85+ { _nodeInfo_from :: !(From k p a)
5086 -- ^Change applying to the current key, be it an insert, move, or delete.
5187 , _nodeInfo_to :: !(To k a)
5288 -- ^Where this key is moving to, if involved in a move. Should only be @ComposeMaybe (Just k)@ when there is a corresponding 'From_Move'.
5389 }
54− deriving (Show)
90+
91+deriving instance ( Show (k a)
92+ , Show (p a a)
93+ , Show (PatchTarget1 p a)
94+ ) => Show (NodeInfo k p a)
95+deriving instance ( Read (k a)
96+ , Read (p a a)
97+ , Read (PatchTarget1 p a)
98+ ) => Read (NodeInfo k p a)
99+deriving instance ( Eq (k a)
100+ , Eq (p a a)
101+ , Eq (PatchTarget1 p a)
102+ ) => Eq (NodeInfo k p a)
103+deriving instance ( Ord (k a)
104+ , Ord (p a a)
105+ , Ord (PatchTarget1 p a)
106+ ) => Ord (NodeInfo k p a)
55107
56108-- |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
57109-- key (@From_Delete@), or moving a key (@From_Move@).
58−data From (k :: a -> *) (v :: a -> *) :: a -> * where
59− -- |Insert a new or update an existing key with the given value @v a@
60− From_Insert :: v a -> From k v a
110+data From (k :: a -> *) (p :: a -> a -> *) :: a -> * where
111+ -- |Insert a new or update an existing key with the given value @PatchTarget1 p a@
112+ From_Insert :: PatchTarget1 p a -> From k p a
61113 -- |Delete the existing key
62− From_Delete :: From k v a
114+ From_Delete :: From k p a
63115 -- |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@,
64116 -- usually but not necessarily with @From_Delete@.
65− From_Move :: !(k a) -> From k v a
66− deriving (Show, Read, Eq, Ord)
117+ From_Move :: !(k a0) -> p a0 a1 -> From k p a1
118+
119+deriving instance ( Show (k a)
120+ , Show (p a a)
121+ , Show (PatchTarget1 p a)
122+ ) => Show (From k p a)
123+deriving instance ( Read (k a)
124+ , Read (p a a)
125+ , Read (PatchTarget1 p a)
126+ ) => Read (From k p a)
127+
128+instance ( GEq k
129+ , HasZip Eq k p
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
135+ Nothing -> False
136+ Just Refl -> has @(DupC Eq p) k0 $ p0 == p1
137+
138+instance ( GCompare k
139+ , HasZip Ord k p
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
145+ DMap.GGT -> GT
146+ DMap.GEQ -> has @(DupC Ord p) k0 $ p0 `compare` p1
147+ DMap.GLT -> LT
67148
68149-- |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
69150-- operation.
70151type To = ComposeMaybe
71152
72153-- |Test whether a 'PatchDMapWithMove' satisfies its invariants.
73−validPatchDMapWithMove :: forall k v. (GCompare k, GShow k) => DMap k (NodeInfo k v) -> Bool
154+validPatchDMapWithMove
155+ :: forall k v
156+ . (GCompare k, GShow k)
157+ => DMap k (NodeInfo k v)
158+ -> Bool
74159validPatchDMapWithMove = not . null . validationErrorsForPatchDMapWithMove
75160
76161-- |Enumerate what reasons a 'PatchDMapWithMove' doesn't satisfy its invariants, returning @[]@ if it's valid.
77−validationErrorsForPatchDMapWithMove :: forall k v. (GCompare k, GShow k) => DMap k (NodeInfo k v) -> [String]
162+validationErrorsForPatchDMapWithMove
163+ :: forall k v
164+ . (GCompare k, GShow k)
165+ => DMap k (NodeInfo k v)
166+ -> [String]
78167validationErrorsForPatchDMapWithMove m =
79168 noSelfMoves <> movesBalanced
80169 where
81170 noSelfMoves = mapMaybe selfMove . DMap.toAscList $ m
82− selfMove (dst :=> NodeInfo (From_Move src) _) | Just _ <- dst `geq` src = Just $ "self move of key " <> gshow src <> " at destination side"
83− selfMove (src :=> NodeInfo _ (ComposeMaybe (Just dst))) | Just _ <- src `geq` dst = Just $ "self move of key " <> gshow dst <> " at source side"
171+ selfMove (dst :=> NodeInfo (From_Move src _) _)
172+ | Just _ <- dst `geq` src = Just $ "self move of key " <> gshow src <> " at destination side"
173+ selfMove (src :=> NodeInfo _ (ComposeMaybe (Just dst)))
174+ | Just _ <- src `geq` dst = Just $ "self move of key " <> gshow dst <> " at source side"
84175 selfMove _ = Nothing
85176 movesBalanced = mapMaybe unbalancedMove . DMap.toAscList $ m
86− unbalancedMove (dst :=> NodeInfo (From_Move src) _) =
177+ unbalancedMove (dst :=> NodeInfo (From_Move src _) _) =
87178 case DMap.lookup src m of
88179 Nothing -> Just $ "unbalanced move at destination key " <> gshow dst <> " supposedly from " <> gshow src <> " but source key is not in the patch"
89180 Just (NodeInfo _ (ComposeMaybe (Just dst'))) ->
@@ -95,7 +186,7 @@ validationErrorsForPatchDMapWithMove m =
95186 unbalancedMove (src :=> NodeInfo _ (ComposeMaybe (Just dst))) =
96187 case DMap.lookup dst m of
97188 Nothing -> Just $ " unbalanced move at source key " <> gshow src <> " supposedly going to " <> gshow dst <> " but destination key is not in the patch"
98− Just (NodeInfo (From_Move src') _) ->
189+ Just (NodeInfo (From_Move src' _) _) ->
99190 if isNothing (src' `geq` src)
100191 then Just $ "unbalanced move at source key " <> gshow src <> " to " <> gshow dst <> " is coming from " <> gshow src' <> " instead"
101192 else Nothing
@@ -104,10 +195,6 @@ validationErrorsForPatchDMapWithMove m =
104195 Just $ "unbalanced move at source key " <> gshow src <> " supposedly going to " <> gshow dst <> " but destination key is not moving"
105196 unbalancedMove _ = Nothing
106197
107−-- |Test whether two @'PatchDMapWithMove' k v@ contain the same patch operations.
108−instance (GEq k, Has' Eq k (NodeInfo k v)) => Eq (PatchDMapWithMove k v) where
109− PatchDMapWithMove a == PatchDMapWithMove b = a == b
110−
111198-- |Higher kinded 2-tuple, identical to @Data.Functor.Product@ from base ≥ 4.9
112199data Pair1 f g a = Pair1 (f a) (g a)
113200
@@ -117,20 +204,25 @@ data Fixup k v a
117204 | Fixup_Update (These (From k v a) (To k a))
118205
119206-- |Compose patches having the same effect as applying the patches in turn: @'applyAlways' (p <> q) == 'applyAlways' p . 'applyAlways' q@
120−instance GCompare k => Semigroup (PatchDMapWithMove k v) where
207+instance ( GCompare k
208+ -- , DecidablyEmpty p
209+ , PatchHet2 p
210+ ) => Semigroup (PatchDMapWithMove k p) where
121211 PatchDMapWithMove ma <> PatchDMapWithMove mb = PatchDMapWithMove m
122212 where
123213 connections = DMap.toList $ DMap.intersectionWithKey (\_ a b -> Pair1 (_nodeInfo_to a) (_nodeInfo_from b)) ma mb
124214 h :: DSum k (Pair1 (ComposeMaybe k) (From k v)) -> [DSum k (Fixup k v)]
125215 h (_ :=> Pair1 (ComposeMaybe mToAfter) editBefore) = case (mToAfter, editBefore) of
126− (Just toAfter, From_Move fromBefore)
127− | isJust $ fromBefore `geq` toAfter
216+ (Just toAfter, From_Move fromBefore p)
217+ | case fromBefore `geq` toAfter of
218+ Nothing -> False
219+ Just Refl -> isNull p
128220 -> [toAfter :=> Fixup_Delete]
129221 | otherwise
130222 -> [ toAfter :=> Fixup_Update (This editBefore)
131223 , fromBefore :=> Fixup_Update (That (ComposeMaybe mToAfter))
132224 ]
133− (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
225+ (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
134226 (Just toAfter, _) -> [toAfter :=> Fixup_Update (This editBefore)]
135227 (Nothing, _) -> []
136228 mergeFixups _ Fixup_Delete Fixup_Delete = Fixup_Delete
@@ -148,7 +240,13 @@ instance GCompare k => Semigroup (PatchDMapWithMove k v) where
148240 applyFixup _ ni = \case
149241 Fixup_Delete -> Nothing
150242 Fixup_Update u -> Just $ NodeInfo
151− { _nodeInfo_from = fromMaybe (_nodeInfo_from ni) $ getHere u
243+ { _nodeInfo_from = case _nodeInfo_from ni of
244+ f@(From_Move _ p') -> case getHere u of -- The `from` fixup comes from the "old" patch
245+ Nothing -> f -- If there's no `from` fixup, just use the "new" `from`
246+ Just (From_Insert v) -> From_Insert $ applyAlways p' v
247+ Just From_Delete -> From_Delete
248+ Just (From_Move oldKey p) -> From_Move oldKey $ p' <> p
249+ _ -> error "DPatchMapWithMove: fixup for non-move From"
152250 , _nodeInfo_to = fromMaybe (_nodeInfo_to ni) $ getThere u
153251 }
154252 m = DMap.differenceWithKey applyFixup (DMap.unionWithKey combineNodeInfos ma mb) fixups
@@ -169,7 +267,7 @@ instance GCompare k => Monoid (PatchDMapWithMove k v) where
169267 mappend = (<>)
170268
171269{-
172−mappendPatchDMapWithMoveSlow :: forall k v. (ShowTag k v, GCompare k) => PatchDMapWithMove k v -> PatchDMapWithMove k v -> PatchDMapWithMove k v
270+mappendPatchDMapWithMoveSlow :: forall k v. (ShowTag k v, GCompare k) => PatchDMapWithMove k v -> PatchDMapWithMove k v -> PatchDMapWithMove k v
173271PatchDMapWithMove dstAfter srcAfter `mappendPatchDMapWithMoveSlow` PatchDMapWithMove dstBefore srcBefore = PatchDMapWithMove dst src
174272 where
175273 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
@@ -190,8 +288,8 @@ PatchDMapWithMove dstAfter srcAfter `mappendPatchDMapWithMoveSlow` PatchDMapWith
190288 src = DMap.mapMaybeWithKey g $ DMap.union srcAfter srcBefore
191289-}
192290
193−-- |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'.
194−insertDMapKey :: k a -> v a -> PatchDMapWithMove k v
291+-- |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'.
292+insertDMapKey :: k a -> PatchTarget1 p a -> PatchDMapWithMove k p
195293insertDMapKey k v =
196294 PatchDMapWithMove . DMap.singleton k $ NodeInfo (From_Insert v) (ComposeMaybe Nothing)
197295
@@ -272,41 +370,67 @@ patchDMapWithMove dm =
272370 errs -> Left errs
273371
274372-- |Map a natural transform @v -> v'@ over the given patch, transforming @'PatchDMapWithMove' k v@ into @'PatchDMapWithMove' k v'@.
275−mapPatchDMapWithMove :: forall k v v'. (forall a. v a -> v' a) -> PatchDMapWithMove k v -> PatchDMapWithMove k v'
373+mapPatchDMapWithMove
374+ :: forall k p p'
375+ . (forall a. PatchTarget1 p a -> PatchTarget1 p' a)
376+ -> PatchDMapWithMove k p
377+ -> PatchDMapWithMove k p'
276378mapPatchDMapWithMove f (PatchDMapWithMove p) = PatchDMapWithMove $
277379 DMap.map (\ni -> ni { _nodeInfo_from = g $ _nodeInfo_from ni }) p
278− where g :: forall a. From k v a -> From k v' a
380+ where g :: forall a. From k PatchTarget1 p a -> From k PatchTarget1 p' a
279381 g = \case
280382 From_Insert v -> From_Insert $ f v
281383 From_Delete -> From_Delete
282384 From_Move k -> From_Move k
283385
284−-- |Traverse an effectful function @forall a. v a -> m (v ' a)@ over the given patch, transforming @'PatchDMapWithMove' k v@ into @m ('PatchDMapWithMove' k v')@.
285−traversePatchDMapWithMove :: forall m k v v'. Applicative m => (forall a. v a -> m (v' a)) -> PatchDMapWithMove k v -> m (PatchDMapWithMove k v')
386+-- |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')@.
387+traversePatchDMapWithMove
388+ :: forall m k p p'
389+ . Applicative m
390+ => (forall a. PatchTarget1 p a -> m (PatchTarget1 p' a))
391+ -> PatchDMapWithMove k p
392+ -> m (PatchDMapWithMove k p')
286393traversePatchDMapWithMove f = traversePatchDMapWithMoveWithKey $ const f
287394
288−-- |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')@.
289−traversePatchDMapWithMoveWithKey :: forall m k v v'. Applicative m => (forall a. k a -> v a -> m (v' a)) -> PatchDMapWithMove k v -> m (PatchDMapWithMove k v')
290−traversePatchDMapWithMoveWithKey f (PatchDMapWithMove p) = PatchDMapWithMove <$> DMap.traverseWithKey (nodeInfoMapFromM . g) p
291− where g :: forall a. k a -> From k v a -> m (From k v' a)
395+-- |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')@.
396+traversePatchDMapWithMoveWithKey
397+ :: forall m k p p'
398+ . Applicative m
399+ => (forall a. k a -> PatchTarget1 p a -> m (PatchTarget1 p' a))
400+ -> PatchDMapWithMove k p
401+ -> m (PatchDMapWithMove k p')
402+traversePatchDMapWithMoveWithKey f (PatchDMapWithMove p) =
403+ PatchDMapWithMove <$> DMap.traverseWithKey (nodeInfoMapFromM . g) p
404+ where g :: forall a. k a -> From k PatchTarget1 p a -> m (From k PatchTarget1 p' a)
292405 g k = \case
293406 From_Insert v -> From_Insert <$> f k v
294407 From_Delete -> pure From_Delete
295408 From_Move fromKey -> pure $ From_Move fromKey
296409
297−-- |Map a function which transforms @'From' k v a@ into a @'From' k v' a@ over a @'NodeInfo' k v a@.
298−nodeInfoMapFrom :: (From k v a -> From k v' a) -> NodeInfo k v a -> NodeInfo k v' a
410+-- |Map a function which transforms @'From' k PatchTarget1 p a@ into a @'From' k PatchTarget1 p' a@ over a @'NodeInfo' k PatchTarget1 p a@.
411+nodeInfoMapFrom
412+ :: (From k p a -> From k p' a)
413+ -> NodeInfo k p a
414+ -> NodeInfo k p' a
299415nodeInfoMapFrom f ni = ni { _nodeInfo_from = f $ _nodeInfo_from ni }
300416
301−-- |Map an effectful function which transforms @'From' k v a@ into a @f ('From' k v' a)@ over a @'NodeInfo' k v a@.
302−nodeInfoMapFromM :: Functor f => (From k v a -> f (From k v' a)) -> NodeInfo k v a -> f (NodeInfo k v' a)
417+-- |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@.
418+nodeInfoMapFromM
419+ :: Functor f
420+ => (From k p a -> f (From k p' a))
421+ -> NodeInfo k p a
422+ -> f (NodeInfo k p' a)
303423nodeInfoMapFromM f ni = fmap (\result -> ni { _nodeInfo_from = result }) $ f $ _nodeInfo_from ni
304424
305−-- |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
425+-- |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
306426-- values.
307−weakenPatchDMapWithMoveWith :: forall k v v'. (forall a. v a -> v') -> PatchDMapWithMove k v -> PatchMapWithMove (Some k) (Proxy v')
427+weakenPatchDMapWithMoveWith
428+ :: forall k p v'
429+ . (forall a. PatchTarget1 p a -> v')
430+ -> PatchDMapWithMove k p
431+ -> PatchMapWithMove (Some k) (Proxy v')
308432weakenPatchDMapWithMoveWith f (PatchDMapWithMove p) = PatchMapWithMove $ weakenDMapWith g p
309− where g :: forall a. NodeInfo k v a -> MapWithMove.NodeInfo (Some k) (Proxy v')
433+ where g :: forall a. NodeInfo k PatchTarget1 p a -> MapWithMove.NodeInfo (Some k) (Proxy v')
310434 g ni = MapWithMove.NodeInfo
311435 { MapWithMove._nodeInfo_from = case _nodeInfo_from ni of
312436 From_Insert v -> MapWithMove.From_Insert $ f v
@@ -317,9 +441,12 @@ weakenPatchDMapWithMoveWith f (PatchDMapWithMove p) = PatchMapWithMove $ weakenD
317441
318442-- |"Weaken" a @'PatchDMapWithMove' (Const2 k a) v@ to a @'PatchMapWithMove' k v'@. Weaken is in scare quotes because the 'Const2' has already disabled any
319443-- dependency in the typing and all points are already @a@, hence the function to map each value to @v'@ is not higher rank.
320−patchDMapWithMoveToPatchMapWithMoveWith :: forall k v v' a. (v a -> v') -> PatchDMapWithMove (Const2 k a) v -> PatchMapWithMove k (Proxy v')
444+patchDMapWithMoveToPatchMapWithMoveWith
445+ :: forall k p v' a. (PatchTarget1 p a -> v')
446+ -> PatchDMapWithMove (Const2 k a) p
447+ -> PatchMapWithMove k (Proxy v')
321448patchDMapWithMoveToPatchMapWithMoveWith f (PatchDMapWithMove p) = PatchMapWithMove $ dmapToMapWith g p
322− where g :: NodeInfo (Const2 k a) v a -> MapWithMove.NodeInfo k (Proxy v')
449+ where g :: NodeInfo (Const2 k a) PatchTarget1 p a -> MapWithMove.NodeInfo k (Proxy v')
323450 g ni = MapWithMove.NodeInfo
324451 { MapWithMove._nodeInfo_from = case _nodeInfo_from ni of
325452 From_Insert v -> MapWithMove.From_Insert $ f v
@@ -329,9 +456,13 @@ patchDMapWithMoveToPatchMapWithMoveWith f (PatchDMapWithMove p) = PatchMapWithMo
329456 }
330457
331458-- |"Strengthen" a @'PatchMapWithMove' k v@ into a @'PatchDMapWithMove ('Const2' k a)@; that is, turn a non-dependently-typed patch into a dependently typed
332−-- one but which always has a constant key type represented by 'Const2'. Apply the given function to each @v@ to produce a @v' a@.
459+-- 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@.
333460-- Completemented by 'patchDMapWithMoveToPatchMapWithMoveWith'
334−const2PatchDMapWithMoveWith :: forall k v v' a. (v -> v' a) -> PatchMapWithMove k (Proxy v) -> PatchDMapWithMove (Const2 k a) v'
461+const2PatchDMapWithMoveWith
462+ :: forall k v p' a
463+ . (v -> PatchTarget1 p' a)
464+ -> PatchMapWithMove k (Proxy v)
465+ -> PatchDMapWithMove (Const2 k a) p'
335466const2PatchDMapWithMoveWith f (PatchMapWithMove p) = PatchDMapWithMove $ DMap.fromDistinctAscList $ g <$> Map.toAscList p
336467 where g :: (k, MapWithMove.NodeInfo k (Proxy v)) -> DSum (Const2 k a) (NodeInfo (Const2 k a) v')
337468 g (k, ni) = Const2 k :=> NodeInfo
@@ -343,19 +474,19 @@ const2PatchDMapWithMoveWith f (PatchMapWithMove p) = PatchDMapWithMove $ DMap.fr
343474 }
344475
345476-- | Apply the insertions, deletions, and moves to a given 'DMap'.
346−instance GCompare k => PatchHet (PatchDMapWithMove k v) where
347− type PatchSource (PatchDMapWithMove k v) = DMap k v
348− type PatchTarget (PatchDMapWithMove k v) = DMap k v
349−instance GCompare k => Patch (PatchDMapWithMove k v) where
477+instance GCompare k => PatchHet (PatchDMapWithMove k p) where
478+ type PatchSource (PatchDMapWithMove k p) = DMap k (PatchSource1 p)
479+ type PatchTarget (PatchDMapWithMove k p) = DMap k (PatchTarget1 p)
480+instance GCompare k => Patch (PatchDMapWithMove k p) where
350481 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?
351482 where insertions = DMap.mapMaybeWithKey insertFunc p
352− insertFunc :: forall a. k a -> NodeInfo k v a -> Maybe (v a)
483+ insertFunc :: forall a. k a -> NodeInfo k p a -> Maybe (PatchTarget1 p a)
353484 insertFunc _ ni = case _nodeInfo_from ni of
354485 From_Insert v -> Just v
355486 From_Move k -> DMap.lookup k old
356487 From_Delete -> Nothing
357488 deletions = DMap.mapMaybeWithKey deleteFunc p
358− deleteFunc :: forall a. k a -> NodeInfo k v a -> Maybe (Constant () a)
489+ deleteFunc :: forall a. k a -> NodeInfo k p a -> Maybe (Constant () a)
359490 deleteFunc _ ni = case _nodeInfo_from ni of
360491 From_Delete -> Just $ Constant ()
361492 _ -> Nothing