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
26 , patchMapWithMoveInsertAll
31 , unsafePatchMapWithMove
32 , patchMapWithMoveNewElements
33 , patchMapWithMoveNewElementsMap
34 , patchThatSortsMapWith
35 , patchThatChangesAndSortsMapWith
64import Data.Kind (Type)
65import Data.Patch.Class
66import Data.Patch.MapWithPatchingMove (PatchMapWithPatchingMove(..), To)
67import qualified Data.Patch.MapWithPatchingMove as PM -- already a transparent synonym
72import qualified Data.Map as Map
74#if !MIN_VERSION_base(4,11,0)
75import Data.Semigroup (Semigroup (..))
77import Data.Traversable (foldMapDefault)
79-- | 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@,
81-- and vice versa. There should never be any unpaired From/To keys.
82newtype PatchMapWithMove k (v :: Type) = PatchMapWithMove'
83 { -- | Extract the underlying 'PatchMapWithPatchingMove k (Proxy v)'
84 unPatchMapWithMove' :: PatchMapWithPatchingMove k (Proxy v)
86 deriving ( Show, Read, Eq, Ord
87 , -- | Compose patches having the same effect as applying the
88 -- patches in turn: @'applyAlways' (p <> q) == 'applyAlways' p .
94pattern Coerce :: Coercible a b => a -> b
95pattern Coerce x <- (coerce -> x)
96 where Coerce x = coerce x
98{-# COMPLETE PatchMapWithMove #-}
99pattern PatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v
100-- | Extract the representation of the 'PatchMapWithMove' as a map of
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 = bitraverseNodeInfo pure
253 -> NodeInfo k0 v0 -> f (NodeInfo k1 v1)
254bitraverseNodeInfo fk fv = fmap coerce
255 . PM.bitraverseNodeInfo fk (\ ~Proxy -> pure Proxy) fv
258-- | Change the 'From' value of a 'NodeInfo'
259nodeInfoMapFrom :: (From k v -> From k v) -> NodeInfo k v -> NodeInfo k v
260nodeInfoMapFrom f = coerce . PM.nodeInfoMapFrom (unFrom' . f . From') . coerce
262-- | Change the 'From' value of a 'NodeInfo', using a 'Functor' (or
263-- 'Applicative', 'Monad', etc.) action to get the new value
266 => (From k v -> f (From k v))
267 -> NodeInfo k v -> f (NodeInfo k v)
268nodeInfoMapMFrom f = fmap coerce
269 . PM.nodeInfoMapMFrom (fmap unFrom' . f . From')
272-- | Set the 'To' field of a 'NodeInfo'
273nodeInfoSetTo :: To k -> NodeInfo k v -> NodeInfo k v
274nodeInfoSetTo = coerce . PM.nodeInfoSetTo
280-- | Describe how a key's new value should be produced
281newtype From k (v :: Type) = From' { unFrom' :: PM.From k (Proxy v) }
283{-# COMPLETE From_Insert, From_Delete, From_Move #-}
285-- | Insert the given value here
286pattern From_Insert :: v -> From k v
287pattern From_Insert v = From' (PM.From_Insert v)
289-- | Delete the existing value, if any, from here
290pattern From_Delete :: From k v
291pattern From_Delete = From' PM.From_Delete
293-- | Move the value here from the given key
294pattern From_Move :: k -> From k v
295pattern From_Move k = From' (PM.From_Move k Proxy)
301 -> From k0 v0 -> f (From k1 v1)
302bitraverseFrom fk fv = fmap coerce
303 . PM.bitraverseFrom fk (\ ~Proxy -> pure Proxy) fv
306makeWrapped ''PatchMapWithMove
307makeWrapped ''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