git.iko.soy/patch
on develop help sign in
Cleanup and avoid GHC bugs
44719daJohn Ericson
ChangeLog.md+4−2
compare with develop
unifiedsplit
@@ -3,8 +3,10 @@
3## Unreleased
3## Unreleased
4
4
5* Rewrite `PatchMapWithMove` in terms of `PatchMapWithPatchingMove`.
5* Rewrite `PatchMapWithMove` in terms of `PatchMapWithPatchingMove`.
6− Care is taken to make this as little of a breaking change as possible.
6+ Care is taken to make this not a breaking change.
7− In particular, `PatchMapWithMove` is a newtype of `PatchMapWithPatchingMove` as is the `NodeInfo` of `PatchMapWithPatchingMove`'s `NodeInfo`.
7+ In particular, `PatchMapWithMove` is a newtype of `PatchMapWithPatchingMove`, as is the `NodeInfo` and `From` of `PatchMapWithPatchingMove`'s versions of those.
8+ There are complete constructor and field patterns too, and everything is
9+ exported under the newtype as real constructors and fields would be.
8
10
9## 0.0.4.0
11## 0.0.4.0
10
12
src/Data/Patch/Class.hs+4−2
@@ -1,9 +1,11 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2+{-# LANGUAGE ScopedTypeVariables #-}
2{-# LANGUAGE TypeFamilies #-}
3{-# LANGUAGE TypeFamilies #-}
3-- | The interface for types which represent changes made to other types
4-- | The interface for types which represent changes made to other types
4module Data.Patch.Class where
5module Data.Patch.Class where
5
6
6import Data.Functor.Identity
7import Data.Functor.Identity
8+import Data.Kind (Type)
7import Data.Maybe
9import Data.Maybe
8#if !MIN_VERSION_base(4,11,0)
10#if !MIN_VERSION_base(4,11,0)
9import Data.Semigroup (Semigroup(..))
11import Data.Semigroup (Semigroup(..))
@@ -15,7 +17,7 @@ import Data.Proxy
15-- If an instance of 'Patch' is also an instance of 'Semigroup', it should obey
17-- If an instance of 'Patch' is also an instance of 'Semigroup', it should obey
16-- the law that @applyAlways (f <> g) == applyAlways f . applyAlways g@.
18-- the law that @applyAlways (f <> g) == applyAlways f . applyAlways g@.
17class Patch p where
19class Patch p where
18− type PatchTarget p :: *
20+ type PatchTarget p :: Type
19 -- | Apply the patch @p a@ to the value @a@. If no change is needed, return
21 -- | Apply the patch @p a@ to the value @a@. If no change is needed, return
20 -- 'Nothing'.
22 -- 'Nothing'.
21 apply :: p -> PatchTarget p -> Maybe (PatchTarget p)
23 apply :: p -> PatchTarget p -> Maybe (PatchTarget p)
@@ -30,7 +32,7 @@ instance Patch (Identity a) where
30 apply (Identity a) _ = Just a
32 apply (Identity a) _ = Just a
31
33
32-- | 'Proxy' can be used as a 'Patch' that does nothing.
34-- | 'Proxy' can be used as a 'Patch' that does nothing.
33−instance Patch (Proxy (a :: *)) where
35+instance forall (a :: Type). Patch (Proxy a) where
34 type PatchTarget (Proxy a) = a
36 type PatchTarget (Proxy a) = a
35 apply ~Proxy _ = Nothing
37 apply ~Proxy _ = Nothing
36
38
src/Data/Patch/MapWithMove.hs+128−58
@@ -8,6 +8,7 @@
8{-# LANGUAGE PatternGuards #-}
8{-# LANGUAGE PatternGuards #-}
9{-# LANGUAGE PatternSynonyms #-}
9{-# LANGUAGE PatternSynonyms #-}
10{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE ScopedTypeVariables #-}
11+{-# LANGUAGE StandaloneDeriving #-}
11{-# LANGUAGE TemplateHaskell #-}
12{-# LANGUAGE TemplateHaskell #-}
12{-# LANGUAGE TypeApplications #-}
13{-# LANGUAGE TypeApplications #-}
13{-# LANGUAGE TypeFamilies #-}
14{-# LANGUAGE TypeFamilies #-}
@@ -16,30 +17,59 @@
16-- | 'Patch'es on 'Map' that can insert, delete, and move values from one key to
17-- | 'Patch'es on 'Map' that can insert, delete, and move values from one key to
17-- another
18-- another
18module Data.Patch.MapWithMove
19module Data.Patch.MapWithMove
19− ( module Data.Patch.MapWithMove
20− , PatchMapWithMove
20+ ( PatchMapWithMove
21 ( PatchMapWithMove
21 ( PatchMapWithMove
22 , -- | Extract the representation of the 'PatchMapWithMove' as a map of
22 , -- | Extract the representation of the 'PatchMapWithMove' as a map of
23 -- 'NodeInfo'.
23 -- 'NodeInfo'.
24 unPatchMapWithMove
24 unPatchMapWithMove
25 , ..
25 , ..
26 )
26 )
27+ , patchMapWithMove
28+ , patchMapWithMoveInsertAll
29+ , insertMapKey
30+ , moveMapKey
31+ , swapMapKey
32+ , deleteMapKey
33+ , unsafePatchMapWithMove
34+ , patchMapWithMoveNewElements
35+ , patchMapWithMoveNewElementsMap
36+ , patchThatSortsMapWith
37+ , patchThatChangesAndSortsMapWith
38+ , patchThatChangesMap
39+
40+ -- * Node Info
27 , NodeInfo
41 , NodeInfo
28 ( NodeInfo
42 ( NodeInfo
29 , _nodeInfo_to
43 , _nodeInfo_to
30 , _nodeInfo_from
44 , _nodeInfo_from
31 , ..
45 , ..
32 )
46 )
33− -- TODO export these under the type consructor once GHC is fixed
47+ , bitraverseNodeInfo
48+ , nodeInfoMapFrom
49+ , nodeInfoMapMFrom
50+ , nodeInfoSetTo
51+
52+ -- * From
53+ , From
34− -- , From (From_Insert, From_Delete, From_Move)
54+ ( From_Insert
55+ , From_Delete
56+ , From_Move
57+ , ..
58+ )
59+ , bitraverseFrom
60+
61+ -- * To
62+ , To
35 ) where
63 ) where
36
64
37import Data.Coerce
65import Data.Coerce
66+import Data.Kind (Type)
38import Data.Patch.Class
67import Data.Patch.Class
39import Data.Patch.MapWithPatchingMove
68import Data.Patch.MapWithPatchingMove
40 ( PatchMapWithPatchingMove (..)
69 ( PatchMapWithPatchingMove (..)
41 )
70 )
42import qualified Data.Patch.MapWithPatchingMove as PM
71import qualified Data.Patch.MapWithPatchingMove as PM
72+import Data.Patch.MapWithPatchingMove (To) -- already a transparent synonym
43
73
44import Control.Lens hiding (from, to)
74import Control.Lens hiding (from, to)
45import Data.List
75import Data.List
@@ -54,7 +84,7 @@ import Data.Traversable (foldMapDefault)
54-- | Patch a Map with additions, deletions, and moves. Invariant: If key @k1@
84-- | Patch a Map with additions, deletions, and moves. Invariant: If key @k1@
55-- is coming from @From_Move k2@, then key @k2@ should be going to @Just k1@,
85-- is coming from @From_Move k2@, then key @k2@ should be going to @Just k1@,
56-- and vice versa. There should never be any unpaired From/To keys.
86-- and vice versa. There should never be any unpaired From/To keys.
57−newtype PatchMapWithMove k v = PatchMapWithMove'
87+newtype PatchMapWithMove k (v :: Type) = PatchMapWithMove'
58 { -- | Extract the underlying 'PatchMapWithPatchingMove k (Proxy v)'
88 { -- | Extract the underlying 'PatchMapWithPatchingMove k (Proxy v)'
59 unPatchMapWithMove' :: PatchMapWithPatchingMove k (Proxy v)
89 unPatchMapWithMove' :: PatchMapWithPatchingMove k (Proxy v)
60 }
90 }
@@ -66,10 +96,14 @@ newtype PatchMapWithMove k v = PatchMapWithMove'
66 , Monoid
96 , Monoid
67 )
97 )
68
98
99+pattern Coerce :: Coercible a b => a -> b
100+pattern Coerce x <- (coerce -> x)
101+ where Coerce x = coerce x
102+
69{-# COMPLETE PatchMapWithMove #-}
103{-# COMPLETE PatchMapWithMove #-}
70pattern PatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v
104pattern PatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v
71−pattern PatchMapWithMove { unPatchMapWithMove } <- PatchMapWithMove' (PatchMapWithPatchingMove (coerce -> unPatchMapWithMove))
105+unPatchMapWithMove :: PatchMapWithMove k v -> Map k (NodeInfo k v)
72− where PatchMapWithMove m = PatchMapWithMove' $ PatchMapWithPatchingMove $ coerce m
106+pattern PatchMapWithMove { unPatchMapWithMove } = PatchMapWithMove' (PatchMapWithPatchingMove (Coerce unPatchMapWithMove))
73
107
74_PatchMapWithMove
108_PatchMapWithMove
75 :: Iso
109 :: Iso
@@ -100,55 +134,6 @@ instance TraversableWithIndex k (PatchMapWithMove k) where
100 itraversed <.
134 itraversed <.
101 traverse
135 traverse
102
136
103−newtype NodeInfo k v = NodeInfo' { unNodeInfo' :: PM.NodeInfo k (Proxy v) }
104− deriving ( Show, Read, Eq, Ord
105− )
106−
107−{-# COMPLETE NodeInfo #-}
108−pattern NodeInfo :: To k -> From k v -> NodeInfo k v
109−pattern NodeInfo { _nodeInfo_to, _nodeInfo_from } =
110− NodeInfo' (PM.NodeInfo
111− { PM._nodeInfo_to = _nodeInfo_to
112− , PM._nodeInfo_from = _nodeInfo_from
113− })
114−
115−_NodeInfo
116− :: Iso
117− (NodeInfo k0 v0)
118− (NodeInfo k1 v1)
119− (PM.NodeInfo k0 (Proxy v0))
120− (PM.NodeInfo k1 (Proxy v1))
121−_NodeInfo = iso unNodeInfo' NodeInfo'
122−
123−instance Functor (NodeInfo k) where
124− fmap f = runIdentity . traverse (Identity . f)
125−
126−instance Foldable (NodeInfo k) where
127− foldMap = foldMapDefault
128−
129−instance Traversable (NodeInfo k) where
130− traverse = _NodeInfo . traverseNodeInfo
131− where
132− traverseNodeInfo
133− :: Traversal (PM.NodeInfo k (Proxy a)) (PM.NodeInfo k (Proxy b)) a b
134− traverseNodeInfo = PM.bitraverseNodeInfo pure (\ ~Proxy -> pure Proxy)
135−
136−type From k v = PM.From k (Proxy v)
137−
138−{-# COMPLETE From_Insert, From_Delete, From_Move #-}
139−
140−pattern From_Insert :: v -> From k v
141−pattern From_Insert v = PM.From_Insert v
142−
143−pattern From_Delete :: From k v
144−pattern From_Delete = PM.From_Delete
145−
146−pattern From_Move :: k -> From k v
147−pattern From_Move k = PM.From_Move k Proxy
148−
149−type To k = PM.To k
150−
151−
152-- | Create a 'PatchMapWithMove', validating it
137-- | Create a 'PatchMapWithMove', validating it
153patchMapWithMove :: Ord k => Map k (NodeInfo k v) -> Maybe (PatchMapWithMove k v)
138patchMapWithMove :: Ord k => Map k (NodeInfo k v) -> Maybe (PatchMapWithMove k v)
154patchMapWithMove = fmap coerce . PM.patchMapWithPatchingMove . coerce
139patchMapWithMove = fmap coerce . PM.patchMapWithPatchingMove . coerce
@@ -224,9 +209,62 @@ patchThatChangesMap :: (Ord k, Ord v) => Map k v -> Map k v -> PatchMapWithMove
224patchThatChangesMap oldByIndex newByIndex = PatchMapWithMove' $
209patchThatChangesMap oldByIndex newByIndex = PatchMapWithMove' $
225 PM.patchThatChangesMap oldByIndex newByIndex
210 PM.patchThatChangesMap oldByIndex newByIndex
226
211
212+--
213+-- NodeInfo
214+--
215+
216+-- | Holds the information about each key: where its new value should come from,
217+-- and where its old value should go to
218+newtype NodeInfo k (v :: Type) = NodeInfo' { unNodeInfo' :: PM.NodeInfo k (Proxy v) }
219+
220+deriving instance (Show k, Show p) => Show (NodeInfo k p)
221+deriving instance (Read k, Read p) => Read (NodeInfo k p)
222+deriving instance (Eq k, Eq p) => Eq (NodeInfo k p)
223+deriving instance (Ord k, Ord p) => Ord (NodeInfo k p)
224+
225+{-# COMPLETE NodeInfo #-}
226+pattern NodeInfo :: To k -> From k v -> NodeInfo k v
227+_nodeInfo_to :: NodeInfo k v -> To k
228+_nodeInfo_from :: NodeInfo k v -> From k v
229+pattern NodeInfo { _nodeInfo_to, _nodeInfo_from } =
230+ NodeInfo' (PM.NodeInfo
231+ { PM._nodeInfo_to = _nodeInfo_to
232+ , PM._nodeInfo_from = Coerce _nodeInfo_from
233+ })
234+
235+_NodeInfo
236+ :: Iso
237+ (NodeInfo k0 v0)
238+ (NodeInfo k1 v1)
239+ (PM.NodeInfo k0 (Proxy v0))
240+ (PM.NodeInfo k1 (Proxy v1))
241+_NodeInfo = iso unNodeInfo' NodeInfo'
242+
243+instance Functor (NodeInfo k) where
244+ fmap f = runIdentity . traverse (Identity . f)
245+
246+instance Foldable (NodeInfo k) where
247+ foldMap = foldMapDefault
248+
249+instance Traversable (NodeInfo k) where
250+ traverse = _NodeInfo . traverseNodeInfo
251+ where
252+ traverseNodeInfo
253+ :: Traversal (PM.NodeInfo k (Proxy a)) (PM.NodeInfo k (Proxy b)) a b
254+ traverseNodeInfo = PM.bitraverseNodeInfo pure (\ ~Proxy -> pure Proxy)
255+
256+bitraverseNodeInfo
257+ :: Applicative f
258+ => (k0 -> f k1)
259+ -> (v0 -> f v1)
260+ -> NodeInfo k0 v0 -> f (NodeInfo k1 v1)
261+bitraverseNodeInfo fk fv = fmap coerce
262+ . PM.bitraverseNodeInfo fk (\ ~Proxy -> pure Proxy) fv
263+ . coerce
264+
227-- | Change the 'From' value of a 'NodeInfo'
265-- | Change the 'From' value of a 'NodeInfo'
228nodeInfoMapFrom :: (From k v -> From k v) -> NodeInfo k v -> NodeInfo k v
266nodeInfoMapFrom :: (From k v -> From k v) -> NodeInfo k v -> NodeInfo k v
229−nodeInfoMapFrom = coerce . PM.nodeInfoMapFrom
267+nodeInfoMapFrom f = coerce . PM.nodeInfoMapFrom (unFrom' . f . From') . coerce
230
268
231-- | Change the 'From' value of a 'NodeInfo', using a 'Functor' (or
269-- | Change the 'From' value of a 'NodeInfo', using a 'Functor' (or
232-- 'Applicative', 'Monad', etc.) action to get the new value
270-- 'Applicative', 'Monad', etc.) action to get the new value
@@ -234,11 +272,43 @@ nodeInfoMapMFrom
234 :: Functor f
272 :: Functor f
235 => (From k v -> f (From k v))
273 => (From k v -> f (From k v))
236 -> NodeInfo k v -> f (NodeInfo k v)
274 -> NodeInfo k v -> f (NodeInfo k v)
237−nodeInfoMapMFrom f = fmap coerce . PM.nodeInfoMapMFrom f . coerce
275+nodeInfoMapMFrom f = fmap coerce
276+ . PM.nodeInfoMapMFrom (fmap unFrom' . f . From')
277+ . coerce
238
278
239-- | Set the 'To' field of a 'NodeInfo'
279-- | Set the 'To' field of a 'NodeInfo'
240nodeInfoSetTo :: To k -> NodeInfo k v -> NodeInfo k v
280nodeInfoSetTo :: To k -> NodeInfo k v -> NodeInfo k v
241nodeInfoSetTo = coerce . PM.nodeInfoSetTo
281nodeInfoSetTo = coerce . PM.nodeInfoSetTo
242
282
283+--
284+-- From
285+--
286+
287+-- | Describe how a key's new value should be produced
288+newtype From k (v :: Type) = From' { unFrom' :: PM.From k (Proxy v) }
289+
290+{-# COMPLETE From_Insert, From_Delete, From_Move #-}
291+
292+-- | Insert the given value here
293+pattern From_Insert :: v -> From k v
294+pattern From_Insert v = From' (PM.From_Insert v)
295+
296+-- | Delete the existing value, if any, from here
297+pattern From_Delete :: From k v
298+pattern From_Delete = From' (PM.From_Delete)
299+
300+-- | Move the value here from the given key
301+pattern From_Move :: k -> From k v
302+pattern From_Move k = From' (PM.From_Move k Proxy)
303+
304+bitraverseFrom
305+ :: Applicative f
306+ => (k0 -> f k1)
307+ -> (v0 -> f v1)
308+ -> From k0 v0 -> f (From k1 v1)
309+bitraverseFrom fk fv = fmap coerce
310+ . PM.bitraverseFrom fk (\ ~Proxy -> pure Proxy) fv
311+ . coerce
312+
243makeWrapped ''PatchMapWithMove
313makeWrapped ''PatchMapWithMove
244makeWrapped ''NodeInfo
314makeWrapped ''NodeInfo
src/Data/Patch/MapWithPatchingMove.hs+99−52
@@ -13,7 +13,38 @@
13
13
14-- | 'Patch'es on 'Map' that can insert, delete, and move values from one key to
14-- | 'Patch'es on 'Map' that can insert, delete, and move values from one key to
15-- another
15-- another
16−module Data.Patch.MapWithPatchingMove where
16+module Data.Patch.MapWithPatchingMove
17+ ( PatchMapWithPatchingMove (..)
18+ , patchMapWithPatchingMove
19+ , patchMapWithPatchingMoveInsertAll
20+ , insertMapKey
21+ , moveMapKey
22+ , swapMapKey
23+ , deleteMapKey
24+ , unsafePatchMapWithPatchingMove
25+ , patchMapWithPatchingMoveNewElements
26+ , patchMapWithPatchingMoveNewElementsMap
27+ , patchThatSortsMapWith
28+ , patchThatChangesAndSortsMapWith
29+ , patchThatChangesMap
30+
31+ -- * Node Info
32+ , NodeInfo (..)
33+ , bitraverseNodeInfo
34+ , nodeInfoMapFrom
35+ , nodeInfoMapMFrom
36+ , nodeInfoSetTo
37+
38+ -- * From
39+ , From(..)
40+ , bitraverseFrom
41+
42+ -- * To
43+ , To
44+
45+ -- TODO internals module
46+ , Fixup (..)
47+ ) where
17
48
18import Data.Patch.Class
49import Data.Patch.Class
19
50
@@ -55,57 +86,6 @@ deriving instance ( Ord k
55 , Patch p
86 , Patch p
56 ) => DecidablyEmpty (PatchMapWithPatchingMove k p)
87 ) => DecidablyEmpty (PatchMapWithPatchingMove k p)
57
88
58−-- | Holds the information about each key: where its new value should come from,
59−-- and where its old value should go to
60−data NodeInfo k p = NodeInfo
61− { _nodeInfo_from :: !(From k p)
62− -- ^ Where do we get the new value for this key?
63− , _nodeInfo_to :: !(To k)
64− -- ^ If the old value is being kept (i.e. moved rather than deleted or
65− -- replaced), where is it going?
66− }
67−deriving instance (Show k, Show p, Show (PatchTarget p)) => Show (NodeInfo k p)
68−deriving instance (Read k, Read p, Read (PatchTarget p)) => Read (NodeInfo k p)
69−deriving instance (Eq k, Eq p, Eq (PatchTarget p)) => Eq (NodeInfo k p)
70−deriving instance (Ord k, Ord p, Ord (PatchTarget p)) => Ord (NodeInfo k p)
71−
72−bitraverseNodeInfo
73− :: Applicative f
74− => (k0 -> f k1)
75− -> (p0 -> f p1)
76− -> (PatchTarget p0 -> f (PatchTarget p1))
77− -> NodeInfo k0 p0 -> f (NodeInfo k1 p1)
78−bitraverseNodeInfo fk fp fpt (NodeInfo from to) = NodeInfo
79− <$> bitraverseFrom fk fp fpt from
80− <*> traverse fk to
81−
82−-- | Describe how a key's new value should be produced
83−data From k p
84− = From_Insert (PatchTarget p) -- ^ Insert the given value here
85− | From_Delete -- ^ Delete the existing value, if any, from here
86− | From_Move !k !p -- ^ Move the value here from the given key, and apply the given patch
87−
88−bitraverseFrom
89− :: Applicative f
90− => (k0 -> f k1)
91− -> (p0 -> f p1)
92− -> (PatchTarget p0 -> f (PatchTarget p1))
93− -> From k0 p0 -> f (From k1 p1)
94−bitraverseFrom fk fp fpt = \case
95− From_Insert pt -> From_Insert <$> fpt pt
96− From_Delete -> pure From_Delete
97− From_Move k p -> From_Move <$> fk k <*> fp p
98−
99−deriving instance (Show k, Show p, Show (PatchTarget p)) => Show (From k p)
100−deriving instance (Read k, Read p, Read (PatchTarget p)) => Read (From k p)
101−deriving instance (Eq k, Eq p, Eq (PatchTarget p)) => Eq (From k p)
102−deriving instance (Ord k, Ord p, Ord (PatchTarget p)) => Ord (From k p)
103−
104−-- | Describe where a key's old value will go. If this is 'Just', that means
105−-- the key's old value will be moved to the given other key; if it is 'Nothing',
106−-- that means it will be deleted.
107−type To = Maybe
108−
109-- | Create a 'PatchMapWithPatchingMove', validating it
89-- | Create a 'PatchMapWithPatchingMove', validating it
110patchMapWithPatchingMove
90patchMapWithPatchingMove
111 :: Ord k => Map k (NodeInfo k p) -> Maybe (PatchMapWithPatchingMove k p)
91 :: Ord k => Map k (NodeInfo k p) -> Maybe (PatchMapWithPatchingMove k p)
@@ -283,6 +263,34 @@ patchThatChangesMap oldByIndex newByIndex = patch
283 else Nothing
263 else Nothing
284 patch = unsafePatchMapWithPatchingMove $ 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
264 patch = unsafePatchMapWithPatchingMove $ 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
285
265
266+--
267+-- NodeInfo
268+--
269+
270+-- | Holds the information about each key: where its new value should come from,
271+-- and where its old value should go to
272+data NodeInfo k p = NodeInfo
273+ { _nodeInfo_from :: !(From k p)
274+ -- ^ Where do we get the new value for this key?
275+ , _nodeInfo_to :: !(To k)
276+ -- ^ If the old value is being kept (i.e. moved rather than deleted or
277+ -- replaced), where is it going?
278+ }
279+deriving instance (Show k, Show p, Show (PatchTarget p)) => Show (NodeInfo k p)
280+deriving instance (Read k, Read p, Read (PatchTarget p)) => Read (NodeInfo k p)
281+deriving instance (Eq k, Eq p, Eq (PatchTarget p)) => Eq (NodeInfo k p)
282+deriving instance (Ord k, Ord p, Ord (PatchTarget p)) => Ord (NodeInfo k p)
283+
284+bitraverseNodeInfo
285+ :: Applicative f
286+ => (k0 -> f k1)
287+ -> (p0 -> f p1)
288+ -> (PatchTarget p0 -> f (PatchTarget p1))
289+ -> NodeInfo k0 p0 -> f (NodeInfo k1 p1)
290+bitraverseNodeInfo fk fp fpt (NodeInfo from to) = NodeInfo
291+ <$> bitraverseFrom fk fp fpt from
292+ <*> traverse fk to
293+
286-- | Change the 'From' value of a 'NodeInfo'
294-- | Change the 'From' value of a 'NodeInfo'
287nodeInfoMapFrom
295nodeInfoMapFrom
288 :: (From k v -> From k v) -> NodeInfo k v -> NodeInfo k v
296 :: (From k v -> From k v) -> NodeInfo k v -> NodeInfo k v
@@ -299,6 +307,45 @@ nodeInfoSetTo
299 :: To k -> NodeInfo k v -> NodeInfo k v
307 :: To k -> NodeInfo k v -> NodeInfo k v
300nodeInfoSetTo to ni = ni { _nodeInfo_to = to }
308nodeInfoSetTo to ni = ni { _nodeInfo_to = to }
301
309
310+--
311+-- From
312+--
313+
314+-- | Describe how a key's new value should be produced
315+data From k p
316+ = From_Insert (PatchTarget p) -- ^ Insert the given value here
317+ | From_Delete -- ^ Delete the existing value, if any, from here
318+ | From_Move !k !p -- ^ Move the value here from the given key, and apply the given patch
319+
320+deriving instance (Show k, Show p, Show (PatchTarget p)) => Show (From k p)
321+deriving instance (Read k, Read p, Read (PatchTarget p)) => Read (From k p)
322+deriving instance (Eq k, Eq p, Eq (PatchTarget p)) => Eq (From k p)
323+deriving instance (Ord k, Ord p, Ord (PatchTarget p)) => Ord (From k p)
324+
325+bitraverseFrom
326+ :: Applicative f
327+ => (k0 -> f k1)
328+ -> (p0 -> f p1)
329+ -> (PatchTarget p0 -> f (PatchTarget p1))
330+ -> From k0 p0 -> f (From k1 p1)
331+bitraverseFrom fk fp fpt = \case
332+ From_Insert pt -> From_Insert <$> fpt pt
333+ From_Delete -> pure From_Delete
334+ From_Move k p -> From_Move <$> fk k <*> fp p
335+
336+--
337+-- To
338+--
339+
340+-- | Describe where a key's old value will go. If this is 'Just', that means
341+-- the key's old value will be moved to the given other key; if it is 'Nothing',
342+-- that means it will be deleted.
343+type To = Maybe
344+
345+--
346+-- Fixup
347+--
348+
302-- | Helper data structure used for composing patches using the monoid instance.
349-- | Helper data structure used for composing patches using the monoid instance.
303data Fixup k v
350data Fixup k v
304 = Fixup_Delete
351 = Fixup_Delete