git.iko.soy/patch
on develop help sign in
Get everything type checking again
3f037afJohn Ericson
src/Data/Functor/Misc.hs+28−5
compare with develop
unifiedsplit
@@ -1,6 +1,6 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveDataTypeable #-}
3−{-# LANGUAGE DeriveFunctor #-}
3+{-# LANGUAGE DeriveTraversable #-}
4{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleContexts #-}
5{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE FlexibleInstances #-}
6{-# LANGUAGE GADTs #-}
6{-# LANGUAGE GADTs #-}
@@ -17,6 +17,8 @@
17module Data.Functor.Misc
17module Data.Functor.Misc
18 ( -- * Const2
18 ( -- * Const2
19 Const2 (..)
19 Const2 (..)
20+ , Proxy3 (..)
21+ , First2 (..)
20 , unConst2
22 , unConst2
21 , dmapToMap
23 , dmapToMap
22 , dmapToIntMap
24 , dmapToIntMap
@@ -37,6 +39,7 @@ module Data.Functor.Misc
37 , ComposeMaybe (..)
39 , ComposeMaybe (..)
38 ) where
40 ) where
39
41
42+import qualified Control.Category as Cat
40import Control.Applicative ((<$>))
43import Control.Applicative ((<$>))
41import Data.Dependent.Map (DMap)
44import Data.Dependent.Map (DMap)
42import qualified Data.Dependent.Map as DMap
45import qualified Data.Dependent.Map as DMap
@@ -48,6 +51,7 @@ import Data.IntMap (IntMap)
48import qualified Data.IntMap as IntMap
51import qualified Data.IntMap as IntMap
49import Data.Map (Map)
52import Data.Map (Map)
50import qualified Data.Map as Map
53import qualified Data.Map as Map
54+import qualified Data.Semigroupoid as Cat
51import Data.Some (Some(Some))
55import Data.Some (Some(Some))
52import Data.These
56import Data.These
53import Data.Type.Equality ((:~:)(Refl))
57import Data.Type.Equality ((:~:)(Refl))
@@ -63,15 +67,15 @@ data Const2 :: * -> x -> x -> * where
63 Const2 :: k -> Const2 k v v
67 Const2 :: k -> Const2 k v v
64 deriving (Typeable)
68 deriving (Typeable)
65
69
66−-- | Extract the value from a Const2
67−unConst2 :: Const2 k v v' -> k
68−unConst2 (Const2 k) = k
69−
70deriving instance Eq k => Eq (Const2 k v v')
70deriving instance Eq k => Eq (Const2 k v v')
71deriving instance Ord k => Ord (Const2 k v v')
71deriving instance Ord k => Ord (Const2 k v v')
72deriving instance Show k => Show (Const2 k v v')
72deriving instance Show k => Show (Const2 k v v')
73deriving instance Read k => Read (Const2 k v v)
73deriving instance Read k => Read (Const2 k v v)
74
74
75+-- | Extract the value from a Const2
76+unConst2 :: Const2 k v v' -> k
77+unConst2 (Const2 k) = k
78+
75instance Show k => GShow (Const2 k v) where
79instance Show k => GShow (Const2 k v) where
76 gshowsPrec n x@(Const2 _) = showsPrec n x
80 gshowsPrec n x@(Const2 _) = showsPrec n x
77
81
@@ -87,6 +91,25 @@ instance Ord k => GCompare (Const2 k v) where
87 EQ -> GEQ
91 EQ -> GEQ
88 GT -> GGT
92 GT -> GGT
89
93
94+data Proxy3 :: x -> y -> z -> * where
95+ Proxy3 :: Proxy3 vx vy vz
96+ deriving ( Show, Read, Eq, Ord
97+ , Functor, Foldable, Traversable
98+ , Typeable
99+ )
100+
101+instance Cat.Category (Proxy3 x) where
102+ id = Proxy3
103+ ~Proxy3 . ~Proxy3 = Proxy3
104+
105+newtype First2 (t :: k -> *) (a :: k) (b :: k) = First2 (t b)
106+ deriving ( Show, Read, Eq, Ord
107+ , Functor, Foldable, Traversable
108+ )
109+
110+instance Cat.Semigroupoid (First2 x) where
111+ First2 x `o` ~(First2 _) = First2 x
112+
90-- | Convert a 'DMap' to a regular 'Map'
113-- | Convert a 'DMap' to a regular 'Map'
91dmapToMap :: DMap (Const2 k v) Identity -> Map k v
114dmapToMap :: DMap (Const2 k v) Identity -> Map k v
92dmapToMap = Map.fromDistinctAscList . map (\(Const2 k :=> Identity v) -> (k, v)) . DMap.toAscList
115dmapToMap = Map.fromDistinctAscList . map (\(Const2 k :=> Identity v) -> (k, v)) . DMap.toAscList
src/Data/Patch/Class.hs+20−21
@@ -1,5 +1,7 @@
1{-# LANGUAGE DefaultSignatures #-}
1{-# LANGUAGE DefaultSignatures #-}
2{-# LANGUAGE DeriveTraversable #-}
2{-# LANGUAGE DeriveTraversable #-}
3+{-# LANGUAGE DerivingStrategies #-}
4+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE MultiParamTypeClasses #-}
6{-# LANGUAGE MultiParamTypeClasses #-}
5{-# LANGUAGE PolyKinds #-}
7{-# LANGUAGE PolyKinds #-}
@@ -8,7 +10,9 @@
8-- | The interface for types which represent changes made to other types
10-- | The interface for types which represent changes made to other types
9module Data.Patch.Class where
11module Data.Patch.Class where
10
12
13+import qualified Data.Semigroupoid as Cat
11import Data.Functor.Identity
14import Data.Functor.Identity
15+import Data.Functor.Misc
12import Data.Maybe
16import Data.Maybe
13import Data.Semigroup (Semigroup(..))
17import Data.Semigroup (Semigroup(..))
14import Data.Proxy
18import Data.Proxy
@@ -128,6 +132,7 @@ applyAlwaysHet2 p t = case applyHet2 p t of
128
132
129-- | Connect the classes without quanitified constraints
133-- | Connect the classes without quanitified constraints
130newtype ProjectLocal p from to = ProjectLocal { unProjectLocal :: p from to }
134newtype ProjectLocal p from to = ProjectLocal { unProjectLocal :: p from to }
135+ deriving newtype Cat.Semigroupoid
131
136
132instance PatchHet2 p => PatchHet (ProjectLocal p from to) where
137instance PatchHet2 p => PatchHet (ProjectLocal p from to) where
133 type PatchSource (ProjectLocal p from to) = PatchSource1 p from
138 type PatchSource (ProjectLocal p from to) = PatchSource1 p from
@@ -145,24 +150,18 @@ instance ( PatchHet2Base p
145 , PatchSource1 p ~ PatchTarget1 p
150 , PatchSource1 p ~ PatchTarget1 p
146 ) => Patch2 p
151 ) => Patch2 p
147
152
148−newtype Replace2 (t :: k -> *) (a :: k) (b :: k) = Replace2 (t b)
149− deriving ( Show, Read, Eq, Ord
150− , Functor, Foldable, Traversable
151− )
152−
153−data Proxy2 t a b = Proxy2
154− deriving ( Show, Read, Eq, Ord
155− , Functor, Foldable, Traversable
156− )
157−
158−-- | 'Replace2' can be used as a 'Patch' that always fully replaces the value
153+-- | 'First2' can be used as a 'Patch' that always fully replaces the value
159−instance PatchHet (Replace2 (t :: k -> *) (from :: k) (to :: k)) where
154+instance PatchHet (First2 (t :: k -> *) (from :: k) (to :: k)) where
160− type PatchSource (Replace2 t from to) = t from
155+ type PatchSource (First2 t from to) = t from
161− type PatchTarget (Replace2 t from to) = t to
156+ type PatchTarget (First2 t from to) = t to
162− applyHet (Replace2 val) _ = Right val
157+ applyHet (First2 val) _ = Right val
163−
158+
164−-- | 'Proxy2' can be used as a 'Patch' that always does nothing
159+-- | 'Proxy3' can be used as a 'Patch' that always does nothing
165−instance PatchHet (Proxy2 (t :: k -> *) (a :: k) (a :: k)) where
160+instance PatchHet (Proxy3 (t :: k -> *) (a :: k) (a :: k)) where
166− type PatchSource (Proxy2 t a a) = t a
161+ type PatchSource (Proxy3 t a a) = t a
167− type PatchTarget (Proxy2 t a a) = t a
162+ type PatchTarget (Proxy3 t a a) = t a
168− applyHet ~Proxy2 _ = Left Refl
163+ applyHet ~Proxy3 _ = Left Refl
164+
165+instance PatchHet2Base (Proxy3 (t :: k -> *) :: k -> k -> *) where
166+ type PatchSource1 (Proxy3 t) = t
167+ type PatchTarget1 (Proxy3 t) = t
src/Data/Patch/DMapWithMove.hs+197−218
@@ -21,40 +21,36 @@
21module Data.Patch.DMapWithMove where
21module Data.Patch.DMapWithMove where
22
22
23import qualified Control.Category as Cat
23import qualified Control.Category as Cat
24+--import qualified Control.Category.DecidablyEmpty as Cat
24−import Data.Constraint.Extras
25+import Data.Constraint.Extras (Has')
25−import Data.Constraint.Compose
26−import Data.Dependent.Map (DMap, DSum (..), GCompare (..))
26+import Data.Dependent.Map (DMap)
27+import Data.Dependent.Sum (DSum (..))
27import qualified Data.Dependent.Map as DMap
28import qualified Data.Dependent.Map as DMap
28−import Data.Functor.Constant
29+import Data.Functor.Constant (Constant (..))
29import Data.Functor.Misc
30import Data.Functor.Misc
31+ ( Const2 (..), Proxy3 (..)
32+ , weakenDMapWith
33+ , dmapToMapWith
34+ )
30−import Data.Functor.Product
35+import Data.Functor.Product (Product (..))
31−import Data.GADT.Compare (GEq (..), GCompare)
36+import Data.GADT.Compare (GEq (..), GCompare (..))
32import Data.GADT.Show (GRead, GShow, gshow)
37import Data.GADT.Show (GRead, GShow, gshow)
33import qualified Data.Map as Map
38import qualified Data.Map as Map
34import Data.Maybe
39import Data.Maybe
35−import Data.Monoid.DecidablyEmpty
36import Data.Semigroup (Semigroup (..), (<>))
40import Data.Semigroup (Semigroup (..), (<>))
37import Data.Semigroupoid as Cat
41import Data.Semigroupoid as Cat
38import Data.Some (Some(Some))
42import Data.Some (Some(Some))
39−import Data.Proxy
43+import Data.Proxy (Proxy (..))
40−import Data.These
41−import Data.Type.Equality ((:~:) (..))
42−import Data.Kind (Constraint)
44+import Data.These (These (..))
43
45
44import Data.Patch.Class
46import Data.Patch.Class
47+ ( Patch (..), PatchHet (..)
48+ , PatchHet2 (..), PatchSource1, PatchTarget1
49+ , applyAlwaysHet2
50+ )
45import Data.Patch.MapWithMove (PatchMapWithMove (..))
51import Data.Patch.MapWithMove (PatchMapWithMove (..))
46import qualified Data.Patch.MapWithMove as MapWithMove
52import qualified Data.Patch.MapWithMove as MapWithMove
47
53
48−-- | Composition for constraints.
49−class p (f a a) => DupC (p :: k2 -> Constraint) (f :: k1 -> k1 -> k2) (a :: k1)
50−instance p (f a a) => DupC p f a
51−
52−type ConstraintsForZip f (c :: k -> Constraint) (g :: k' -> k' -> k) =
53− ConstraintsFor f (DupC c g)
54−
55−type HasZip (c :: k -> Constraint) f (g :: k' -> k' -> k) =
56− (ArgDict (DupC c g) f, ConstraintsForZip f c g)
57−
58-- | Like 'PatchMapWithMove', but for 'DMap'. Each key carries a 'NodeInfo'
54-- | Like 'PatchMapWithMove', but for 'DMap'. Each key carries a 'NodeInfo'
59-- which describes how it will be changed by the patch and connects move sources
55-- which describes how it will be changed by the patch and connects move sources
60-- and destinations.
56-- and destinations.
@@ -68,22 +64,22 @@ type HasZip (c :: k -> Constraint) f (g :: k' -> k' -> k) =
68-- destination)@)
64-- destination)@)
69newtype PatchDMapWithMove k v = PatchDMapWithMove (DMap k (NodeInfo k v))
65newtype PatchDMapWithMove k v = PatchDMapWithMove (DMap k (NodeInfo k v))
70
66
71−deriving instance ( GShow k
67+--deriving instance ( GShow k
72− , HasZip Show k p
68+-- , HasZip Show k p
73− , Has' Show k (PatchTarget1 p)
69+-- , Has' Show k (PatchTarget1 p)
74− ) => Show (PatchDMapWithMove k p)
70+-- ) => Show (PatchDMapWithMove k p)
75−deriving instance ( GRead k
71+--deriving instance ( GRead k
76− , HasZip Read k p
72+-- , HasZip Read k p
77− , Has' Read k (PatchTarget1 p)
73+-- , Has' Read k (PatchTarget1 p)
78− ) => Read (PatchDMapWithMove k p)
74+-- ) => Read (PatchDMapWithMove k p)
79−deriving instance ( GEq k
75+--deriving instance ( GEq k
80− , HasZip Eq k p
76+-- , HasZip Eq k p
81− , Has' Eq k (PatchTarget1 p)
77+-- , Has' Eq k (PatchTarget1 p)
82− ) => Eq (PatchDMapWithMove k p)
78+-- ) => Eq (PatchDMapWithMove k p)
83−deriving instance ( GCompare k
79+--deriving instance ( GCompare k
84− , HasZip Ord k p
80+-- , HasZip Ord k p
85− , Has' Ord k (PatchTarget1 p)
81+-- , Has' Ord k (PatchTarget1 p)
86− ) => Ord (PatchDMapWithMove k p)
82+-- ) => Ord (PatchDMapWithMove k p)
87
83
88-- | Structure which represents what changes apply to a particular key.
84-- | Structure which represents what changes apply to a particular key.
89-- @_nodeInfo_from@ specifies what happens to this key, and in particular what
85-- @_nodeInfo_from@ specifies what happens to this key, and in particular what
@@ -97,91 +93,22 @@ data NodeInfo k p a = NodeInfo
97 -- @ComposeMaybe (Just k)@ when there is a corresponding 'From_Move'.
93 -- @ComposeMaybe (Just k)@ when there is a corresponding 'From_Move'.
98 }
94 }
99
95
100−deriving instance ( Show (k a)
96+--deriving instance ( Show (k a)
101− , Show (p a a)
97+-- , Show (p a a)
102− , Show (PatchTarget1 p a)
98+-- , Show (PatchTarget1 p a)
103− ) => Show (NodeInfo k p a)
99+-- ) => Show (NodeInfo k p a)
104−deriving instance ( Read (k a)
100+--deriving instance ( Read (k a)
105− , Read (p a a)
101+-- , Read (p a a)
106− , Read (PatchTarget1 p a)
102+-- , Read (PatchTarget1 p a)
107− ) => Read (NodeInfo k p a)
103+-- ) => Read (NodeInfo k p a)
108−deriving instance ( Eq (k a)
104+--deriving instance ( Eq (k a)
109− , Eq (p a a)
105+-- , Eq (p a a)
110− , Eq (PatchTarget1 p a)
106+-- , Eq (PatchTarget1 p a)
111− ) => Eq (NodeInfo k p a)
107+-- ) => Eq (NodeInfo k p a)
112−deriving instance ( Ord (k a)
108+--deriving instance ( Ord (k a)
113− , Ord (p a a)
109+-- , Ord (p a a)
114− , Ord (PatchTarget1 p a)
110+-- , Ord (PatchTarget1 p a)
115− ) => Ord (NodeInfo k p a)
111+-- ) => Ord (NodeInfo k p a)
116−
117−-- | Structure describing a particular change to a key, be it inserting a new
118−-- key (@By_Insert@), updating an existing key (@By_Insert@ again), deleting
119−-- a key (@By_Delete@), or moving a key (@By_Move@).
120−--
121−-- This type isn't used directly as the from field patch, but is instead wrapped
122−-- in an existential. However, it is nice to be able to reason about this in
123−-- isolation as it is itself a @Semigroupoid@ when the underlying patch is.
124−data By (k :: a -> *) (p :: a -> a -> *) :: a -> a -> * where
125− -- | Insert a new or update an existing key with the given value @PatchTarget1
126− -- p a@
127− By_Insert :: PatchTarget1 p to -> By k p from to
128− -- | Delete the existing key
129− By_Delete :: By k p from to
130− -- | Move the value from the given key @k a@ to this key. The source key
131− -- should also have an entry in the patch giving the current key as
132− -- @_nodeInfo_to@, usually but not necessarily with @By_Delete@.
133− By_Move :: !(k from) -> p from to -> By k p from to
134−
135−deriving instance ( Show (k to)
136− , Show (p from to)
137− , Show (PatchTarget1 p to)
138− ) => Show (By k p from to)
139−deriving instance ( Read (k to)
140− , Read (p from to)
141− , Read (PatchTarget1 p to)
142− ) => Read (By k p from to)
143−deriving instance ( Eq (k to)
144− , Eq (p from to)
145− , Eq (PatchTarget1 p to)
146− ) => Eq (By k p from to)
147−deriving instance ( Ord (k to)
148− , Ord (p from to)
149− , Ord (PatchTarget1 p to)
150− ) => Ord (By k p from to)
151−
152−mapByPatch
153− :: PatchTarget1 p0 ~ PatchTarget1 p1
154− => ((p0 from to) -> (p1 from to))
155− -> By k p0 from to
156− -> By k p1 from to
157−mapByPatch f = \case
158− By_Insert v -> By_Insert v
159− By_Delete -> By_Delete
160− By_Move k p -> By_Move k $ f p
161−
162−-- | Compose patches having the same effect as applying the patches in turn:
163−-- @'applyAlways' (p <> q) == 'applyAlways' p . 'applyAlways' q@
164−instance ( PatchSource1 p ~ PatchTarget1 p
165− , Cat.Semigroupoid p
166− , PatchHet2 p
167− ) => Cat.Semigroupoid (By k p) where
168− o p0 p1 = mapByPatch unProjectLocal $
169− oLocal (mapByPatch ProjectLocal p0) (mapByPatch ProjectLocal p1)
170−
171−oLocal
172− :: ( PatchSource1 p ~ PatchTarget1 p
173− , PatchHet2Locally p between after
174− )
175− => By k p between after
176− -> By k p before between
177− -> By k p before after
178−By_Insert new `oLocal` _ = By_Insert new
179−By_Delete `oLocal` _ = By_Delete
180−By_Move _ x `oLocal` By_Insert y = By_Insert $ applyAlwaysHet2 x y
181−By_Move _ x `oLocal` By_Move src y = By_Move src $ x `o` y
182−By_Move _ _ `oLocal` By_Delete = By_Delete
183−
184−newtype Flip p to from = Flip (p from to)
185
112
186-- | Structure describing a particular change to a key, be it inserting a new
113-- | Structure describing a particular change to a key, be it inserting a new
187-- key (@From_Insert@), updating an existing key (@From_Insert@ again), deleting
114-- key (@From_Insert@), updating an existing key (@From_Insert@ again), deleting
@@ -201,25 +128,30 @@ data From (k :: a -> *) (p :: a -> a -> *) :: a -> * where
201 -- @_nodeInfo_to@, usually but not necessarily with @From_Delete@.
128 -- @_nodeInfo_to@, usually but not necessarily with @From_Delete@.
202 From_Move :: !(DSum k (Flip p to)) -> From k p to
129 From_Move :: !(DSum k (Flip p to)) -> From k p to
203
130
204−deriving instance ( Show (k a)
131+deriving instance ( Show (k a), GShow k
205− , Show (p a a)
132+ , Has' Show k (Flip p a)
206 , Show (PatchTarget1 p a)
133 , Show (PatchTarget1 p a)
207 ) => Show (From k p a)
134 ) => Show (From k p a)
208−deriving instance ( Read (k a)
135+deriving instance ( Read (k a), GRead k
209− , Read (p a a)
136+ , Has' Read k (Flip p a)
210 , Read (PatchTarget1 p a)
137 , Read (PatchTarget1 p a)
211 ) => Read (From k p a)
138 ) => Read (From k p a)
212−
213deriving instance ( GEq k
139deriving instance ( GEq k
214− , HasZip Eq k p
140+ , Has' Eq k (Flip p a)
215 , Eq (PatchTarget1 p a)
141 , Eq (PatchTarget1 p a)
216 ) => Eq (From k p a)
142 ) => Eq (From k p a)
217−
218deriving instance ( GCompare k
143deriving instance ( GCompare k
144+ , Has' Eq k (Flip p a) -- superclass bug
219− , HasZip Ord k p
145+ , Has' Ord k (Flip p a)
220 , Ord (PatchTarget1 p a)
146 , Ord (PatchTarget1 p a)
221 ) => Ord (From k p a)
147 ) => Ord (From k p a)
222
148
149+newtype Flip p to from = Flip (p from to)
150+
151+instance Cat.Category p => Cat.Category (Flip (p :: k -> k -> *)) where
152+ id = Flip Cat.id
153+ Flip y . Flip x = Flip $ x Cat.. y
154+
223-- | The "to" part of a 'NodeInfo'. Rather than be built out of @From@ like @From@
155-- | The "to" part of a 'NodeInfo'. Rather than be built out of @From@ like @From@
224-- is, we store just the information necessary to compose a @To@ and @From@ like
156-- is, we store just the information necessary to compose a @To@ and @From@ like
225-- @oLocal@ composes two @From@s.
157-- @oLocal@ composes two @From@s.
@@ -231,38 +163,24 @@ data To (k :: a -> *) (p :: a -> a -> *) :: a -> * where
231 -- @_nodeInfo_from@, usually but not necessarily with @To_Delete@.
163 -- @_nodeInfo_from@, usually but not necessarily with @To_Delete@.
232 To_Move :: !(DSum k (p from)) -> To k p from
164 To_Move :: !(DSum k (p from)) -> To k p from
233
165
234−deriving instance ( Show (k a)
166+deriving instance ( Show (k a), GShow k
235− , Show (p a a)
167+ , Has' Show k (p a)
236 , Show (PatchTarget1 p a)
168 , Show (PatchTarget1 p a)
237 ) => Show (To k p a)
169 ) => Show (To k p a)
238−deriving instance ( Read (k a)
170+deriving instance ( Read (k a), GRead k
239− , Read (p a a)
171+ , Has' Read k (p a)
240 , Read (PatchTarget1 p a)
172 , Read (PatchTarget1 p a)
241 ) => Read (To k p a)
173 ) => Read (To k p a)
242−
243deriving instance ( GEq k
174deriving instance ( GEq k
244− , HasZip Eq k p
175+ , Has' Eq k (p a)
245 , Eq (PatchTarget1 p a)
176 , Eq (PatchTarget1 p a)
246 ) => Eq (To k p a)
177 ) => Eq (To k p a)
247−
248deriving instance ( GCompare k
178deriving instance ( GCompare k
179+ , Has' Eq k (p a) -- superclass bug
249− , HasZip Ord k p
180+ , Has' Ord k (p a)
250 , Ord (PatchTarget1 p a)
181 , Ord (PatchTarget1 p a)
251 ) => Ord (To k p a)
182 ) => Ord (To k p a)
252
183
253−--oToFrom
254−-- :: ( PatchSource1 p ~ PatchTarget1 p
255−-- , PatchHet2 p
256−-- )
257−-- => To k p between
258−-- -> From k p between
259−-- -> DSum k (From k p)
260−--From_Insert new `oToFrom` _ = From_Insert new
261−--From_Delete `oToFrom` _ = From_Delete
262−--From_Move _ x `oToFrom` From_Insert y = From_Insert $ applyAlwaysHet2 x y
263−--From_Move _ x `oToFrom` From_Move src y = From_Move src $ x `o` y
264−--From_Move _ _ `oToFrom` From_Delete = From_Delete
265−
266-- |Test whether a 'PatchDMapWithMove' satisfies its invariants.
184-- |Test whether a 'PatchDMapWithMove' satisfies its invariants.
267validPatchDMapWithMove
185validPatchDMapWithMove
268 :: forall k v
186 :: forall k v
@@ -320,7 +238,7 @@ data Fixup k p a
320-- @'applyAlways' (p <> q) == 'applyAlways' p . 'applyAlways' q@
238-- @'applyAlways' (p <> q) == 'applyAlways' p . 'applyAlways' q@
321instance ( GCompare k
239instance ( GCompare k
322 , Cat.Semigroupoid p
240 , Cat.Semigroupoid p
323− -- , DecidablyEmpty p
241+ -- , Cat.DecidablyEmpty p
324 , PatchHet2 p
242 , PatchHet2 p
325 , PatchSource1 p ~ PatchTarget1 p
243 , PatchSource1 p ~ PatchTarget1 p
326 ) => Semigroup (PatchDMapWithMove k p) where
244 ) => Semigroup (PatchDMapWithMove k p) where
@@ -332,12 +250,12 @@ instance ( GCompare k
332 ma
250 ma
333 mb
251 mb
334 h :: DSum k (Pair1 (To k p) (From k p)) -> [DSum k (Fixup k p)]
252 h :: DSum k (Pair1 (To k p) (From k p)) -> [DSum k (Fixup k p)]
335− h ((between :: k between) :=> Pair1 editAfter editBefore) = case (editAfter, editBefore) of
253+ h ((_ :: k between) :=> Pair1 editAfter editBefore) = case (editAfter, editBefore) of
336 (To_Move ((toAfter :: k after) :=> p1), From_Move ((fromBefore :: k before) :=> Flip p0)) ->
254 (To_Move ((toAfter :: k after) :=> p1), From_Move ((fromBefore :: k before) :=> Flip p0)) ->
337− case toAfter `geq` fromBefore of
255+ --case toAfter `geq` fromBefore of
338− Just Refl | isNull p0 ->
256+ -- Just Refl | Just Refl <- Cat.isId p0 ->
339− [ toAfter :=> Fixup_Delete ]
257+ -- [ toAfter :=> Fixup_Delete ]
340− _ ->
258+ -- _ ->
341 [ toAfter :=> Fixup_Update (This $ From_Move $ fromBefore :=> (Flip $ p1 `o` p0))
259 [ toAfter :=> Fixup_Update (This $ From_Move $ fromBefore :=> (Flip $ p1 `o` p0))
342 , fromBefore :=> Fixup_Update (That $ To_Move $ toAfter :=> (p1 `o` p0))
260 , fromBefore :=> Fixup_Update (That $ To_Move $ toAfter :=> (p1 `o` p0))
343 ]
261 ]
@@ -347,7 +265,7 @@ instance ( GCompare k
347 [fromBefore :=> Fixup_Update (That To_NonMove)]
265 [fromBefore :=> Fixup_Update (That To_NonMove)]
348 (To_Move (toAfter :=> p), From_Insert val) ->
266 (To_Move (toAfter :=> p), From_Insert val) ->
349 [toAfter :=> Fixup_Update (This $ From_Insert $ applyAlwaysHet2 p val)]
267 [toAfter :=> Fixup_Update (This $ From_Insert $ applyAlwaysHet2 p val)]
350− (To_Move (toAfter :=> p), From_Delete) ->
268+ (To_Move (toAfter :=> _), From_Delete) ->
351 [toAfter :=> Fixup_Update (This From_Delete)]
269 [toAfter :=> Fixup_Update (This From_Delete)]
352 (To_NonMove, _) ->
270 (To_NonMove, _) ->
353 []
271 []
@@ -414,25 +332,31 @@ PatchDMapWithMove dstAfter srcAfter `mappendPatchDMapWithMoveSlow` PatchDMapWith
414 src = DMap.mapMaybeWithKey g $ DMap.union srcAfter srcBefore
332 src = DMap.mapMaybeWithKey g $ DMap.union srcAfter srcBefore
415-}
333-}
416
334
417−-- |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'.
335+-- | Make a @'PatchDMapWithMove' k v@ which has the effect of inserting or
336+-- updating a value @PatchTarget1 p a@ to the given key @k a@, like
337+-- 'DMap.insert'.
418insertDMapKey :: k a -> PatchTarget1 p a -> PatchDMapWithMove k p
338insertDMapKey :: k a -> PatchTarget1 p a -> PatchDMapWithMove k p
419insertDMapKey k v =
339insertDMapKey k v =
420 PatchDMapWithMove . DMap.singleton k $ NodeInfo (From_Insert v) To_NonMove
340 PatchDMapWithMove . DMap.singleton k $ NodeInfo (From_Insert v) To_NonMove
421
341
422−-- |Make a @'PatchDMapWithMove' k v@ which has the effect of moving the value from the first key @k a@ to the second key @k a@, equivalent to:
342+-- | Make a @'PatchDMapWithMove' k v@ which has the effect of moving the value
343+-- from the first key @k a@ to the second key @k a@, equivalent to:
423--
344--
424-- @
345-- @
425-- 'DMap.delete' src (maybe dmap ('DMap.insert' dst) (DMap.lookup src dmap))
346-- 'DMap.delete' src (maybe dmap ('DMap.insert' dst) (DMap.lookup src dmap))
426-- @
347-- @
348+moveDMapKey
349+ :: GCompare k
427−moveDMapKey :: GCompare k => k a -> k a -> PatchDMapWithMove k (Proxy2 v)
350+ => k a -> k a -> PatchDMapWithMove k (Proxy3 v)
428moveDMapKey src dst = case src `geq` dst of
351moveDMapKey src dst = case src `geq` dst of
429 Nothing -> PatchDMapWithMove $ DMap.fromList
352 Nothing -> PatchDMapWithMove $ DMap.fromList
430− [ dst :=> NodeInfo (From_Move (src :=> Cat.id)) To_NonMove
353+ [ dst :=> NodeInfo (From_Move (src :=> Flip Proxy3)) To_NonMove
431− , src :=> NodeInfo From_Delete (To_Move $ dst :=> Proxy2)
354+ , src :=> NodeInfo From_Delete (To_Move $ dst :=> Proxy3)
432 ]
355 ]
433− Just _ -> mempty
356+ Just _ -> PatchDMapWithMove DMap.empty
434
357
435−-- |Make a @'PatchDMapWithMove' k v@ which has the effect of swapping two keys in the mapping, equivalent to:
358+-- | Make a @'PatchDMapWithMove' k v@ which has the effect of swapping two keys
359+-- in the mapping, equivalent to:
436--
360--
437-- @
361-- @
438-- let aMay = DMap.lookup a dmap
362-- let aMay = DMap.lookup a dmap
@@ -441,17 +365,18 @@ moveDMapKey src dst = case src `geq` dst of
441-- . maybe id (DMap.insert b) (aMay `mplus` bMay)
365-- . maybe id (DMap.insert b) (aMay `mplus` bMay)
442-- . DMap.delete a . DMap.delete b $ dmap
366-- . DMap.delete a . DMap.delete b $ dmap
443-- @
367-- @
444−swapDMapKey :: GCompare k => k a -> k a -> PatchDMapWithMove k v
368+swapDMapKey :: GCompare k => k a -> k a -> PatchDMapWithMove k (Proxy3 v)
445swapDMapKey src dst = case src `geq` dst of
369swapDMapKey src dst = case src `geq` dst of
446 Nothing -> PatchDMapWithMove $ DMap.fromList
370 Nothing -> PatchDMapWithMove $ DMap.fromList
447− [ dst :=> NodeInfo (From_Move (src :=> Cat.id)) (ComposeMaybe $ Just src)
371+ [ dst :=> NodeInfo (From_Move (src :=> Flip Proxy3)) (To_Move $ src :=> Proxy3)
448− , src :=> NodeInfo (From_Move (dst :=> Cat.id)) (To_Move $ dst :=> Proxy2)
372+ , src :=> NodeInfo (From_Move (dst :=> Flip Proxy3)) (To_Move $ dst :=> Proxy3)
449 ]
373 ]
450− Just _ -> mempty
374+ Just _ -> PatchDMapWithMove DMap.empty
451
375
452−-- |Make a @'PatchDMapWithMove' k v@ which has the effect of deleting a key in the mapping, equivalent to 'DMap.delete'.
376+-- | Make a @'PatchDMapWithMove' k v@ which has the effect of deleting a key in
377+-- the mapping, equivalent to 'DMap.delete'.
453deleteDMapKey :: k a -> PatchDMapWithMove k v
378deleteDMapKey :: k a -> PatchDMapWithMove k v
454−deleteDMapKey k = PatchDMapWithMove $ DMap.singleton k $ NodeInfo From_Delete $ ComposeMaybe Nothing
379+deleteDMapKey k = PatchDMapWithMove $ DMap.singleton k $ NodeInfo From_Delete To_NonMove
455
380
456{-
381{-
457k1, k2 :: Const2 Int () ()
382k1, k2 :: Const2 Int () ()
@@ -477,17 +402,20 @@ dst (PatchDMapWithMove x _) = x
477src (PatchDMapWithMove _ x) = x
402src (PatchDMapWithMove _ x) = x
478-}
403-}
479
404
480−-- |Extract the 'DMap' representing the patch changes from the 'PatchDMapWithMove'.
405+-- | Extract the 'DMap' representing the patch changes from the
406+-- 'PatchDMapWithMove'.
481unPatchDMapWithMove :: PatchDMapWithMove k v -> DMap k (NodeInfo k v)
407unPatchDMapWithMove :: PatchDMapWithMove k v -> DMap k (NodeInfo k v)
482unPatchDMapWithMove (PatchDMapWithMove p) = p
408unPatchDMapWithMove (PatchDMapWithMove p) = p
483
409
484−-- |Wrap a 'DMap' representing patch changes into a 'PatchDMapWithMove', without checking any invariants.
410+-- | Wrap a 'DMap' representing patch changes into a 'PatchDMapWithMove',
411+-- without checking any invariants.
485--
412--
486-- __Warning:__ when using this function, you must ensure that the invariants of 'PatchDMapWithMove' are preserved; they will not be checked.
413-- __Warning:__ when using this function, you must ensure that the invariants of 'PatchDMapWithMove' are preserved; they will not be checked.
487unsafePatchDMapWithMove :: DMap k (NodeInfo k v) -> PatchDMapWithMove k v
414unsafePatchDMapWithMove :: DMap k (NodeInfo k v) -> PatchDMapWithMove k v
488unsafePatchDMapWithMove = PatchDMapWithMove
415unsafePatchDMapWithMove = PatchDMapWithMove
489
416
417+-- | Wrap a 'DMap' representing patch changes into a 'PatchDMapWithMove' while
490−-- |Wrap a 'DMap' representing patch changes into a 'PatchDMapWithMove' while checking invariants. If the invariants are satisfied, @Right p@ is returned
418+-- checking invariants. If the invariants are satisfied, @Right p@ is returned
491-- otherwise @Left errors@.
419-- otherwise @Left errors@.
492patchDMapWithMove :: (GCompare k, GShow k) => DMap k (NodeInfo k v) -> Either [String] (PatchDMapWithMove k v)
420patchDMapWithMove :: (GCompare k, GShow k) => DMap k (NodeInfo k v) -> Either [String] (PatchDMapWithMove k v)
493patchDMapWithMove dm =
421patchDMapWithMove dm =
@@ -495,20 +423,28 @@ patchDMapWithMove dm =
495 [] -> Right $ unsafePatchDMapWithMove dm
423 [] -> Right $ unsafePatchDMapWithMove dm
496 errs -> Left errs
424 errs -> Left errs
497
425
498−-- |Map a natural transform @v -> v'@ over the given patch, transforming @'PatchDMapWithMove' k v@ into @'PatchDMapWithMove' k v'@.
426+-- | Map a natural transform @v -> v'@ over the given patch, transforming
427+-- @'PatchDMapWithMove' k v@ into @'PatchDMapWithMove' k v'@.
499mapPatchDMapWithMove
428mapPatchDMapWithMove
500 :: forall k p p'
429 :: forall k p p'
501 . (forall a. PatchTarget1 p a -> PatchTarget1 p' a)
430 . (forall a. PatchTarget1 p a -> PatchTarget1 p' a)
502 -> (forall from to. p from to -> p' from to)
431 -> (forall from to. p from to -> p' from to)
503 -> PatchDMapWithMove k p
432 -> PatchDMapWithMove k p
504 -> PatchDMapWithMove k p'
433 -> PatchDMapWithMove k p'
505−mapPatchDMapWithMove f g (PatchDMapWithMove p) = PatchDMapWithMove $
434+mapPatchDMapWithMove f g (PatchDMapWithMove m) =
435+ PatchDMapWithMove $ DMap.map (\ni -> NodeInfo
506− DMap.map (\ni -> ni { _nodeInfo_from = g $ _nodeInfo_from ni }) p
436+ { _nodeInfo_from = h $ _nodeInfo_from ni
437+ , _nodeInfo_to = j $ _nodeInfo_to ni
438+ }) m
507− where g :: forall a. From k PatchTarget1 p a -> From k PatchTarget1 p' a
439+ where h :: forall a. From k p a -> From k p' a
508− g = \case
440+ h = \case
509 From_Insert v -> From_Insert $ f v
441 From_Insert v -> From_Insert $ f v
510 From_Delete -> From_Delete
442 From_Delete -> From_Delete
511− From_Move k p -> From_Move k $ g p
443+ From_Move (k :=> (Flip p)) -> From_Move $ k :=> Flip (g p)
444+ j :: forall a. To k p a -> To k p' a
445+ j = \case
446+ To_NonMove -> To_NonMove
447+ To_Move (k :=> p) -> To_Move $ k :=> g p
512
448
513-- | Traverse an effectful function @forall a. PatchTarget1 p a -> m (v ' a)@
449-- | Traverse an effectful function @forall a. PatchTarget1 p a -> m (v ' a)@
514-- over the given patch, transforming @'PatchDMapWithMove' k v@ into @m
450-- over the given patch, transforming @'PatchDMapWithMove' k v@ into @m
@@ -517,9 +453,12 @@ traversePatchDMapWithMove
517 :: forall m k p p'
453 :: forall m k p p'
518 . Applicative m
454 . Applicative m
519 => (forall a. PatchTarget1 p a -> m (PatchTarget1 p' a))
455 => (forall a. PatchTarget1 p a -> m (PatchTarget1 p' a))
456+ -> (forall from to. p from to -> m (p' from to))
520 -> PatchDMapWithMove k p
457 -> PatchDMapWithMove k p
521 -> m (PatchDMapWithMove k p')
458 -> m (PatchDMapWithMove k p')
522−traversePatchDMapWithMove f = traversePatchDMapWithMoveWithKey $ const f
459+traversePatchDMapWithMove f g = traversePatchDMapWithMoveWithKey
460+ (\_ -> f)
461+ (\_ _ -> g)
523
462
524-- | Map an effectful function @forall a. k a -> PatchTarget1 p a -> m (v ' a)@
463-- | Map an effectful function @forall a. k a -> PatchTarget1 p a -> m (v ' a)@
525-- over the given patch, transforming @'PatchDMapWithMove' k v@ into @m
464-- over the given patch, transforming @'PatchDMapWithMove' k v@ into @m
@@ -528,49 +467,67 @@ traversePatchDMapWithMoveWithKey
528 :: forall m k p p'
467 :: forall m k p p'
529 . Applicative m
468 . Applicative m
530 => (forall a. k a -> PatchTarget1 p a -> m (PatchTarget1 p' a))
469 => (forall a. k a -> PatchTarget1 p a -> m (PatchTarget1 p' a))
470+ -> (forall from to. k from -> k to -> p from to -> m (p' from to))
531 -> PatchDMapWithMove k p
471 -> PatchDMapWithMove k p
532 -> m (PatchDMapWithMove k p')
472 -> m (PatchDMapWithMove k p')
533−traversePatchDMapWithMoveWithKey f (PatchDMapWithMove p) =
473+traversePatchDMapWithMoveWithKey f g (PatchDMapWithMove m) =
534− PatchDMapWithMove <$> DMap.traverseWithKey (nodeInfoMapFromM . g) p
474+ fmap PatchDMapWithMove $ DMap.traverseWithKey (\k ni -> NodeInfo
475+ <$> (h k $ _nodeInfo_from ni)
476+ <*> (j k $ _nodeInfo_to ni)) m
535− where g :: forall a. k a -> From k PatchTarget1 p a -> m (From k PatchTarget1 p' a)
477+ where h :: forall a. k a -> From k p a -> m (From k p' a)
536− g k = \case
478+ h k = \case
537 From_Insert v -> From_Insert <$> f k v
479 From_Insert v -> From_Insert <$> f k v
538 From_Delete -> pure From_Delete
480 From_Delete -> pure From_Delete
539− From_Move fromKey -> pure $ From_Move fromKey
481+ From_Move (fromKey :=> Flip p) -> From_Move . (fromKey :=>) . Flip <$> g fromKey k p
482+ j :: forall a. k a -> To k p a -> m (To k p' a)
483+ j k = \case
484+ To_NonMove -> pure To_NonMove
485+ To_Move (toKey :=> p) -> To_Move . (toKey :=>) <$> g k toKey p
540
486
541-- | Map a function which transforms @'From k PatchTarget1 p a@ into a @'From k
487-- | Map a function which transforms @'From k PatchTarget1 p a@ into a @'From k
542-- PatchTarget1 p' a@ over a @'NodeInfo' k PatchTarget1 p a@.
488-- PatchTarget1 p' a@ over a @'NodeInfo' k PatchTarget1 p a@.
543nodeInfoMapFrom
489nodeInfoMapFrom
544 :: (From k p a -> From k p' a)
490 :: (From k p a -> From k p' a)
491+ -> (To k p a -> To k p' a)
545 -> NodeInfo k p a
492 -> NodeInfo k p a
546 -> NodeInfo k p' a
493 -> NodeInfo k p' a
494+nodeInfoMapFrom f g ni = NodeInfo
547−nodeInfoMapFrom f ni = ni { _nodeInfo_from = f $ _nodeInfo_from ni }
495+ { _nodeInfo_from = f $ _nodeInfo_from ni
496+ , _nodeInfo_to = g $ _nodeInfo_to ni
497+ }
548
498
549-- | Map an effectful function which transforms @'From k PatchTarget1 p a@ into
499-- | Map an effectful function which transforms @'From k PatchTarget1 p a@ into
550-- a @f ('From k PatchTarget1 p' a)@ over a @'NodeInfo' k PatchTarget1 p a@.
500-- a @f ('From k PatchTarget1 p' a)@ over a @'NodeInfo' k PatchTarget1 p a@.
551nodeInfoMapFromM
501nodeInfoMapFromM
552− :: Functor f
502+ :: Applicative f
553 => (From k p a -> f (From k p' a))
503 => (From k p a -> f (From k p' a))
504+ -> (To k p a -> f (To k p' a))
554 -> NodeInfo k p a
505 -> NodeInfo k p a
555 -> f (NodeInfo k p' a)
506 -> f (NodeInfo k p' a)
556−nodeInfoMapFromM f ni = fmap (\result -> ni { _nodeInfo_from = result }) $ f $ _nodeInfo_from ni
507+nodeInfoMapFromM f g ni = NodeInfo
508+ <$> (f $ _nodeInfo_from ni)
509+ <*> (g $ _nodeInfo_to ni)
557
510
558-- | Weaken a 'PatchDMapWithMove' to a 'PatchMapWithMove' by weakening the keys
511-- | Weaken a 'PatchDMapWithMove' to a 'PatchMapWithMove' by weakening the keys
559-- from @k a@ to @'Some' k@ and applying a given weakening function
512-- from @k a@ to @'Some' k@ and applying a given weakening function
560-- @PatchTarget1 p a -> v'@ to values.
513-- @PatchTarget1 p a -> v'@ to values.
561weakenPatchDMapWithMoveWith
514weakenPatchDMapWithMoveWith
562− :: forall k p v'
515+ :: forall k p p'
563− . (forall a. PatchTarget1 p a -> v')
516+ . (forall a. PatchTarget1 p a -> PatchTarget p')
517+ -> (forall from to. p from to -> p')
564 -> PatchDMapWithMove k p
518 -> PatchDMapWithMove k p
565− -> PatchMapWithMove (Some k) (Proxy v')
519+ -> PatchMapWithMove (Some k) p'
566−weakenPatchDMapWithMoveWith f (PatchDMapWithMove p) = PatchMapWithMove $ weakenDMapWith g p
520+weakenPatchDMapWithMoveWith f g (PatchDMapWithMove m) =
521+ PatchMapWithMove $ weakenDMapWith h m
567− where g :: forall a. NodeInfo k PatchTarget1 p a -> MapWithMove.NodeInfo (Some k) (Proxy v')
522+ where h :: forall a. NodeInfo k p a -> MapWithMove.NodeInfo (Some k) p'
568− g ni = MapWithMove.NodeInfo
523+ h ni = MapWithMove.NodeInfo
569 { MapWithMove._nodeInfo_from = case _nodeInfo_from ni of
524 { MapWithMove._nodeInfo_from = case _nodeInfo_from ni of
570 From_Insert v -> MapWithMove.From_Insert $ f v
525 From_Insert v -> MapWithMove.From_Insert $ f v
571 From_Delete -> MapWithMove.From_Delete
526 From_Delete -> MapWithMove.From_Delete
572− From_Move k -> MapWithMove.From_Move (Some k) Proxy
527+ From_Move (k :=> Flip p) -> MapWithMove.From_Move (Some k) $ g p
573− , MapWithMove._nodeInfo_to = Some <$> getComposeMaybe (_nodeInfo_to ni)
528+ , MapWithMove._nodeInfo_to = case _nodeInfo_to ni of
529+ To_NonMove -> MapWithMove.To_NonMove
530+ To_Move (k :=> p) -> MapWithMove.To_Move (Some k) $ g p
574 }
531 }
575
532
576-- | "Weaken" a @'PatchDMapWithMove' (Const2 k a) v@ to a @'PatchMapWithMove' k
533-- | "Weaken" a @'PatchDMapWithMove' (Const2 k a) v@ to a @'PatchMapWithMove' k
@@ -578,17 +535,22 @@ weakenPatchDMapWithMoveWith f (PatchDMapWithMove p) = PatchMapWithMove $ weakenD
578-- dependency in the typing and all points are already @a@, hence the function
535-- dependency in the typing and all points are already @a@, hence the function
579-- to map each value to @v'@ is not higher rank.
536-- to map each value to @v'@ is not higher rank.
580patchDMapWithMoveToPatchMapWithMoveWith
537patchDMapWithMoveToPatchMapWithMoveWith
538+ :: forall k p p' a
581− :: forall k p v' a. (PatchTarget1 p a -> v')
539+ . (PatchTarget1 p a -> PatchTarget p')
540+ -> (p a a -> p')
582 -> PatchDMapWithMove (Const2 k a) p
541 -> PatchDMapWithMove (Const2 k a) p
583− -> PatchMapWithMove k (Proxy v')
542+ -> PatchMapWithMove k p'
584−patchDMapWithMoveToPatchMapWithMoveWith f (PatchDMapWithMove p) = PatchMapWithMove $ dmapToMapWith g p
543+patchDMapWithMoveToPatchMapWithMoveWith f g (PatchDMapWithMove m) =
544+ PatchMapWithMove $ dmapToMapWith h m
585− where g :: NodeInfo (Const2 k a) PatchTarget1 p a -> MapWithMove.NodeInfo k (Proxy v')
545+ where h :: NodeInfo (Const2 k a) p a -> MapWithMove.NodeInfo k p'
586− g ni = MapWithMove.NodeInfo
546+ h ni = MapWithMove.NodeInfo
587 { MapWithMove._nodeInfo_from = case _nodeInfo_from ni of
547 { MapWithMove._nodeInfo_from = case _nodeInfo_from ni of
588 From_Insert v -> MapWithMove.From_Insert $ f v
548 From_Insert v -> MapWithMove.From_Insert $ f v
589 From_Delete -> MapWithMove.From_Delete
549 From_Delete -> MapWithMove.From_Delete
590− From_Move (Const2 k) -> MapWithMove.From_Move k Proxy
550+ From_Move (Const2 k :=> Flip p) -> MapWithMove.From_Move k $ g p
591− , MapWithMove._nodeInfo_to = unConst2 <$> getComposeMaybe (_nodeInfo_to ni)
551+ , MapWithMove._nodeInfo_to = case _nodeInfo_to ni of
552+ To_NonMove -> MapWithMove.To_NonMove
553+ To_Move (Const2 k :=> p) -> MapWithMove.To_Move k $ g p
592 }
554 }
593
555
594-- | "Strengthen" a @'PatchMapWithMove' k v@ into a @'PatchDMapWithMove
556-- | "Strengthen" a @'PatchMapWithMove' k v@ into a @'PatchDMapWithMove
@@ -597,36 +559,47 @@ patchDMapWithMoveToPatchMapWithMoveWith f (PatchDMapWithMove p) = PatchMapWithMo
597-- 'Const2'. Apply the given function to each @v@ to produce a @PatchTarget1 p'
559-- 'Const2'. Apply the given function to each @v@ to produce a @PatchTarget1 p'
598-- a@. Completemented by 'patchDMapWithMoveToPatchMapWithMoveWith'
560-- a@. Completemented by 'patchDMapWithMoveToPatchMapWithMoveWith'
599const2PatchDMapWithMoveWith
561const2PatchDMapWithMoveWith
600− :: forall k v p' a
562+ :: forall k v v' a
601− . (v -> PatchTarget1 p' a)
563+ . (v -> v' a)
602 -> PatchMapWithMove k (Proxy v)
564 -> PatchMapWithMove k (Proxy v)
603− -> PatchDMapWithMove (Const2 k a) p'
565+ -> PatchDMapWithMove (Const2 k a) (Proxy3 v')
566+const2PatchDMapWithMoveWith f (PatchMapWithMove p) =
604−const2PatchDMapWithMoveWith f (PatchMapWithMove p) = PatchDMapWithMove $ DMap.fromDistinctAscList $ g <$> Map.toAscList p
567+ PatchDMapWithMove $ DMap.fromDistinctAscList $ g <$> Map.toAscList p
605− where g :: (k, MapWithMove.NodeInfo k (Proxy v)) -> DSum (Const2 k a) (NodeInfo (Const2 k a) v')
568+ where g :: (k, MapWithMove.NodeInfo k (Proxy v))
569+ -> DSum (Const2 k a) (NodeInfo (Const2 k a) (Proxy3 v'))
606 g (k, ni) = Const2 k :=> NodeInfo
570 g (k, ni) = Const2 k :=> NodeInfo
607 { _nodeInfo_from = case MapWithMove._nodeInfo_from ni of
571 { _nodeInfo_from = case MapWithMove._nodeInfo_from ni of
608 MapWithMove.From_Insert v -> From_Insert $ f v
572 MapWithMove.From_Insert v -> From_Insert $ f v
609 MapWithMove.From_Delete -> From_Delete
573 MapWithMove.From_Delete -> From_Delete
610− MapWithMove.From_Move fromKey Proxy -> From_Move $ Const2 fromKey
574+ MapWithMove.From_Move fromKey Proxy -> From_Move $ Const2 fromKey :=> Flip Proxy3
611− , _nodeInfo_to = ComposeMaybe $ Const2 <$> MapWithMove._nodeInfo_to ni
575+ , _nodeInfo_to = case MapWithMove._nodeInfo_to ni of
576+ MapWithMove.To_NonMove -> To_NonMove
577+ MapWithMove.To_Move toKey Proxy -> To_Move $ Const2 toKey :=> Proxy3
612 }
578 }
613
579
614-- | Apply the insertions, deletions, and moves to a given 'DMap'.
580-- | Apply the insertions, deletions, and moves to a given 'DMap'.
581+instance ( GCompare k
582+ , PatchHet2 p
583+ , PatchSource1 p ~ PatchTarget1 p
615−instance GCompare k => PatchHet (PatchDMapWithMove k p) where
584+ ) => PatchHet (PatchDMapWithMove k p) where
616 type PatchSource (PatchDMapWithMove k p) = DMap k (PatchSource1 p)
585 type PatchSource (PatchDMapWithMove k p) = DMap k (PatchSource1 p)
617 type PatchTarget (PatchDMapWithMove k p) = DMap k (PatchTarget1 p)
586 type PatchTarget (PatchDMapWithMove k p) = DMap k (PatchTarget1 p)
587+
588+instance ( GCompare k
589+ , PatchHet2 p
590+ , PatchSource1 p ~ PatchTarget1 p
618−instance GCompare k => Patch (PatchDMapWithMove k p) where
591+ ) => Patch (PatchDMapWithMove k p) where
619− apply (PatchDMapWithMove p) old = Just $! insertions `DMap.union` (old `DMap.difference` deletions)
592+ apply (PatchDMapWithMove m) old = Just $! insertions `DMap.union` (old `DMap.difference` deletions)
620 -- TODO: return Nothing sometimes --Note: the strict application here is
593 -- TODO: return Nothing sometimes --Note: the strict application here is
621 -- critical to ensuring that incremental merges don't hold onto all their
594 -- critical to ensuring that incremental merges don't hold onto all their
622 -- prerequisite events forever; can we make this more robust?
595 -- prerequisite events forever; can we make this more robust?
623− where insertions = DMap.mapMaybeWithKey insertFunc p
596+ where insertions = DMap.mapMaybeWithKey insertFunc m
624 insertFunc :: forall a. k a -> NodeInfo k p a -> Maybe (PatchTarget1 p a)
597 insertFunc :: forall a. k a -> NodeInfo k p a -> Maybe (PatchTarget1 p a)
625 insertFunc _ ni = case _nodeInfo_from ni of
598 insertFunc _ ni = case _nodeInfo_from ni of
626 From_Insert v -> Just v
599 From_Insert v -> Just v
627− From_Move k -> DMap.lookup k old
600+ From_Move (k :=> Flip p) -> applyAlwaysHet2 p <$> DMap.lookup k old
628 From_Delete -> Nothing
601 From_Delete -> Nothing
629− deletions = DMap.mapMaybeWithKey deleteFunc p
602+ deletions = DMap.mapMaybeWithKey deleteFunc m
630 deleteFunc :: forall a. k a -> NodeInfo k p a -> Maybe (Constant () a)
603 deleteFunc :: forall a. k a -> NodeInfo k p a -> Maybe (Constant () a)
631 deleteFunc _ ni = case _nodeInfo_from ni of
604 deleteFunc _ ni = case _nodeInfo_from ni of
632 From_Delete -> Just $ Constant ()
605 From_Delete -> Just $ Constant ()
@@ -634,6 +607,12 @@ instance GCompare k => Patch (PatchDMapWithMove k p) where
634
607
635-- | Get the values that will be replaced, deleted, or moved if the given patch
608-- | Get the values that will be replaced, deleted, or moved if the given patch
636-- is applied to the given 'DMap'.
609-- is applied to the given 'DMap'.
637−getDeletionsAndMoves :: GCompare k => PatchDMapWithMove k v -> DMap k v' -> DMap k (Product v' (ComposeMaybe k))
610+getDeletionsAndMoves
611+ :: ( GCompare k
612+ , PatchSource1 p ~ PatchTarget1 p
613+ )
614+ => PatchDMapWithMove k p
615+ -> DMap k (PatchSource1 p)
616+ -> DMap k (Product (PatchTarget1 p) (To k p))
638getDeletionsAndMoves (PatchDMapWithMove p) m = DMap.intersectionWithKey f m p
617getDeletionsAndMoves (PatchDMapWithMove p) m = DMap.intersectionWithKey f m p
639 where f _ v ni = Pair v $ _nodeInfo_to ni
618 where f _ v ni = Pair v $ _nodeInfo_to ni
src/Data/Patch/MapWithMove.hs+62−41
@@ -41,7 +41,7 @@ deriving instance (Ord k, Ord p, Ord (PatchTarget p)) => Ord (PatchMapWithMove k
41data NodeInfo k p = NodeInfo
41data NodeInfo k p = NodeInfo
42 { _nodeInfo_from :: !(From k p)
42 { _nodeInfo_from :: !(From k p)
43 -- ^ Where do we get the new value for this key?
43 -- ^ Where do we get the new value for this key?
44− , _nodeInfo_to :: !(To k)
44+ , _nodeInfo_to :: !(To k p)
45 -- ^ If the old value is being kept (i.e. moved rather than deleted or
45 -- ^ If the old value is being kept (i.e. moved rather than deleted or
46 -- replaced), where is it going?
46 -- replaced), where is it going?
47 }
47 }
@@ -64,14 +64,23 @@ deriving instance (Ord k, Ord p, Ord (PatchTarget p)) => Ord (From k p)
64-- | Describe where a key's old value will go. If this is 'Just', that means
64-- | Describe where a key's old value will go. If this is 'Just', that means
65-- the key's old value will be moved to the given other key; if it is 'Nothing',
65-- the key's old value will be moved to the given other key; if it is 'Nothing',
66-- that means it will be deleted.
66-- that means it will be deleted.
67−type To = Maybe
67+data To k p
68+ = To_NonMove
69+ | To_Move !k !p
70+
71+deriving instance (Show k, Show p, Show (PatchTarget p)) => Show (To k p)
72+deriving instance (Read k, Read p, Read (PatchTarget p)) => Read (To k p)
73+deriving instance (Eq k, Eq p, Eq (PatchTarget p)) => Eq (To k p)
74+deriving instance (Ord k, Ord p, Ord (PatchTarget p)) => Ord (To k p)
68
75
69-- | Create a 'PatchMapWithMove', validating it
76-- | Create a 'PatchMapWithMove', validating it
70patchMapWithMove
77patchMapWithMove
71 :: Ord k => Map k (NodeInfo k p) -> Maybe (PatchMapWithMove k p)
78 :: Ord k => Map k (NodeInfo k p) -> Maybe (PatchMapWithMove k p)
72patchMapWithMove m = if valid then Just $ PatchMapWithMove m else Nothing
79patchMapWithMove m = if valid then Just $ PatchMapWithMove m else Nothing
73 where valid = forwardLinks == backwardLinks
80 where valid = forwardLinks == backwardLinks
74− forwardLinks = Map.mapMaybe _nodeInfo_to m
81+ forwardLinks = flip Map.mapMaybe m $ \x -> case _nodeInfo_to x of
82+ To_NonMove -> Nothing
83+ To_Move to _ -> Just to
75 backwardLinks = Map.fromList $ catMaybes $ flip fmap (Map.toList m) $ \(to, p) ->
84 backwardLinks = Map.fromList $ catMaybes $ flip fmap (Map.toList m) $ \(to, p) ->
76 case _nodeInfo_from p of
85 case _nodeInfo_from p of
77 From_Move from _ -> Just (from, to)
86 From_Move from _ -> Just (from, to)
@@ -82,7 +91,7 @@ patchMapWithMoveInsertAll
82 :: Map k (PatchTarget p) -> PatchMapWithMove k p
91 :: Map k (PatchTarget p) -> PatchMapWithMove k p
83patchMapWithMoveInsertAll m = PatchMapWithMove $ flip fmap m $ \v -> NodeInfo
92patchMapWithMoveInsertAll m = PatchMapWithMove $ flip fmap m $ \v -> NodeInfo
84 { _nodeInfo_from = From_Insert v
93 { _nodeInfo_from = From_Insert v
85− , _nodeInfo_to = Nothing
94+ , _nodeInfo_to = To_NonMove
86 }
95 }
87
96
88-- | Extract the internal representation of the 'PatchMapWithMove'
97-- | Extract the internal representation of the 'PatchMapWithMove'
@@ -93,7 +102,7 @@ unPatchMapWithMove (PatchMapWithMove p) = p
93-- | Make a @'PatchMapWithMove' k p@ which has the effect of inserting or updating a value @v@ to the given key @k@, like 'Map.insert'.
102-- | Make a @'PatchMapWithMove' k p@ which has the effect of inserting or updating a value @v@ to the given key @k@, like 'Map.insert'.
94insertMapKey
103insertMapKey
95 :: k -> PatchTarget p -> PatchMapWithMove k p
104 :: k -> PatchTarget p -> PatchMapWithMove k p
96−insertMapKey k v = PatchMapWithMove . Map.singleton k $ NodeInfo (From_Insert v) Nothing
105+insertMapKey k v = PatchMapWithMove . Map.singleton k $ NodeInfo (From_Insert v) To_NonMove
97
106
98-- |Make a @'PatchMapWithMove' k p@ which has the effect of moving the value from the first key @k@ to the second key @k@, equivalent to:
107-- |Make a @'PatchMapWithMove' k p@ which has the effect of moving the value from the first key @k@ to the second key @k@, equivalent to:
99--
108--
@@ -106,8 +115,8 @@ moveMapKey src dst
106 | src == dst = mempty
115 | src == dst = mempty
107 | otherwise =
116 | otherwise =
108 PatchMapWithMove $ Map.fromList
117 PatchMapWithMove $ Map.fromList
109− [ (dst, NodeInfo (From_Move src mempty) Nothing)
118+ [ (dst, NodeInfo (From_Move src mempty) To_NonMove)
110− , (src, NodeInfo From_Delete (Just dst))
119+ , (src, NodeInfo From_Delete (To_Move dst mempty))
111 ]
120 ]
112
121
113-- |Make a @'PatchMapWithMove' k p@ which has the effect of swapping two keys in the mapping, equivalent to:
122-- |Make a @'PatchMapWithMove' k p@ which has the effect of swapping two keys in the mapping, equivalent to:
@@ -120,19 +129,21 @@ moveMapKey src dst
120-- . Map.delete a . Map.delete b $ map
129-- . Map.delete a . Map.delete b $ map
121-- @
130-- @
122swapMapKey
131swapMapKey
132+ :: (DecidablyEmpty p, Patch p)
123− :: (DecidablyEmpty p, Patch p) => Ord k => k -> k -> PatchMapWithMove k p
133+ => Ord k => k -> k -> PatchMapWithMove k p
124swapMapKey src dst
134swapMapKey src dst
125 | src == dst = mempty
135 | src == dst = mempty
126 | otherwise =
136 | otherwise =
127 PatchMapWithMove $ Map.fromList
137 PatchMapWithMove $ Map.fromList
128− [ (dst, NodeInfo (From_Move src mempty) (Just src))
138+ [ (dst, NodeInfo (From_Move src mempty) (To_Move dst mempty))
129− , (src, NodeInfo (From_Move dst mempty) (Just dst))
139+ , (src, NodeInfo (From_Move dst mempty) (To_Move dst mempty))
130 ]
140 ]
131
141
132−-- |Make a @'PatchMapWithMove' k v@ which has the effect of deleting a key in the mapping, equivalent to 'Map.delete'.
142+-- | Make a @'PatchMapWithMove' k v@ which has the effect of deleting a key in
143+-- the mapping, equivalent to 'Map.delete'.
133deleteMapKey
144deleteMapKey
134 :: k -> PatchMapWithMove k v
145 :: k -> PatchMapWithMove k v
135−deleteMapKey k = PatchMapWithMove . Map.singleton k $ NodeInfo From_Delete Nothing
146+deleteMapKey k = PatchMapWithMove . Map.singleton k $ NodeInfo From_Delete To_NonMove
136
147
137-- | Wrap a @'Map' k (NodeInfo k v)@ representing patch changes into a @'PatchMapWithMove' k v@, without checking any invariants.
148-- | Wrap a @'Map' k (NodeInfo k v)@ representing patch changes into a @'PatchMapWithMove' k v@, without checking any invariants.
138--
149--
@@ -145,6 +156,7 @@ unsafePatchMapWithMove = PatchMapWithMove
145instance (Ord k, Patch p) => PatchHet (PatchMapWithMove k p) where
156instance (Ord k, Patch p) => PatchHet (PatchMapWithMove k p) where
146 type PatchSource (PatchMapWithMove k p) = Map k (PatchSource p)
157 type PatchSource (PatchMapWithMove k p) = Map k (PatchSource p)
147 type PatchTarget (PatchMapWithMove k p) = Map k (PatchTarget p)
158 type PatchTarget (PatchMapWithMove k p) = Map k (PatchTarget p)
159+
148instance (Ord k, Patch p) => Patch (PatchMapWithMove k p) where
160instance (Ord k, Patch p) => Patch (PatchMapWithMove k p) where
149 -- TODO: return Nothing sometimes
161 -- TODO: return Nothing sometimes
150 -- Note: the strict application here is critical to ensuring that incremental
162 -- Note: the strict application here is critical to ensuring that incremental
@@ -188,7 +200,7 @@ patchThatSortsMapWith cmp m = PatchMapWithMove $ Map.fromList $ catMaybes $ zipW
188 reverseMapping = Map.fromList $ catMaybes $ zipWith f unsorted sorted
200 reverseMapping = Map.fromList $ catMaybes $ zipWith f unsorted sorted
189 g (to, _) (from, _) = if to == from then Nothing else
201 g (to, _) (from, _) = if to == from then Nothing else
190 let Just movingTo = Map.lookup from reverseMapping
202 let Just movingTo = Map.lookup from reverseMapping
191− in Just (to, NodeInfo (From_Move from mempty) $ Just movingTo)
203+ in Just (to, NodeInfo (From_Move from mempty) $ To_Move movingTo mempty)
192
204
193-- | Create a 'PatchMapWithMove' that, if applied to the first 'Map' provided,
205-- | Create a 'PatchMapWithMove' that, if applied to the first 'Map' provided,
194-- will produce a 'Map' with the same values as the second 'Map' but with the
206-- will produce a 'Map' with the same values as the second 'Map' but with the
@@ -215,25 +227,32 @@ patchThatChangesMap oldByIndex newByIndex = patch
215 then Map.delete v remainingValues
227 then Map.delete v remainingValues
216 else Map.insert v remainingKeys remainingValues
228 else Map.insert v remainingKeys remainingValues
217 case Map.lookup v remainingValues of
229 case Map.lookup v remainingValues of
218− Nothing -> return $ NodeInfo (From_Insert v) $ Just undefined -- There's no existing value we can take
230+ Nothing -> return $ NodeInfo (From_Insert v) $ To_Move undefined undefined -- There's no existing value we can take
219 Just fromKs ->
231 Just fromKs ->
220 if k `Set.member` fromKs
232 if k `Set.member` fromKs
221 then do
233 then do
222 putRemainingKeys $ Set.delete k fromKs
234 putRemainingKeys $ Set.delete k fromKs
223− return $ NodeInfo (From_Move k mempty) $ Just undefined -- There's an existing value, and it's here, so no patch necessary
235+ return $ NodeInfo (From_Move k mempty) $ To_Move undefined undefined -- There's an existing value, and it's here, so no patch necessary
224 else do
236 else do
225 (fromK, remainingKeys) <- return . fromJust $ Set.minView fromKs -- There's an existing value, but it's not here; move it here
237 (fromK, remainingKeys) <- return . fromJust $ Set.minView fromKs -- There's an existing value, but it's not here; move it here
226 putRemainingKeys remainingKeys
238 putRemainingKeys remainingKeys
227− return $ NodeInfo (From_Move fromK mempty) $ Just undefined
239+ return $ NodeInfo (From_Move fromK mempty) $ To_Move undefined undefined
228 Map.traverseWithKey f newByIndex
240 Map.traverseWithKey f newByIndex
229 unusedOldKeys = fold unusedValuesByValue
241 unusedOldKeys = fold unusedValuesByValue
230 pointlessMove k = \case
242 pointlessMove k = \case
231 From_Move k' _ | k == k' -> True
243 From_Move k' _ | k == k' -> True
232 _ -> False
244 _ -> False
233 keyWasMoved k = if k `Map.member` oldByIndex && not (k `Set.member` unusedOldKeys)
245 keyWasMoved k = if k `Map.member` oldByIndex && not (k `Set.member` unusedOldKeys)
234− then Just undefined
246+ then To_Move undefined undefined
235− else Nothing
247+ else To_NonMove
236− patch = unsafePatchMapWithMove $ Map.filterWithKey (\k -> not . pointlessMove k . _nodeInfo_from) $ Map.mergeWithKey (\k a _ -> Just $ nodeInfoSetTo (keyWasMoved k) a) (Map.mapWithKey $ \k -> nodeInfoSetTo $ keyWasMoved k) (Map.mapWithKey $ \k _ -> NodeInfo From_Delete $ keyWasMoved k) insertsAndMoves oldByIndex
248+ patch = unsafePatchMapWithMove $ Map.filterWithKey
249+ (\k -> not . pointlessMove k . _nodeInfo_from)
250+ $ Map.mergeWithKey
251+ (\k a _ -> Just $ nodeInfoSetTo (keyWasMoved k) a)
252+ (Map.mapWithKey $ \k -> nodeInfoSetTo $ keyWasMoved k)
253+ (Map.mapWithKey $ \k _ -> NodeInfo From_Delete $ keyWasMoved k)
254+ insertsAndMoves
255+ oldByIndex
237
256
238-- | Change the 'From' value of a 'NodeInfo'
257-- | Change the 'From' value of a 'NodeInfo'
239nodeInfoMapFrom
258nodeInfoMapFrom
@@ -248,15 +267,16 @@ nodeInfoMapMFrom f ni = fmap (\result -> ni { _nodeInfo_from = result }) $ f $ _
248
267
249-- | Set the 'To' field of a 'NodeInfo'
268-- | Set the 'To' field of a 'NodeInfo'
250nodeInfoSetTo
269nodeInfoSetTo
251− :: To k -> NodeInfo k v -> NodeInfo k v
270+ :: To k p -> NodeInfo k p -> NodeInfo k p
252nodeInfoSetTo to ni = ni { _nodeInfo_to = to }
271nodeInfoSetTo to ni = ni { _nodeInfo_to = to }
253
272
254−-- |Helper data structure used for composing patches using the monoid instance.
273+-- | Helper data structure used for composing patches using the monoid instance.
255−data Fixup k v
274+data Fixup k p
256 = Fixup_Delete
275 = Fixup_Delete
257− | Fixup_Update (These (From k v) (To k))
276+ | Fixup_Update (These (From k p) (To k p))
258
277
259−-- |Compose patches having the same effect as applying the patches in turn: @'applyAlways' (p <> q) == 'applyAlways' p . 'applyAlways' q@
278+-- | Compose patches having the same effect as applying the patches in turn:
279+-- @'applyAlways' (p <> q) == 'applyAlways' p . 'applyAlways' q@
260instance ( Ord k
280instance ( Ord k
261 , DecidablyEmpty p
281 , DecidablyEmpty p
262 , Patch p
282 , Patch p
@@ -264,18 +284,24 @@ instance ( Ord k
264 PatchMapWithMove ma <> PatchMapWithMove mb = PatchMapWithMove m
284 PatchMapWithMove ma <> PatchMapWithMove mb = PatchMapWithMove m
265 where
285 where
266 connections = Map.toList $ Map.intersectionWithKey (\_ a b -> (_nodeInfo_to a, _nodeInfo_from b)) ma mb
286 connections = Map.toList $ Map.intersectionWithKey (\_ a b -> (_nodeInfo_to a, _nodeInfo_from b)) ma mb
267− h :: (k, (Maybe k, From k p)) -> [(k, Fixup k p)]
287+ h :: (k, (To k p, From k p)) -> [(k, Fixup k p)]
268− h (_, (mToAfter, editBefore)) = case (mToAfter, editBefore) of
288+ h (_, (editAfter, editBefore)) = case (editAfter, editBefore) of
269− (Just toAfter, From_Move fromBefore p)
289+ (To_Move toAfter p1, From_Move fromBefore p0)
270− | fromBefore == toAfter && isNull p
290+ | fromBefore == toAfter && isNull p0
271 -> [(toAfter, Fixup_Delete)]
291 -> [(toAfter, Fixup_Delete)]
272 | otherwise
292 | otherwise
273− -> [ (toAfter, Fixup_Update (This editBefore))
293+ -> [ (toAfter, Fixup_Update (This $ From_Move fromBefore $ p1 <> p0))
274− , (fromBefore, Fixup_Update (That mToAfter))
294+ , (fromBefore, Fixup_Update (That $ To_Move toAfter $ p1 <> p0))
275 ]
295 ]
296+ (To_NonMove, From_Move fromBefore _) ->
276− (Nothing, From_Move fromBefore _) -> [(fromBefore, Fixup_Update (That mToAfter))] -- The item is destroyed in the second patch, so indicate that it is destroyed in the source map
297+ -- The item is destroyed in the second patch, so indicate that it is
298+ -- destroyed in the source map
299+ [(fromBefore, Fixup_Update (That editAfter))]
300+ (To_Move toAfter p, From_Insert val) ->
277− (Just toAfter, _) -> [(toAfter, Fixup_Update (This editBefore))]
301+ [(toAfter, Fixup_Update $ This $ From_Insert $ applyAlways p val)]
278− (Nothing, _) -> []
302+ (To_Move toAfter _, From_Delete) ->
303+ [(toAfter, Fixup_Update $ This From_Delete)]
304+ (To_NonMove, _) -> []
279 mergeFixups _ Fixup_Delete Fixup_Delete = Fixup_Delete
305 mergeFixups _ Fixup_Delete Fixup_Delete = Fixup_Delete
280 mergeFixups _ (Fixup_Update a) (Fixup_Update b)
306 mergeFixups _ (Fixup_Update a) (Fixup_Update b)
281 | This x <- a, That y <- b
307 | This x <- a, That y <- b
@@ -291,13 +317,7 @@ instance ( Ord k
291 applyFixup _ ni = \case
317 applyFixup _ ni = \case
292 Fixup_Delete -> Nothing
318 Fixup_Delete -> Nothing
293 Fixup_Update u -> Just $ NodeInfo
319 Fixup_Update u -> Just $ NodeInfo
294− { _nodeInfo_from = case _nodeInfo_from ni of
320+ { _nodeInfo_from = fromMaybe (_nodeInfo_from ni) $ getHere u
295− f@(From_Move _ p') -> case getHere u of -- The `from` fixup comes from the "old" patch
296− Nothing -> f -- If there's no `from` fixup, just use the "new" `from`
297− Just (From_Insert v) -> From_Insert $ applyAlways p' v
298− Just From_Delete -> From_Delete
299− Just (From_Move oldKey p) -> From_Move oldKey $ p' <> p
300− _ -> error "PatchMapWithMove: fixup for non-move From"
301 , _nodeInfo_to = fromMaybe (_nodeInfo_to ni) $ getThere u
321 , _nodeInfo_to = fromMaybe (_nodeInfo_to ni) $ getThere u
302 }
322 }
303 m = Map.differenceWithKey applyFixup (Map.unionWithKey combineNodeInfos ma mb) fixups
323 m = Map.differenceWithKey applyFixup (Map.unionWithKey combineNodeInfos ma mb) fixups
@@ -313,7 +333,8 @@ instance ( Ord k
313 That b -> Just b
333 That b -> Just b
314
334
315--TODO: Figure out how to implement this in terms of PatchDMapWithMove rather than duplicating it here
335--TODO: Figure out how to implement this in terms of PatchDMapWithMove rather than duplicating it here
316−-- |Compose patches having the same effect as applying the patches in turn: @'applyAlways' (p <> q) == 'applyAlways' p . 'applyAlways' q@
336+-- | Compose patches having the same effect as applying the patches in turn:
337+-- @'applyAlways' (p <> q) == 'applyAlways' p . 'applyAlways' q@
317instance ( Ord k
338instance ( Ord k
318 , Monoid p
339 , Monoid p
319 , DecidablyEmpty p
340 , DecidablyEmpty p