2{-# LANGUAGE DeriveTraversable #-}
3{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6{-# LANGUAGE LambdaCase #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
8{-# LANGUAGE PatternGuards #-}
9{-# LANGUAGE PatternSynonyms #-}
10{-# LANGUAGE ScopedTypeVariables #-}
11{-# LANGUAGE StandaloneDeriving #-}
12{-# LANGUAGE TemplateHaskell #-}
13{-# LANGUAGE TypeApplications #-}
14{-# LANGUAGE TypeFamilies #-}
15{-# LANGUAGE ViewPatterns #-}
17-- | 'Patch'es on 'Map' that can insert, delete, and move values from one key to
19module Data.Patch.MapWithMove
22 , -- | Extract the representation of the 'PatchMapWithMove' as a map of
28 , patchMapWithMoveInsertAll
33 , unsafePatchMapWithMove
34 , patchMapWithMoveNewElements
35 , patchMapWithMoveNewElementsMap
36 , patchThatSortsMapWith
37 , patchThatChangesAndSortsMapWith
66import Data.Kind (Type)
67import Data.Patch.Class
68import Data.Patch.MapWithPatchingMove (PatchMapWithPatchingMove(..), To)
69import qualified Data.Patch.MapWithPatchingMove as PM -- already a transparent synonym
74import qualified Data.Map as Map
76#if !MIN_VERSION_base(4,11,0)
77import Data.Semigroup (Semigroup (..))
79import Data.Traversable (foldMapDefault)
81-- | Patch a Map with additions, deletions, and moves. Invariant: If key @k1@
82-- is coming from @From_Move k2@, then key @k2@ should be going to @Just k1@,
83-- and vice versa. There should never be any unpaired From/To keys.
84newtype PatchMapWithMove k (v :: Type) = PatchMapWithMove'
85 { -- | Extract the underlying 'PatchMapWithPatchingMove k (Proxy v)'
86 unPatchMapWithMove' :: PatchMapWithPatchingMove k (Proxy v)
88 deriving ( Show, Read, Eq, Ord
89 , -- | Compose patches having the same effect as applying the
90 -- patches in turn: @'applyAlways' (p <> q) == 'applyAlways' p .
96pattern Coerce :: Coercible a b => a -> b
97pattern Coerce x <- (coerce -> x)
98 where Coerce x = coerce x
100{-# COMPLETE PatchMapWithMove #-}
101pattern PatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v
102unPatchMapWithMove :: PatchMapWithMove k v -> Map k (NodeInfo k v)
103pattern PatchMapWithMove { unPatchMapWithMove } = PatchMapWithMove' (PatchMapWithPatchingMove (Coerce unPatchMapWithMove))
107 (PatchMapWithMove k0 v0)
108 (PatchMapWithMove k1 v1)
109 (Map k0 (NodeInfo k0 v0))
110 (Map k1 (NodeInfo k1 v1))
111_PatchMapWithMove = iso unPatchMapWithMove PatchMapWithMove
113instance Functor (PatchMapWithMove k) where
114 fmap f = runIdentity . traverse (Identity . f)
116instance Foldable (PatchMapWithMove k) where
117 foldMap = foldMapDefault
119instance Traversable (PatchMapWithMove k) where
125instance FunctorWithIndex k (PatchMapWithMove k)
126instance FoldableWithIndex k (PatchMapWithMove k)
127instance TraversableWithIndex k (PatchMapWithMove k) where
128 itraverse = itraversed . Indexed
134-- | Create a 'PatchMapWithMove', validating it
135patchMapWithMove :: Ord k => Map k (NodeInfo k v) -> Maybe (PatchMapWithMove k v)
136patchMapWithMove = fmap coerce . PM.patchMapWithPatchingMove . coerce
138-- | Create a 'PatchMapWithMove' that inserts everything in the given 'Map'
139patchMapWithMoveInsertAll :: Map k v -> PatchMapWithMove k v
140patchMapWithMoveInsertAll = PatchMapWithMove' . PM.patchMapWithPatchingMoveInsertAll
142-- | Make a @'PatchMapWithMove' k v@ which has the effect of inserting or updating a value @v@ to the given key @k@, like 'Map.insert'.
143insertMapKey :: k -> v -> PatchMapWithMove k v
144insertMapKey k v = PatchMapWithMove' $ PM.insertMapKey k v
146-- |Make a @'PatchMapWithMove' k v@ which has the effect of moving the value from the first key @k@ to the second key @k@, equivalent to:
149-- 'Map.delete' src (maybe map ('Map.insert' dst) (Map.lookup src map))
151moveMapKey :: Ord k => k -> k -> PatchMapWithMove k v
152moveMapKey src dst = PatchMapWithMove' $ PM.moveMapKey src dst
154-- |Make a @'PatchMapWithMove' k v@ which has the effect of swapping two keys in the mapping, equivalent to:
157-- let aMay = Map.lookup a map
158-- bMay = Map.lookup b map
159-- in maybe id (Map.insert a) (bMay `mplus` aMay)
160-- . maybe id (Map.insert b) (aMay `mplus` bMay)
161-- . Map.delete a . Map.delete b $ map
163swapMapKey :: Ord k => k -> k -> PatchMapWithMove k v
164swapMapKey src dst = PatchMapWithMove' $ PM.swapMapKey src dst
166-- |Make a @'PatchMapWithMove' k v@ which has the effect of deleting a key in the mapping, equivalent to 'Map.delete'.
167deleteMapKey :: k -> PatchMapWithMove k v
168deleteMapKey = PatchMapWithMove' . PM.deleteMapKey
170-- | Wrap a @'Map' k (NodeInfo k v)@ representing patch changes into a @'PatchMapWithMove' k v@, without checking any invariants.
172-- __Warning:__ when using this function, you must ensure that the invariants of 'PatchMapWithMove' are preserved; they will not be checked.
173unsafePatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v
174unsafePatchMapWithMove = PatchMapWithMove' . PM.unsafePatchMapWithPatchingMove . coerce
176-- | Apply the insertions, deletions, and moves to a given 'Map'
177instance Ord k => Patch (PatchMapWithMove k v) where
178 type PatchTarget (PatchMapWithMove k v) = Map k v
179 apply (PatchMapWithMove' p) = apply p
181-- | Returns all the new elements that will be added to the 'Map'.
182patchMapWithMoveNewElements :: PatchMapWithMove k v -> [v]
183patchMapWithMoveNewElements = PM.patchMapWithPatchingMoveNewElements . unPatchMapWithMove'
185-- | Return a @'Map' k v@ with all the inserts/updates from the given @'PatchMapWithMove' k v@.
186patchMapWithMoveNewElementsMap :: PatchMapWithMove k v -> Map k v
187patchMapWithMoveNewElementsMap = PM.patchMapWithPatchingMoveNewElementsMap . unPatchMapWithMove'
189-- | Create a 'PatchMapWithMove' that, if applied to the given 'Map', will sort
190-- its values using the given ordering function. The set keys of the 'Map' is
192patchThatSortsMapWith :: Ord k => (v -> v -> Ordering) -> Map k v -> PatchMapWithMove k v
193patchThatSortsMapWith cmp = PatchMapWithMove' . PM.patchThatSortsMapWith cmp
195-- | Create a 'PatchMapWithMove' that, if applied to the first 'Map' provided,
196-- will produce a 'Map' with the same values as the second 'Map' but with the
197-- values sorted with the given ordering function.
198patchThatChangesAndSortsMapWith :: forall k v. (Ord k, Ord v) => (v -> v -> Ordering) -> Map k v -> Map k v -> PatchMapWithMove k v
199patchThatChangesAndSortsMapWith cmp oldByIndex newByIndexUnsorted = patchThatChangesMap oldByIndex newByIndex
200 where newList = Map.toList newByIndexUnsorted
201 newByIndex = Map.fromList $ zip (fst <$> newList) $ sortBy cmp $ snd <$> newList
203-- | Create a 'PatchMapWithMove' that, if applied to the first 'Map' provided,
204-- will produce the second 'Map'.
205patchThatChangesMap :: (Ord k, Ord v) => Map k v -> Map k v -> PatchMapWithMove k v
206patchThatChangesMap oldByIndex newByIndex = PatchMapWithMove' $
207 PM.patchThatChangesMap oldByIndex newByIndex
213-- | Holds the information about each key: where its new value should come from,
214-- and where its old value should go to
215newtype NodeInfo k (v :: Type) = NodeInfo' { unNodeInfo' :: PM.NodeInfo k (Proxy v) }
217deriving instance (Show k, Show p) => Show (NodeInfo k p)
218deriving instance (Read k, Read p) => Read (NodeInfo k p)
219deriving instance (Eq k, Eq p) => Eq (NodeInfo k p)
220deriving instance (Ord k, Ord p) => Ord (NodeInfo k p)
222{-# COMPLETE NodeInfo #-}
223pattern NodeInfo :: To k -> From k v -> NodeInfo k v
224_nodeInfo_to :: NodeInfo k v -> To k
225_nodeInfo_from :: NodeInfo k v -> From k v
226pattern NodeInfo { _nodeInfo_to, _nodeInfo_from } = NodeInfo'
228 { PM._nodeInfo_to = _nodeInfo_to
229 , PM._nodeInfo_from = Coerce _nodeInfo_from
236 (PM.NodeInfo k0 (Proxy v0))
237 (PM.NodeInfo k1 (Proxy v1))
238_NodeInfo = iso unNodeInfo' NodeInfo'
240instance Functor (NodeInfo k) where
241 fmap f = runIdentity . traverse (Identity . f)
243instance Foldable (NodeInfo k) where
244 foldMap = foldMapDefault
246instance Traversable (NodeInfo k) where
247 traverse = _NodeInfo . traverseNodeInfo
250 :: Traversal (PM.NodeInfo k (Proxy a)) (PM.NodeInfo k (Proxy b)) a b
251 traverseNodeInfo = PM.bitraverseNodeInfo pure (\ ~Proxy -> pure Proxy)
257 -> NodeInfo k0 v0 -> f (NodeInfo k1 v1)
258bitraverseNodeInfo fk fv = fmap coerce
259 . PM.bitraverseNodeInfo fk (\ ~Proxy -> pure Proxy) fv
262-- | Change the 'From' value of a 'NodeInfo'
263nodeInfoMapFrom :: (From k v -> From k v) -> NodeInfo k v -> NodeInfo k v
264nodeInfoMapFrom f = coerce . PM.nodeInfoMapFrom (unFrom' . f . From') . coerce
266-- | Change the 'From' value of a 'NodeInfo', using a 'Functor' (or
267-- 'Applicative', 'Monad', etc.) action to get the new value
270 => (From k v -> f (From k v))
271 -> NodeInfo k v -> f (NodeInfo k v)
272nodeInfoMapMFrom f = fmap coerce
273 . PM.nodeInfoMapMFrom (fmap unFrom' . f . From')
276-- | Set the 'To' field of a 'NodeInfo'
277nodeInfoSetTo :: To k -> NodeInfo k v -> NodeInfo k v
278nodeInfoSetTo = coerce . PM.nodeInfoSetTo
284-- | Describe how a key's new value should be produced
285newtype 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
290pattern From_Insert :: v -> From k v
291pattern From_Insert v = From' (PM.From_Insert v)
293-- | Delete the existing value, if any, from here
294pattern From_Delete :: From k v
295pattern From_Delete = From' PM.From_Delete
297-- | Move the value here from the given key
298pattern From_Move :: k -> From k v
299pattern From_Move k = From' (PM.From_Move k Proxy)
305 -> From k0 v0 -> f (From k1 v1)
306bitraverseFrom fk fv = fmap coerce
307 . PM.bitraverseFrom fk (\ ~Proxy -> pure Proxy) fv
310makeWrapped ''PatchMapWithMove
311makeWrapped ''NodeInfo
keysesc to close
- j k
- move down, up
- enter
- open
- esc
- back, or up a level
- 1 2 3 4
- readme, files, commits, refs
- /
- filter
- y
- copy the clone command
- c
- compare the chosen commit with another (or shift-click both)
- ?
- show or hide this list