@@ -19,7 +19,9 @@
1919module Data.Patch.MapWithMove
2020 ( PatchMapWithMove
2121 ( PatchMapWithMove
22− , unPatchMapWithMove
22+ , -- | Extract the representation of the 'PatchMapWithMove' as a map of
23+ -- 'NodeInfo'.
24+ unPatchMapWithMove
2325 , ..
2426 )
2527 , patchMapWithMove
@@ -63,10 +65,13 @@ module Data.Patch.MapWithMove
6365import Data.Coerce
6466import Data.Kind (Type)
6567import Data.Patch.Class
66−import Data.Patch.MapWithPatchingMove (PatchMapWithPatchingMove(..), To)
67−import qualified Data.Patch.MapWithPatchingMove as PM -- already a transparent synonym
68+import Data.Patch.MapWithPatchingMove
69+ ( PatchMapWithPatchingMove (..)
70+ )
71+import qualified Data.Patch.MapWithPatchingMove as PM
72+import Data.Patch.MapWithPatchingMove (To) -- already a transparent synonym
6873
69−import Control.Lens
74+import Control.Lens hiding (from, to)
7075import Data.List
7176import Data.Map (Map)
7277import qualified Data.Map as Map
@@ -84,13 +89,9 @@ newtype PatchMapWithMove k (v :: Type) = PatchMapWithMove'
8489 unPatchMapWithMove' :: PatchMapWithPatchingMove k (Proxy v)
8590 }
8691 deriving ( Show, Read, Eq, Ord
87−-- Haddock cannot handle documentation here before GHC 8.6
88− ,
89−#if __GLASGOW_HASKELL__ >= 806
90− -- | Compose patches having the same effect as applying the
92+ , -- | Compose patches having the same effect as applying the
9193 -- patches in turn: @'applyAlways' (p <> q) == 'applyAlways' p .
9294 -- 'applyAlways' q@
93−#endif
9495 Semigroup
9596 , Monoid
9697 )
@@ -101,8 +102,6 @@ pattern Coerce x <- (coerce -> x)
101102
102103{-# COMPLETE PatchMapWithMove #-}
103104pattern PatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v
104−-- | Extract the representation of the 'PatchMapWithMove' as a map of
105−-- 'NodeInfo'.
106105unPatchMapWithMove :: PatchMapWithMove k v -> Map k (NodeInfo k v)
107106pattern PatchMapWithMove { unPatchMapWithMove } = PatchMapWithMove' (PatchMapWithPatchingMove (Coerce unPatchMapWithMove))
108107
@@ -137,7 +136,7 @@ instance TraversableWithIndex k (PatchMapWithMove k) where
137136
138137-- | Create a 'PatchMapWithMove', validating it
139138patchMapWithMove :: Ord k => Map k (NodeInfo k v) -> Maybe (PatchMapWithMove k v)
140−patchMapWithMove = fmap PatchMapWithMove' . PM.patchMapWithPatchingMove . coerce
139+patchMapWithMove = fmap coerce . PM.patchMapWithPatchingMove . coerce
141140
142141-- | Create a 'PatchMapWithMove' that inserts everything in the given 'Map'
143142patchMapWithMoveInsertAll :: Map k v -> PatchMapWithMove k v
@@ -160,8 +159,8 @@ moveMapKey src dst = PatchMapWithMove' $ PM.moveMapKey src dst
160159-- @
161160-- let aMay = Map.lookup a map
162161-- bMay = Map.lookup b map
163−-- in maybe id (Map.insert a) (bMay <> aMay)
164−-- . maybe id (Map.insert b) (aMay <> bMay)
162+-- in maybe id (Map.insert a) (bMay `mplus` aMay)
163+-- . maybe id (Map.insert b) (aMay `mplus` bMay)
165164-- . Map.delete a . Map.delete b $ map
166165-- @
167166swapMapKey :: Ord k => k -> k -> PatchMapWithMove k v
@@ -175,7 +174,7 @@ deleteMapKey = PatchMapWithMove' . PM.deleteMapKey
175174--
176175-- __Warning:__ when using this function, you must ensure that the invariants of 'PatchMapWithMove' are preserved; they will not be checked.
177176unsafePatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v
178−unsafePatchMapWithMove = coerce PM.unsafePatchMapWithPatchingMove
177+unsafePatchMapWithMove = PatchMapWithMove' . PM.unsafePatchMapWithPatchingMove . coerce
179178
180179-- | Apply the insertions, deletions, and moves to a given 'Map'
181180instance Ord k => Patch (PatchMapWithMove k v) where
@@ -199,7 +198,7 @@ patchThatSortsMapWith cmp = PatchMapWithMove' . PM.patchThatSortsMapWith cmp
199198-- | Create a 'PatchMapWithMove' that, if applied to the first 'Map' provided,
200199-- will produce a 'Map' with the same values as the second 'Map' but with the
201200-- 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
201+patchThatChangesAndSortsMapWith :: forall k v. (Ord k, Ord v) => (v -> v -> Ordering) -> Map k v -> Map k v -> PatchMapWithMove k v
203202patchThatChangesAndSortsMapWith cmp oldByIndex newByIndexUnsorted = patchThatChangesMap oldByIndex newByIndex
204203 where newList = Map.toList newByIndexUnsorted
205204 newByIndex = Map.fromList $ zip (fst <$> newList) $ sortBy cmp $ snd <$> newList
@@ -227,11 +226,11 @@ deriving instance (Ord k, Ord p) => Ord (NodeInfo k p)
227226pattern NodeInfo :: To k -> From k v -> NodeInfo k v
228227_nodeInfo_to :: NodeInfo k v -> To k
229228_nodeInfo_from :: NodeInfo k v -> From k v
230−pattern NodeInfo { _nodeInfo_to, _nodeInfo_from } = NodeInfo'
231− PM.NodeInfo
229+pattern NodeInfo { _nodeInfo_to, _nodeInfo_from } =
230+ NodeInfo' (PM.NodeInfo
232231 { PM._nodeInfo_to = _nodeInfo_to
233232 , PM._nodeInfo_from = Coerce _nodeInfo_from
234− }
233+ })
235234
236235_NodeInfo
237236 :: Iso
@@ -248,20 +247,24 @@ instance Foldable (NodeInfo k) where
248247 foldMap = foldMapDefault
249248
250249instance Traversable (NodeInfo k) where
251− traverse = bitraverseNodeInfo pure
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)
252255
253256bitraverseNodeInfo
254257 :: Applicative f
255258 => (k0 -> f k1)
256259 -> (v0 -> f v1)
257260 -> NodeInfo k0 v0 -> f (NodeInfo k1 v1)
258−bitraverseNodeInfo fk fv = fmap NodeInfo'
261+bitraverseNodeInfo fk fv = fmap coerce
259262 . PM.bitraverseNodeInfo fk (\ ~Proxy -> pure Proxy) fv
260263 . coerce
261264
262265-- | Change the 'From' value of a 'NodeInfo'
263266nodeInfoMapFrom :: (From k v -> From k v) -> NodeInfo k v -> NodeInfo k v
264−nodeInfoMapFrom f = coerce $ PM.nodeInfoMapFrom (unFrom' . f . From')
267+nodeInfoMapFrom f = coerce . PM.nodeInfoMapFrom (unFrom' . f . From') . coerce
265268
266269-- | Change the 'From' value of a 'NodeInfo', using a 'Functor' (or
267270-- 'Applicative', 'Monad', etc.) action to get the new value
@@ -269,7 +272,7 @@ nodeInfoMapMFrom
269272 :: Functor f
270273 => (From k v -> f (From k v))
271274 -> NodeInfo k v -> f (NodeInfo k v)
272−nodeInfoMapMFrom f = fmap NodeInfo'
275+nodeInfoMapMFrom f = fmap coerce
273276 . PM.nodeInfoMapMFrom (fmap unFrom' . f . From')
274277 . coerce
275278
@@ -292,7 +295,7 @@ pattern From_Insert v = From' (PM.From_Insert v)
292295
293296-- | Delete the existing value, if any, from here
294297pattern From_Delete :: From k v
295−pattern From_Delete = From' PM.From_Delete
298+pattern From_Delete = From' (PM.From_Delete)
296299
297300-- | Move the value here from the given key
298301pattern From_Move :: k -> From k v
@@ -303,10 +306,9 @@ bitraverseFrom
303306 => (k0 -> f k1)
304307 -> (v0 -> f v1)
305308 -> From k0 v0 -> f (From k1 v1)
306−bitraverseFrom fk fv = fmap From'
309+bitraverseFrom fk fv = fmap coerce
307310 . PM.bitraverseFrom fk (\ ~Proxy -> pure Proxy) fv
308311 . coerce
309312
310313makeWrapped ''PatchMapWithMove
311314makeWrapped ''NodeInfo
312−makeWrapped ''From