git.iko.soy/patch
on cfcd1cf help sign in
patch/src/Data/Patch/MapWithMove.hs
196 lines 7.8 kB history raw
1{-# LANGUAGE CPP #-}
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 TemplateHaskell #-}
12{-# LANGUAGE TypeApplications #-}
13{-# LANGUAGE TypeFamilies #-}
15-- | 'Patch'es on 'Map' that can insert, delete, and move values from one key to
16-- another
17module Data.Patch.MapWithMove
18 ( module Data.Patch.MapWithMove
19 , PatchMapWithMove (PatchMapWithMove)
20 , NodeInfo
21 , pattern PM.NodeInfo
22 , PM._nodeInfo_to
23 , PM._nodeInfo_from
24 ) where
26import Data.Patch.Class
27import Data.Patch.MapWithPatchingMove
28 ( PatchMapWithPatchingMove (..)
29 )
30import qualified Data.Patch.MapWithPatchingMove as PM
32import Control.Lens hiding (from, to)
33import Data.List
34import Data.Map (Map)
35import qualified Data.Map as Map
36import Data.Proxy
37#if !MIN_VERSION_base(4,11,0)
38import Data.Semigroup (Semigroup (..))
39#endif
40import Data.Traversable (foldMapDefault)
42-- | Patch a Map with additions, deletions, and moves. Invariant: If key @k1@
43-- is coming from @From_Move k2@, then key @k2@ should be going to @Just k1@,
44-- and vice versa. There should never be any unpaired From/To keys.
45newtype PatchMapWithMove k v = PatchMapWithMove'
46 { -- | Extract the underlying 'PatchMapWithPatchingMove k (Proxy v)'
47 unPatchMapWithMove' :: PatchMapWithPatchingMove k (Proxy v)
48 }
49 deriving ( Show, Read, Eq, Ord
50 , Semigroup, Monoid
51 )
53{-# COMPLETE PatchMapWithMove #-}
54pattern PatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v
55pattern PatchMapWithMove m = PatchMapWithMove' (PatchMapWithPatchingMove m)
57-- | Extract the internal representation of the 'PatchMapWithMove'
58unPatchMapWithMove :: PatchMapWithMove k v -> Map k (PM.NodeInfo k (Proxy v))
59unPatchMapWithMove = unPatchMapWithPatchingMove . unPatchMapWithMove'
61instance Functor (PatchMapWithMove k) where
62 fmap f = runIdentity . traverse (Identity . f)
64instance Foldable (PatchMapWithMove k) where
65 foldMap = foldMapDefault
67instance Traversable (PatchMapWithMove k) where
68 traverse =
69 _Wrapping PatchMapWithMove' .
70 _Wrapping PatchMapWithPatchingMove .
71 traverse .
72 traverseNodeInfo
74instance FunctorWithIndex k (PatchMapWithMove k)
75instance FoldableWithIndex k (PatchMapWithMove k)
76instance TraversableWithIndex k (PatchMapWithMove k) where
77 itraverse = itraversed . Indexed
78 itraversed =
79 _Wrapping PatchMapWithMove' .>
80 _Wrapping PatchMapWithPatchingMove .>
81 itraversed <.
82 traverseNodeInfo
84type NodeInfo k v = PM.NodeInfo k (Proxy v)
86type From k v = PM.From k (Proxy v)
88{-# COMPLETE From_Insert, From_Delete, From_Move #-}
90pattern From_Insert :: v -> From k v
91pattern From_Insert v = PM.From_Insert v
93pattern From_Delete :: From k v
94pattern From_Delete = PM.From_Delete
96pattern From_Move :: k -> From k v
97pattern From_Move k = PM.From_Move k Proxy
99type To k = PM.To k
101traverseNodeInfo
102 :: Traversal (NodeInfo k a) (NodeInfo k b) a b
103traverseNodeInfo = PM.bitraverseNodeInfo pure (\(~Proxy) -> pure Proxy)
105-- | Create a 'PatchMapWithMove', validating it
106patchMapWithMove :: Ord k => Map k (NodeInfo k v) -> Maybe (PatchMapWithMove k v)
107patchMapWithMove = fmap PatchMapWithMove' . PM.patchMapWithPatchingMove
109-- | Create a 'PatchMapWithMove' that inserts everything in the given 'Map'
110patchMapWithMoveInsertAll :: Map k v -> PatchMapWithMove k v
111patchMapWithMoveInsertAll = PatchMapWithMove' . PM.patchMapWithPatchingMoveInsertAll
113-- | Make a @'PatchMapWithMove' k v@ which has the effect of inserting or updating a value @v@ to the given key @k@, like 'Map.insert'.
114insertMapKey :: k -> v -> PatchMapWithMove k v
115insertMapKey k v = PatchMapWithMove' $ PM.insertMapKey k v
117-- |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:
118--
119-- @
120-- 'Map.delete' src (maybe map ('Map.insert' dst) (Map.lookup src map))
121-- @
122moveMapKey :: Ord k => k -> k -> PatchMapWithMove k v
123moveMapKey src dst = PatchMapWithMove' $ PM.moveMapKey src dst
125-- |Make a @'PatchMapWithMove' k v@ which has the effect of swapping two keys in the mapping, equivalent to:
126--
127-- @
128-- let aMay = Map.lookup a map
129-- bMay = Map.lookup b map
130-- in maybe id (Map.insert a) (bMay `mplus` aMay)
131-- . maybe id (Map.insert b) (aMay `mplus` bMay)
132-- . Map.delete a . Map.delete b $ map
133-- @
134swapMapKey :: Ord k => k -> k -> PatchMapWithMove k v
135swapMapKey src dst = PatchMapWithMove' $ PM.swapMapKey src dst
137-- |Make a @'PatchMapWithMove' k v@ which has the effect of deleting a key in the mapping, equivalent to 'Map.delete'.
138deleteMapKey :: k -> PatchMapWithMove k v
139deleteMapKey = PatchMapWithMove' . PM.deleteMapKey
141-- | Wrap a @'Map' k (NodeInfo k v)@ representing patch changes into a @'PatchMapWithMove' k v@, without checking any invariants.
142--
143-- __Warning:__ when using this function, you must ensure that the invariants of 'PatchMapWithMove' are preserved; they will not be checked.
144unsafePatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v
145unsafePatchMapWithMove = PatchMapWithMove' . PM.unsafePatchMapWithPatchingMove
147-- | Apply the insertions, deletions, and moves to a given 'Map'
148instance Ord k => Patch (PatchMapWithMove k v) where
149 type PatchTarget (PatchMapWithMove k v) = Map k v
150 apply (PatchMapWithMove' p) old = apply p old
152-- | Returns all the new elements that will be added to the 'Map'.
153patchMapWithMoveNewElements :: PatchMapWithMove k v -> [v]
154patchMapWithMoveNewElements = PM.patchMapWithPatchingMoveNewElements . unPatchMapWithMove'
156-- | Return a @'Map' k v@ with all the inserts/updates from the given @'PatchMapWithMove' k v@.
157patchMapWithMoveNewElementsMap :: PatchMapWithMove k v -> Map k v
158patchMapWithMoveNewElementsMap = PM.patchMapWithPatchingMoveNewElementsMap . unPatchMapWithMove'
160-- | Create a 'PatchMapWithMove' that, if applied to the given 'Map', will sort
161-- its values using the given ordering function. The set keys of the 'Map' is
162-- not changed.
163patchThatSortsMapWith :: Ord k => (v -> v -> Ordering) -> Map k v -> PatchMapWithMove k v
164patchThatSortsMapWith cmp = PatchMapWithMove' . PM.patchThatSortsMapWith cmp
166-- | Create a 'PatchMapWithMove' that, if applied to the first 'Map' provided,
167-- will produce a 'Map' with the same values as the second 'Map' but with the
168-- values sorted with the given ordering function.
169patchThatChangesAndSortsMapWith :: forall k v. (Ord k, Ord v) => (v -> v -> Ordering) -> Map k v -> Map k v -> PatchMapWithMove k v
170patchThatChangesAndSortsMapWith cmp oldByIndex newByIndexUnsorted = patchThatChangesMap oldByIndex newByIndex
171 where newList = Map.toList newByIndexUnsorted
172 newByIndex = Map.fromList $ zip (fst <$> newList) $ sortBy cmp $ snd <$> newList
174-- | Create a 'PatchMapWithMove' that, if applied to the first 'Map' provided,
175-- will produce the second 'Map'.
176patchThatChangesMap :: (Ord k, Ord v) => Map k v -> Map k v -> PatchMapWithMove k v
177patchThatChangesMap oldByIndex newByIndex = PatchMapWithMove' $
178 PM.patchThatChangesMap oldByIndex newByIndex
180-- | Change the 'From' value of a 'NodeInfo'
181nodeInfoMapFrom :: (From k v -> From k v) -> NodeInfo k v -> NodeInfo k v
182nodeInfoMapFrom = PM.nodeInfoMapFrom
184-- | Change the 'From' value of a 'NodeInfo', using a 'Functor' (or
185-- 'Applicative', 'Monad', etc.) action to get the new value
186nodeInfoMapMFrom
187 :: Functor f
188 => (From k v -> f (From k v))
189 -> NodeInfo k v -> f (NodeInfo k v)
190nodeInfoMapMFrom = PM.nodeInfoMapMFrom
192-- | Set the 'To' field of a 'NodeInfo'
193nodeInfoSetTo :: To k -> NodeInfo k v -> NodeInfo k v
194nodeInfoSetTo = PM.nodeInfoSetTo
196makeWrapped ''PatchMapWithMove