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-- 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 .
98pattern Coerce :: Coercible a b => a -> b
99pattern Coerce x <- (coerce -> x)
100 where Coerce x = coerce x
102{-# COMPLETE PatchMapWithMove #-}
103pattern PatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v
104-- | Extract the representation of the 'PatchMapWithMove' as a map of
106unPatchMapWithMove :: PatchMapWithMove k v -> Map k (NodeInfo k v)
107pattern PatchMapWithMove { unPatchMapWithMove } = PatchMapWithMove' (PatchMapWithPatchingMove (Coerce 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
118 fmap f = runIdentity . traverse (Identity . f)
120instance Foldable (PatchMapWithMove k) where
121 foldMap = foldMapDefault
123instance Traversable (PatchMapWithMove k) where
129instance FunctorWithIndex k (PatchMapWithMove k)
130instance FoldableWithIndex k (PatchMapWithMove k)
131instance TraversableWithIndex k (PatchMapWithMove k) where
132 itraverse = itraversed . Indexed
138-- | Create a 'PatchMapWithMove', validating it
139patchMapWithMove :: Ord k => Map k (NodeInfo k v) -> Maybe (PatchMapWithMove k v)
140patchMapWithMove = fmap PatchMapWithMove' . PM.patchMapWithPatchingMove . coerce
142-- | Create a 'PatchMapWithMove' that inserts everything in the given 'Map'
143patchMapWithMoveInsertAll :: Map k v -> PatchMapWithMove k v
144patchMapWithMoveInsertAll = PatchMapWithMove' . PM.patchMapWithPatchingMoveInsertAll
146-- | Make a @'PatchMapWithMove' k v@ which has the effect of inserting or updating a value @v@ to the given key @k@, like 'Map.insert'.
147insertMapKey :: k -> v -> PatchMapWithMove k v
148insertMapKey k v = PatchMapWithMove' $ PM.insertMapKey k v
150-- |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:
153-- 'Map.delete' src (maybe map ('Map.insert' dst) (Map.lookup src map))
155moveMapKey :: Ord k => k -> k -> PatchMapWithMove k v
156moveMapKey src dst = PatchMapWithMove' $ PM.moveMapKey src dst
158-- |Make a @'PatchMapWithMove' k v@ which has the effect of swapping two keys in the mapping, equivalent to:
161-- let aMay = Map.lookup a map
162-- bMay = Map.lookup b map
163-- in maybe id (Map.insert a) (bMay <> aMay)
164-- . maybe id (Map.insert b) (aMay <> bMay)
165-- . Map.delete a . Map.delete b $ map
167swapMapKey :: Ord k => k -> k -> PatchMapWithMove k v
168swapMapKey src dst = PatchMapWithMove' $ PM.swapMapKey src dst
170-- |Make a @'PatchMapWithMove' k v@ which has the effect of deleting a key in the mapping, equivalent to 'Map.delete'.
171deleteMapKey :: k -> PatchMapWithMove k v
172deleteMapKey = PatchMapWithMove' . PM.deleteMapKey
174-- | Wrap a @'Map' k (NodeInfo k v)@ representing patch changes into a @'PatchMapWithMove' k v@, without checking any invariants.
176-- __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
178unsafePatchMapWithMove = coerce PM.unsafePatchMapWithPatchingMove
180-- | Apply the insertions, deletions, and moves to a given 'Map'
181instance Ord k => Patch (PatchMapWithMove k v) where
182 type PatchTarget (PatchMapWithMove k v) = Map k v
183 apply (PatchMapWithMove' p) = apply p
185-- | Returns all the new elements that will be added to the 'Map'.
186patchMapWithMoveNewElements :: PatchMapWithMove k v -> [v]
187patchMapWithMoveNewElements = PM.patchMapWithPatchingMoveNewElements . unPatchMapWithMove'
189-- | Return a @'Map' k v@ with all the inserts/updates from the given @'PatchMapWithMove' k v@.
190patchMapWithMoveNewElementsMap :: PatchMapWithMove k v -> Map k v
191patchMapWithMoveNewElementsMap = PM.patchMapWithPatchingMoveNewElementsMap . unPatchMapWithMove'
193-- | Create a 'PatchMapWithMove' that, if applied to the given 'Map', will sort
194-- its values using the given ordering function. The set keys of the 'Map' is
196patchThatSortsMapWith :: Ord k => (v -> v -> Ordering) -> Map k v -> PatchMapWithMove k v
197patchThatSortsMapWith cmp = PatchMapWithMove' . PM.patchThatSortsMapWith cmp
199-- | 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
201-- values sorted with the given ordering function.
202patchThatChangesAndSortsMapWith :: (Ord k, Ord v) => (v -> v -> Ordering) -> Map k v -> Map k v -> PatchMapWithMove k v
203patchThatChangesAndSortsMapWith cmp oldByIndex newByIndexUnsorted = patchThatChangesMap oldByIndex newByIndex
204 where newList = Map.toList newByIndexUnsorted
205 newByIndex = Map.fromList $ zip (fst <$> newList) $ sortBy cmp $ snd <$> newList
207-- | Create a 'PatchMapWithMove' that, if applied to the first 'Map' provided,
208-- will produce the second 'Map'.
209patchThatChangesMap :: (Ord k, Ord v) => Map k v -> Map k v -> PatchMapWithMove k v
210patchThatChangesMap oldByIndex newByIndex = PatchMapWithMove' $
211 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
219newtype NodeInfo k (v :: Type) = NodeInfo' { unNodeInfo' :: PM.NodeInfo k (Proxy v) }
221deriving instance (Show k, Show p) => Show (NodeInfo k p)
222deriving instance (Read k, Read p) => Read (NodeInfo k p)
223deriving instance (Eq k, Eq p) => Eq (NodeInfo k p)
224deriving instance (Ord k, Ord p) => Ord (NodeInfo k p)
226{-# COMPLETE NodeInfo #-}
227pattern 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
230pattern 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'
244instance Functor (NodeInfo k) where
245 fmap f = runIdentity . traverse (Identity . f)
247instance Foldable (NodeInfo k) where
248 foldMap = foldMapDefault
250instance Traversable (NodeInfo k) where
251 traverse = bitraverseNodeInfo pure
257 -> NodeInfo k0 v0 -> f (NodeInfo k1 v1)
258bitraverseNodeInfo fk fv = fmap NodeInfo'
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')
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 NodeInfo'
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 From'
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