@@ -8,65 +8,28 @@
8{-# LANGUAGE PatternGuards #-}
8{-# LANGUAGE PatternGuards #-}
9{-# LANGUAGE PatternSynonyms #-}
9{-# LANGUAGE PatternSynonyms #-}
10{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE ScopedTypeVariables #-}
11−{-# LANGUAGE StandaloneDeriving #-}
12{-# LANGUAGE TemplateHaskell #-}
11{-# LANGUAGE TemplateHaskell #-}
13{-# LANGUAGE TypeApplications #-}
12{-# LANGUAGE TypeApplications #-}
14{-# LANGUAGE TypeFamilies #-}
13{-# LANGUAGE TypeFamilies #-}
15−{-# LANGUAGE ViewPatterns #-}
17-- | 'Patch'es on 'Map' that can insert, delete, and move values from one key to
15-- | 'Patch'es on 'Map' that can insert, delete, and move values from one key to
19module Data.Patch.MapWithMove
17module Data.Patch.MapWithMove
20− ( PatchMapWithMove
18+ ( module Data.Patch.MapWithMove
21− ( PatchMapWithMove
19+ , PatchMapWithMove (PatchMapWithMove)
26− , patchMapWithMoveInsertAll
31− , unsafePatchMapWithMove
32− , patchMapWithMoveNewElements
33− , patchMapWithMoveNewElementsMap
34− , patchThatSortsMapWith
35− , patchThatChangesAndSortsMapWith
36− , patchThatChangesMap
39 , NodeInfo
20 , NodeInfo
40− ( NodeInfo
21+ , pattern PM.NodeInfo
41− , _nodeInfo_to
22+ , PM._nodeInfo_to
42− , _nodeInfo_from
23+ , PM._nodeInfo_from
64−import Data.Kind (Type)
65import Data.Patch.Class
26import Data.Patch.Class
66−import Data.Patch.MapWithPatchingMove (PatchMapWithPatchingMove(..), To)
27+import Data.Patch.MapWithPatchingMove
28+ ( PatchMapWithPatchingMove (..)
67−import qualified Data.Patch.MapWithPatchingMove as PM -- already a transparent synonym
30+import qualified Data.Patch.MapWithPatchingMove as PM
69−import Control.Lens
32+import Control.Lens hiding (from, to)
70import Data.List
33import Data.List
71import Data.Map (Map)
34import Data.Map (Map)
72import qualified Data.Map as Map
35import qualified Data.Map as Map
@@ -79,40 +42,21 @@ import Data.Traversable (foldMapDefault)
79-- | Patch a Map with additions, deletions, and moves. Invariant: If key @k1@
42-- | Patch a Map with additions, deletions, and moves. Invariant: If key @k1@
80-- is coming from @From_Move k2@, then key @k2@ should be going to @Just k1@,
43-- is coming from @From_Move k2@, then key @k2@ should be going to @Just k1@,
81-- and vice versa. There should never be any unpaired From/To keys.
44-- and vice versa. There should never be any unpaired From/To keys.
82−newtype PatchMapWithMove k (v :: Type) = PatchMapWithMove'
45+newtype PatchMapWithMove k v = PatchMapWithMove'
83 { -- | Extract the underlying 'PatchMapWithPatchingMove k (Proxy v)'
46 { -- | Extract the underlying 'PatchMapWithPatchingMove k (Proxy v)'
84 unPatchMapWithMove' :: PatchMapWithPatchingMove k (Proxy v)
47 unPatchMapWithMove' :: PatchMapWithPatchingMove k (Proxy v)
86 deriving ( Show, Read, Eq, Ord
49 deriving ( Show, Read, Eq, Ord
87−-- Haddock cannot handle documentation here before GHC 8.6
89−#if __GLASGOW_HASKELL__ >= 806
90− -- | Compose patches having the same effect as applying the
91− -- patches in turn: @'applyAlways' (p <> q) == 'applyAlways' p .
94− Semigroup
50+ , Semigroup, Monoid
98−pattern Coerce :: Coercible a b => a -> b
99−pattern Coerce x <- (coerce -> x)
100− where Coerce x = coerce x
102{-# COMPLETE PatchMapWithMove #-}
53{-# COMPLETE PatchMapWithMove #-}
103pattern PatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v
54pattern PatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v
55+pattern PatchMapWithMove m = PatchMapWithMove' (PatchMapWithPatchingMove m)
104−-- | Extract the representation of the 'PatchMapWithMove' as a map of
57+-- | Extract the internal representation of the 'PatchMapWithMove'
106−unPatchMapWithMove :: PatchMapWithMove k v -> Map k (NodeInfo k v)
58+unPatchMapWithMove :: PatchMapWithMove k v -> Map k (PM.NodeInfo k (Proxy v))
107−pattern PatchMapWithMove { unPatchMapWithMove } = PatchMapWithMove' (PatchMapWithPatchingMove (Coerce unPatchMapWithMove))
59+unPatchMapWithMove = unPatchMapWithPatchingMove . unPatchMapWithMove'
111− (PatchMapWithMove k0 v0)
112− (PatchMapWithMove k1 v1)
113− (Map k0 (NodeInfo k0 v0))
114− (Map k1 (NodeInfo k1 v1))
115−_PatchMapWithMove = iso unPatchMapWithMove PatchMapWithMove
117instance Functor (PatchMapWithMove k) where
61instance Functor (PatchMapWithMove k) where
118 fmap f = runIdentity . traverse (Identity . f)
62 fmap f = runIdentity . traverse (Identity . f)
@@ -122,22 +66,45 @@ instance Foldable (PatchMapWithMove k) where
123instance Traversable (PatchMapWithMove k) where
67instance Traversable (PatchMapWithMove k) where
124 traverse =
68 traverse =
125− _PatchMapWithMove .
69+ _Wrapping PatchMapWithMove' .
70+ _Wrapping PatchMapWithPatchingMove .
126 traverse .
71 traverse .
127− traverse
72+ traverseNodeInfo
129instance FunctorWithIndex k (PatchMapWithMove k)
74instance FunctorWithIndex k (PatchMapWithMove k)
130instance FoldableWithIndex k (PatchMapWithMove k)
75instance FoldableWithIndex k (PatchMapWithMove k)
131instance TraversableWithIndex k (PatchMapWithMove k) where
76instance TraversableWithIndex k (PatchMapWithMove k) where
132 itraverse = itraversed . Indexed
77 itraverse = itraversed . Indexed
133 itraversed =
78 itraversed =
134− _PatchMapWithMove .>
79+ _Wrapping PatchMapWithMove' .>
80+ _Wrapping PatchMapWithPatchingMove .>
135 itraversed <.
81 itraversed <.
136− traverse
82+ traverseNodeInfo
84+type NodeInfo k v = PM.NodeInfo k (Proxy v)
86+type From k v = PM.From k (Proxy v)
88+{-# COMPLETE From_Insert, From_Delete, From_Move #-}
90+pattern From_Insert :: v -> From k v
91+pattern From_Insert v = PM.From_Insert v
93+pattern From_Delete :: From k v
94+pattern From_Delete = PM.From_Delete
96+pattern From_Move :: k -> From k v
97+pattern From_Move k = PM.From_Move k Proxy
102+ :: Traversal (NodeInfo k a) (NodeInfo k b) a b
103+traverseNodeInfo = PM.bitraverseNodeInfo pure (\(~Proxy) -> pure Proxy)
138-- | Create a 'PatchMapWithMove', validating it
105-- | Create a 'PatchMapWithMove', validating it
139patchMapWithMove :: Ord k => Map k (NodeInfo k v) -> Maybe (PatchMapWithMove k v)
106patchMapWithMove :: Ord k => Map k (NodeInfo k v) -> Maybe (PatchMapWithMove k v)
140−patchMapWithMove = fmap PatchMapWithMove' . PM.patchMapWithPatchingMove . coerce
107+patchMapWithMove = fmap PatchMapWithMove' . PM.patchMapWithPatchingMove
142-- | Create a 'PatchMapWithMove' that inserts everything in the given 'Map'
109-- | Create a 'PatchMapWithMove' that inserts everything in the given 'Map'
143patchMapWithMoveInsertAll :: Map k v -> PatchMapWithMove k v
110patchMapWithMoveInsertAll :: Map k v -> PatchMapWithMove k v
@@ -160,8 +127,8 @@ moveMapKey src dst = PatchMapWithMove' $ PM.moveMapKey src dst
161-- let aMay = Map.lookup a map
128-- let aMay = Map.lookup a map
162-- bMay = Map.lookup b map
129-- bMay = Map.lookup b map
163−-- in maybe id (Map.insert a) (bMay <> aMay)
130+-- in maybe id (Map.insert a) (bMay `mplus` aMay)
164−-- . maybe id (Map.insert b) (aMay <> bMay)
131+-- . maybe id (Map.insert b) (aMay `mplus` bMay)
165-- . Map.delete a . Map.delete b $ map
132-- . Map.delete a . Map.delete b $ map
167swapMapKey :: Ord k => k -> k -> PatchMapWithMove k v
134swapMapKey :: Ord k => k -> k -> PatchMapWithMove k v
@@ -175,12 +142,12 @@ deleteMapKey = PatchMapWithMove' . PM.deleteMapKey
176-- __Warning:__ when using this function, you must ensure that the invariants of 'PatchMapWithMove' are preserved; they will not be checked.
143-- __Warning:__ when using this function, you must ensure that the invariants of 'PatchMapWithMove' are preserved; they will not be checked.
177unsafePatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v
144unsafePatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v
178−unsafePatchMapWithMove = coerce PM.unsafePatchMapWithPatchingMove
145+unsafePatchMapWithMove = PatchMapWithMove' . PM.unsafePatchMapWithPatchingMove
180-- | Apply the insertions, deletions, and moves to a given 'Map'
147-- | Apply the insertions, deletions, and moves to a given 'Map'
181instance Ord k => Patch (PatchMapWithMove k v) where
148instance Ord k => Patch (PatchMapWithMove k v) where
182 type PatchTarget (PatchMapWithMove k v) = Map k v
149 type PatchTarget (PatchMapWithMove k v) = Map k v
183− apply (PatchMapWithMove' p) = apply p
150+ apply (PatchMapWithMove' p) old = apply p old
185-- | Returns all the new elements that will be added to the 'Map'.
152-- | Returns all the new elements that will be added to the 'Map'.
186patchMapWithMoveNewElements :: PatchMapWithMove k v -> [v]
153patchMapWithMoveNewElements :: PatchMapWithMove k v -> [v]
@@ -199,7 +166,7 @@ patchThatSortsMapWith cmp = PatchMapWithMove' . PM.patchThatSortsMapWith cmp
199-- | Create a 'PatchMapWithMove' that, if applied to the first 'Map' provided,
166-- | Create a 'PatchMapWithMove' that, if applied to the first 'Map' provided,
200-- will produce a 'Map' with the same values as the second 'Map' but with the
167-- will produce a 'Map' with the same values as the second 'Map' but with the
201-- values sorted with the given ordering function.
168-- values sorted with the given ordering function.
202−patchThatChangesAndSortsMapWith :: (Ord k, Ord v) => (v -> v -> Ordering) -> Map k v -> Map k v -> PatchMapWithMove k v
169+patchThatChangesAndSortsMapWith :: forall k v. (Ord k, Ord v) => (v -> v -> Ordering) -> Map k v -> Map k v -> PatchMapWithMove k v
203patchThatChangesAndSortsMapWith cmp oldByIndex newByIndexUnsorted = patchThatChangesMap oldByIndex newByIndex
170patchThatChangesAndSortsMapWith cmp oldByIndex newByIndexUnsorted = patchThatChangesMap oldByIndex newByIndex
204 where newList = Map.toList newByIndexUnsorted
171 where newList = Map.toList newByIndexUnsorted
205 newByIndex = Map.fromList $ zip (fst <$> newList) $ sortBy cmp $ snd <$> newList
172 newByIndex = Map.fromList $ zip (fst <$> newList) $ sortBy cmp $ snd <$> newList
@@ -210,58 +177,9 @@ patchThatChangesMap :: (Ord k, Ord v) => Map k v -> Map k v -> PatchMapWithMove
210patchThatChangesMap oldByIndex newByIndex = PatchMapWithMove' $
177patchThatChangesMap oldByIndex newByIndex = PatchMapWithMove' $
211 PM.patchThatChangesMap oldByIndex newByIndex
178 PM.patchThatChangesMap oldByIndex newByIndex
217−-- | Holds the information about each key: where its new value should come from,
218−-- and where its old value should go to
219−newtype NodeInfo k (v :: Type) = NodeInfo' { unNodeInfo' :: PM.NodeInfo k (Proxy v) }
221−deriving instance (Show k, Show p) => Show (NodeInfo k p)
222−deriving instance (Read k, Read p) => Read (NodeInfo k p)
223−deriving instance (Eq k, Eq p) => Eq (NodeInfo k p)
224−deriving instance (Ord k, Ord p) => Ord (NodeInfo k p)
226−{-# COMPLETE NodeInfo #-}
227−pattern NodeInfo :: To k -> From k v -> NodeInfo k v
228−_nodeInfo_to :: NodeInfo k v -> To k
229−_nodeInfo_from :: NodeInfo k v -> From k v
230−pattern NodeInfo { _nodeInfo_to, _nodeInfo_from } = NodeInfo'
232− { PM._nodeInfo_to = _nodeInfo_to
233− , PM._nodeInfo_from = Coerce _nodeInfo_from
240− (PM.NodeInfo k0 (Proxy v0))
241− (PM.NodeInfo k1 (Proxy v1))
242−_NodeInfo = iso unNodeInfo' NodeInfo'
244−instance Functor (NodeInfo k) where
245− fmap f = runIdentity . traverse (Identity . f)
247−instance Foldable (NodeInfo k) where
248− foldMap = foldMapDefault
250−instance Traversable (NodeInfo k) where
251− traverse = bitraverseNodeInfo pure
257− -> NodeInfo k0 v0 -> f (NodeInfo k1 v1)
258−bitraverseNodeInfo fk fv = fmap NodeInfo'
259− . PM.bitraverseNodeInfo fk (\ ~Proxy -> pure Proxy) fv
262-- | Change the 'From' value of a 'NodeInfo'
180-- | Change the 'From' value of a 'NodeInfo'
263nodeInfoMapFrom :: (From k v -> From k v) -> NodeInfo k v -> NodeInfo k v
181nodeInfoMapFrom :: (From k v -> From k v) -> NodeInfo k v -> NodeInfo k v
264−nodeInfoMapFrom f = coerce $ PM.nodeInfoMapFrom (unFrom' . f . From')
182+nodeInfoMapFrom = PM.nodeInfoMapFrom
266-- | Change the 'From' value of a 'NodeInfo', using a 'Functor' (or
184-- | Change the 'From' value of a 'NodeInfo', using a 'Functor' (or
267-- 'Applicative', 'Monad', etc.) action to get the new value
185-- 'Applicative', 'Monad', etc.) action to get the new value
@@ -269,44 +187,10 @@ nodeInfoMapMFrom
269 :: Functor f
187 :: Functor f
270 => (From k v -> f (From k v))
188 => (From k v -> f (From k v))
271 -> NodeInfo k v -> f (NodeInfo k v)
189 -> NodeInfo k v -> f (NodeInfo k v)
272−nodeInfoMapMFrom f = fmap NodeInfo'
273− . PM.nodeInfoMapMFrom (fmap unFrom' . f . From')
190+nodeInfoMapMFrom = PM.nodeInfoMapMFrom
276-- | Set the 'To' field of a 'NodeInfo'
192-- | Set the 'To' field of a 'NodeInfo'
277nodeInfoSetTo :: To k -> NodeInfo k v -> NodeInfo k v
193nodeInfoSetTo :: To k -> NodeInfo k v -> NodeInfo k v
278−nodeInfoSetTo = coerce . PM.nodeInfoSetTo
194+nodeInfoSetTo = PM.nodeInfoSetTo
284−-- | Describe how a key's new value should be produced
285−newtype From k (v :: Type) = From' { unFrom' :: PM.From k (Proxy v) }
287−{-# COMPLETE From_Insert, From_Delete, From_Move #-}
289−-- | Insert the given value here
290−pattern From_Insert :: v -> From k v
291−pattern From_Insert v = From' (PM.From_Insert v)
293−-- | Delete the existing value, if any, from here
294−pattern From_Delete :: From k v
295−pattern From_Delete = From' PM.From_Delete
297−-- | Move the value here from the given key
298−pattern From_Move :: k -> From k v
299−pattern From_Move k = From' (PM.From_Move k Proxy)
305− -> From k0 v0 -> f (From k1 v1)
306−bitraverseFrom fk fv = fmap From'
307− . PM.bitraverseFrom fk (\ ~Proxy -> pure Proxy) fv
310makeWrapped ''PatchMapWithMove
196makeWrapped ''PatchMapWithMove
311−makeWrapped ''NodeInfo