git.iko.soy/patch
on aa-example help sign in
patch/src/Data/Patch/Map.hs
55 lines 2.4 kB history raw
1{-# LANGUAGE LambdaCase #-}
2{-# LANGUAGE TypeFamilies #-}
3-- | 'Patch'es on 'Map' that consist only of insertions (including overwrites)
4-- and deletions
5module Data.Patch.Map where
7import Data.Patch.Class
9import Data.Map (Map)
10import qualified Data.Map as Map
11import Data.Maybe
12import Data.Semigroup
14-- | A set of changes to a 'Map'. Any element may be inserted/updated or
15-- deleted. Insertions are represented as values wrapped in 'Just', while
16-- deletions are represented as 'Nothing's
17newtype PatchMap k v = PatchMap { unPatchMap :: Map k (Maybe v) }
18 deriving (Show, Read, Eq, Ord)
20-- | Apply the insertions or deletions to a given 'Map'.
21instance Ord k => Patch (PatchMap k v) where
22 type PatchTarget (PatchMap k v) = Map k v
23 {-# INLINABLE apply #-}
24 apply (PatchMap p) old = Just $! insertions `Map.union` (old `Map.difference` deletions) --TODO: return Nothing sometimes --Note: the strict application here is critical to ensuring that incremental merges don't hold onto all their prerequisite events forever; can we make this more robust?
25 where insertions = Map.mapMaybeWithKey (const id) p
26 deletions = Map.mapMaybeWithKey (const nothingToJust) p
27 nothingToJust = \case
28 Nothing -> Just ()
29 Just _ -> Nothing
31-- | @a <> b@ will apply the changes of @b@ and then apply the changes of @a@.
32-- If the same key is modified by both patches, the one on the left will take
33-- precedence.
34instance Ord k => Semigroup (PatchMap k v) where
35 PatchMap a <> PatchMap b = PatchMap $ a `mappend` b --TODO: Add a semigroup instance for Map
36 -- PatchMap is idempotent, so stimes n is id for every n
37 stimes = stimesIdempotentMonoid
39-- | The empty 'PatchMap' contains no insertions or deletions
40instance Ord k => Monoid (PatchMap k v) where
41 mempty = PatchMap mempty
42 mappend = (<>)
44-- | 'fmap'ping a 'PatchMap' will alter all of the values it will insert.
45-- Deletions are unaffected.
46instance Functor (PatchMap k) where
47 fmap f = PatchMap . fmap (fmap f) . unPatchMap
49-- | Returns all the new elements that will be added to the 'Map'
50patchMapNewElements :: PatchMap k v -> [v]
51patchMapNewElements (PatchMap p) = catMaybes $ Map.elems p
53-- | Returns all the new elements that will be added to the 'Map'
54patchMapNewElementsMap :: PatchMap k v -> Map k v
55patchMapNewElementsMap (PatchMap p) = Map.mapMaybe id p