git.iko.soy/patch
on develop help sign in
Cleanup and avoid GHC bugs

- Do explicit export lists. This is a chore now, but makes managing Compatibility easier later. - Make `MapWithMove`'s `From` a proper newtype. This improves the compatibility and type error situation. - Work around GHC export list bug: the explicit export lists without big reexports this this for us, in fact.

commit44719da3b8397d0bdb4103100a5ef5e0b9c45c5d authorJohn Ericson <John.Ericson@Obsidian.Systems> dateThu 22 Apr 2021, 14:32 (5 years ago) parent220acfc
4 files changed+235−114
compare with develop
unifiedsplit
ChangeLog.md+4−2 src/Data/Patch/Class.hs+4−2 src/Data/Patch/MapWithMove.hs+128−58 src/Data/Patch/MapWithPatchingMove.hs+99−52
ChangeLog.md+4−2
@@ -3,8 +3,10 @@
33## Unreleased
44
55* Rewrite `PatchMapWithMove` in terms of `PatchMapWithPatchingMove`.
6− Care is taken to make this as little of a breaking change as possible.
7− In particular, `PatchMapWithMove` is a newtype of `PatchMapWithPatchingMove` as is the `NodeInfo` of `PatchMapWithPatchingMove`'s `NodeInfo`.
6+ Care is taken to make this not a breaking change.
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.
810
911## 0.0.4.0
1012
src/Data/Patch/Class.hs+4−2
@@ -1,9 +1,11 @@
11{-# LANGUAGE CPP #-}
2+{-# LANGUAGE ScopedTypeVariables #-}
23{-# LANGUAGE TypeFamilies #-}
34-- | The interface for types which represent changes made to other types
45module Data.Patch.Class where
56
67import Data.Functor.Identity
8+import Data.Kind (Type)
79import Data.Maybe
810#if !MIN_VERSION_base(4,11,0)
911import Data.Semigroup (Semigroup(..))
@@ -15,7 +17,7 @@ import Data.Proxy
1517-- If an instance of 'Patch' is also an instance of 'Semigroup', it should obey
1618-- the law that @applyAlways (f <> g) == applyAlways f . applyAlways g@.
1719class Patch p where
18− type PatchTarget p :: *
20+ type PatchTarget p :: Type
1921 -- | Apply the patch @p a@ to the value @a@. If no change is needed, return
2022 -- 'Nothing'.
2123 apply :: p -> PatchTarget p -> Maybe (PatchTarget p)
@@ -30,7 +32,7 @@ instance Patch (Identity a) where
3032 apply (Identity a) _ = Just a
3133
3234-- | '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
3436 type PatchTarget (Proxy a) = a
3537 apply ~Proxy _ = Nothing
3638
src/Data/Patch/MapWithMove.hs+128−58
@@ -8,6 +8,7 @@
88{-# LANGUAGE PatternGuards #-}
99{-# LANGUAGE PatternSynonyms #-}
1010{-# LANGUAGE ScopedTypeVariables #-}
11+{-# LANGUAGE StandaloneDeriving #-}
1112{-# LANGUAGE TemplateHaskell #-}
1213{-# LANGUAGE TypeApplications #-}
1314{-# LANGUAGE TypeFamilies #-}
@@ -16,30 +17,59 @@
1617-- | 'Patch'es on 'Map' that can insert, delete, and move values from one key to
1718-- another
1819module Data.Patch.MapWithMove
19− ( module Data.Patch.MapWithMove
20− , PatchMapWithMove
20+ ( PatchMapWithMove
2121 ( PatchMapWithMove
2222 , -- | Extract the representation of the 'PatchMapWithMove' as a map of
2323 -- 'NodeInfo'.
2424 unPatchMapWithMove
2525 , ..
2626 )
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
2741 , NodeInfo
2842 ( NodeInfo
2943 , _nodeInfo_to
3044 , _nodeInfo_from
3145 , ..
3246 )
33− -- TODO export these under the type consructor once GHC is fixed
34− -- , From (From_Insert, From_Delete, From_Move)
47+ , bitraverseNodeInfo
48+ , nodeInfoMapFrom
49+ , nodeInfoMapMFrom
50+ , nodeInfoSetTo
51+
52+ -- * From
53+ , From
54+ ( From_Insert
55+ , From_Delete
56+ , From_Move
57+ , ..
58+ )
59+ , bitraverseFrom
60+
61+ -- * To
62+ , To
3563 ) where
3664
3765import Data.Coerce
66+import Data.Kind (Type)
3867import Data.Patch.Class
3968import Data.Patch.MapWithPatchingMove
4069 ( PatchMapWithPatchingMove (..)
4170 )
4271import qualified Data.Patch.MapWithPatchingMove as PM
72+import Data.Patch.MapWithPatchingMove (To) -- already a transparent synonym
4373
4474import Control.Lens hiding (from, to)
4575import Data.List
@@ -54,7 +84,7 @@ import Data.Traversable (foldMapDefault)
5484-- | Patch a Map with additions, deletions, and moves. Invariant: If key @k1@
5585-- is coming from @From_Move k2@, then key @k2@ should be going to @Just k1@,
5686-- 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'
5888 { -- | Extract the underlying 'PatchMapWithPatchingMove k (Proxy v)'
5989 unPatchMapWithMove' :: PatchMapWithPatchingMove k (Proxy v)
6090 }
@@ -66,10 +96,14 @@ newtype PatchMapWithMove k v = PatchMapWithMove'
6696 , Monoid
6797 )
6898
99+pattern Coerce :: Coercible a b => a -> b
100+pattern Coerce x <- (coerce -> x)
101+ where Coerce x = coerce x
102+
69103{-# COMPLETE PatchMapWithMove #-}
70104pattern PatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v
71−pattern PatchMapWithMove { unPatchMapWithMove } <- PatchMapWithMove' (PatchMapWithPatchingMove (coerce -> unPatchMapWithMove))
72− where PatchMapWithMove m = PatchMapWithMove' $ PatchMapWithPatchingMove $ coerce m
105+unPatchMapWithMove :: PatchMapWithMove k v -> Map k (NodeInfo k v)
106+pattern PatchMapWithMove { unPatchMapWithMove } = PatchMapWithMove' (PatchMapWithPatchingMove (Coerce unPatchMapWithMove))
73107
74108_PatchMapWithMove
75109 :: Iso
@@ -100,55 +134,6 @@ instance TraversableWithIndex k (PatchMapWithMove k) where
100134 itraversed <.
101135 traverse
102136
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−
152137-- | Create a 'PatchMapWithMove', validating it
153138patchMapWithMove :: Ord k => Map k (NodeInfo k v) -> Maybe (PatchMapWithMove k v)
154139patchMapWithMove = fmap coerce . PM.patchMapWithPatchingMove . coerce
@@ -224,9 +209,62 @@ patchThatChangesMap :: (Ord k, Ord v) => Map k v -> Map k v -> PatchMapWithMove
224209patchThatChangesMap oldByIndex newByIndex = PatchMapWithMove' $
225210 PM.patchThatChangesMap oldByIndex newByIndex
226211
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+
227265-- | Change the 'From' value of a 'NodeInfo'
228266nodeInfoMapFrom :: (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
230268
231269-- | Change the 'From' value of a 'NodeInfo', using a 'Functor' (or
232270-- 'Applicative', 'Monad', etc.) action to get the new value
@@ -234,11 +272,43 @@ nodeInfoMapMFrom
234272 :: Functor f
235273 => (From k v -> f (From k v))
236274 -> 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
238278
239279-- | Set the 'To' field of a 'NodeInfo'
240280nodeInfoSetTo :: To k -> NodeInfo k v -> NodeInfo k v
241281nodeInfoSetTo = coerce . PM.nodeInfoSetTo
242282
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+
243313makeWrapped ''PatchMapWithMove
244314makeWrapped ''NodeInfo
src/Data/Patch/MapWithPatchingMove.hs+99−52
@@ -13,7 +13,38 @@
1313
1414-- | 'Patch'es on 'Map' that can insert, delete, and move values from one key to
1515-- 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
1748
1849import Data.Patch.Class
1950
@@ -55,57 +86,6 @@ deriving instance ( Ord k
5586 , Patch p
5687 ) => DecidablyEmpty (PatchMapWithPatchingMove k p)
5788
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−
10989-- | Create a 'PatchMapWithPatchingMove', validating it
11090patchMapWithPatchingMove
11191 :: Ord k => Map k (NodeInfo k p) -> Maybe (PatchMapWithPatchingMove k p)
@@ -283,6 +263,34 @@ patchThatChangesMap oldByIndex newByIndex = patch
283263 else Nothing
284264 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
285265
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+
286294-- | Change the 'From' value of a 'NodeInfo'
287295nodeInfoMapFrom
288296 :: (From k v -> From k v) -> NodeInfo k v -> NodeInfo k v
@@ -299,6 +307,45 @@ nodeInfoSetTo
299307 :: To k -> NodeInfo k v -> NodeInfo k v
300308nodeInfoSetTo to ni = ni { _nodeInfo_to = to }
301309
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+
302349-- | Helper data structure used for composing patches using the monoid instance.
303350data Fixup k v
304351 = Fixup_Delete