git.iko.soy/patch
on d2a1df7 help sign in
patch/src/Data/Patch/Map.hs
71 lines 2.9 kB history raw
1{-# LANGUAGE DeriveTraversable #-}
2{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4{-# LANGUAGE LambdaCase #-}
5{-# LANGUAGE MultiParamTypeClasses #-}
6{-# LANGUAGE StandaloneDeriving #-}
7{-# LANGUAGE TemplateHaskell #-}
8{-# LANGUAGE TypeFamilies #-}
10-- | 'Patch'es on 'Map' that consist only of insertions (including overwrites)
11-- and deletions
12module Data.Patch.Map where
14import Data.Patch.Class
16import Control.Lens
17import Data.Map (Map)
18import qualified Data.Map as Map
19import Data.Maybe
20import Data.Monoid.DecidablyEmpty
21import Data.Semigroup
23-- | A set of changes to a 'Map'. Any element may be inserted/updated or
24-- deleted. Insertions are represented as values wrapped in 'Just', while
25-- deletions are represented as 'Nothing's
26newtype PatchMap k v = PatchMap { unPatchMap :: Map k (Maybe v) }
27 deriving ( Show, Read, Eq, Ord
28 , Foldable, Traversable
29 , DecidablyEmpty
30 )
32-- | 'fmap'ping a 'PatchMap' will alter all of the values it will insert.
33-- Deletions are unaffected.
34deriving instance Functor (PatchMap k)
35-- | The empty 'PatchMap' contains no insertions or deletions
36deriving instance Ord k => Monoid (PatchMap k v)
38-- | @a <> b@ will apply the changes of @b@ and then apply the changes of @a@.
39-- If the same key is modified by both patches, the one on the left will take
40-- precedence.
41instance Ord k => Semigroup (PatchMap k v) where
42 PatchMap a <> PatchMap b = PatchMap $ a `mappend` b --TODO: Add a semigroup instance for Map
43 -- PatchMap is idempotent, so stimes n is id for every n
44 stimes = stimesIdempotentMonoid
46-- | Apply the insertions or deletions to a given 'Map'.
47instance Ord k => Patch (PatchMap k v) where
48 type PatchTarget (PatchMap k v) = Map k v
49 {-# INLINABLE apply #-}
50 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?
51 where insertions = Map.mapMaybeWithKey (const id) p
52 deletions = Map.mapMaybeWithKey (const nothingToJust) p
53 nothingToJust = \case
54 Nothing -> Just ()
55 Just _ -> Nothing
57instance FunctorWithIndex k (PatchMap k)
58instance FoldableWithIndex k (PatchMap k)
59instance TraversableWithIndex k (PatchMap k) where
60 itraverse = itraversed . Indexed
61 itraversed = _Wrapped .> itraversed <. traversed
63-- | Returns all the new elements that will be added to the 'Map'
64patchMapNewElements :: PatchMap k v -> [v]
65patchMapNewElements (PatchMap p) = catMaybes $ Map.elems p
67-- | Returns all the new elements that will be added to the 'Map'
68patchMapNewElementsMap :: PatchMap k v -> Map k v
69patchMapNewElementsMap (PatchMap p) = Map.mapMaybe id p
71makeWrapped ''PatchMap