git.iko.soy/patch
on baac813 help sign in
patch/src/Reflex/Patch/Map.hs
64 lines 2.6 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE LambdaCase #-}
3{-# LANGUAGE TypeFamilies #-}
4-- | 'Patch'es on 'Map' that consist only of insertions (including overwrites)
5-- and deletions
6module Reflex.Patch.Map where
8import Reflex.Patch.Class
10import Data.Map (Map)
11import qualified Data.Map as Map
12import Data.Maybe
13import Data.Semigroup
15-- | A set of changes to a 'Map'. Any element may be inserted/updated or
16-- deleted. Insertions are represented as values wrapped in 'Just', while
17-- deletions are represented as 'Nothing's
18newtype PatchMap k v = PatchMap { unPatchMap :: Map k (Maybe v) }
19 deriving (Show, Read, Eq, Ord)
21-- | Applying a 'PatchMap' will update the 'Map' by performing the insertions
22-- and deletions specified
23instance Ord k => Patch (PatchMap k v) where
24 type PatchTarget (PatchMap k v) = Map k v
25 {-# INLINABLE apply #-}
26 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?
27 where insertions = Map.mapMaybeWithKey (const id) p
28 deletions = Map.mapMaybeWithKey (const nothingToJust) p
29 nothingToJust = \case
30 Nothing -> Just ()
31 Just _ -> Nothing
33-- | @a <> b@ will apply the changes of @b@ and then apply the changes of @a@.
34-- If the same key is modified by both patches, the one on the left will take
35-- precedence.
36instance Ord k => Semigroup (PatchMap k v) where
37 PatchMap a <> PatchMap b = PatchMap $ a `mappend` b --TODO: Add a semigroup instance for Map
38 -- PatchMap is idempotent, so stimes n is id for every n
39#if MIN_VERSION_semigroups(0,17,0)
40 stimes = stimesIdempotentMonoid
41#else
42 times1p n x = case compare n 0 of
43 LT -> error "stimesIdempotentMonoid: negative multiplier"
44 EQ -> mempty
45 GT -> x
46#endif
48-- | The empty 'PatchMap' contains no insertions or deletions
49instance Ord k => Monoid (PatchMap k v) where
50 mempty = PatchMap mempty
51 mappend = (<>)
53-- | 'fmap'ping a 'PatchMap' will alter all of the values it will insert.
54-- Deletions are unaffected.
55instance Functor (PatchMap k) where
56 fmap f = PatchMap . fmap (fmap f) . unPatchMap
58-- | Returns all the new elements that will be added to the 'Map'
59patchMapNewElements :: PatchMap k v -> [v]
60patchMapNewElements (PatchMap p) = catMaybes $ Map.elems p
62-- | Returns all the new elements that will be added to the 'Map'
63patchMapNewElementsMap :: PatchMap k v -> Map k v
64patchMapNewElementsMap (PatchMap p) = Map.mapMaybe id p