git.iko.soy/patch
on 032e6b2 help sign in
patch/src/Reflex/Patch/IntMap.hs
67 lines 3.1 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE DeriveFoldable #-}
3{-# LANGUAGE DeriveFunctor #-}
4{-# LANGUAGE DeriveTraversable #-}
5{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6{-# LANGUAGE TypeFamilies #-}
7-- | Module containing 'PatchIntMap', a 'Patch' for 'IntMap' which allows for
8-- insert/update or delete of associations.
9module Reflex.Patch.IntMap where
11import Data.IntMap.Strict (IntMap)
12import qualified Data.IntMap.Strict as IntMap
13import Data.Maybe
14import Data.Semigroup
15import Reflex.Patch.Class
17-- | 'Patch' for 'IntMap' which represents insertion or deletion of keys in the mapping.
18-- Internally represented by 'IntMap (Maybe a)', where @Just@ means insert/update
19-- and @Nothing@ means delete.
20newtype PatchIntMap a = PatchIntMap (IntMap (Maybe a)) deriving (Functor, Foldable, Traversable, Monoid)
22-- | Apply the insertions or deletions to a given 'IntMap'.
23instance Patch (PatchIntMap a) where
24 type PatchTarget (PatchIntMap a) = IntMap a
25 apply (PatchIntMap p) v = if IntMap.null p then Nothing else Just $
26 let removes = IntMap.filter isNothing p
27 adds = IntMap.mapMaybe id p
28 in IntMap.union adds $ v `IntMap.difference` removes
30-- | @a <> b@ will apply the changes of @b@ and then apply the changes of @a@.
31-- If the same key is modified by both patches, the one on the left will take
32-- precedence.
33instance Semigroup (PatchIntMap v) where
34 PatchIntMap a <> PatchIntMap b = PatchIntMap $ a `mappend` b --TODO: Add a semigroup instance for Map
35 -- PatchMap is idempotent, so stimes n is id for every n
36#if MIN_VERSION_semigroups(0,17,0)
37 stimes = stimesIdempotentMonoid
38#else
39 times1p n x = case compare n 0 of
40 LT -> error "stimesIdempotentMonoid: negative multiplier"
41 EQ -> mempty
42 GT -> x
43#endif
45-- | Map a function @Int -> a -> b@ over all @a@s in the given @'PatchIntMap' a@
46-- (that is, all inserts/updates), producing a @PatchIntMap b@.
47mapIntMapPatchWithKey :: (Int -> a -> b) -> PatchIntMap a -> PatchIntMap b
48mapIntMapPatchWithKey f (PatchIntMap m) = PatchIntMap $ IntMap.mapWithKey (\ k mv -> f k <$> mv) m
50-- | Map an effectful function @Int -> a -> f b@ over all @a@s in the given @'PatchIntMap' a@
51-- (that is, all inserts/updates), producing a @f (PatchIntMap b)@.
52traverseIntMapPatchWithKey :: Applicative f => (Int -> a -> f b) -> PatchIntMap a -> f (PatchIntMap b)
53traverseIntMapPatchWithKey f (PatchIntMap m) = PatchIntMap <$> IntMap.traverseWithKey (\k mv -> traverse (f k) mv) m
55-- | Extract all @a@s inserted/updated by the given @'PatchIntMap' a@.
56patchIntMapNewElements :: PatchIntMap a -> [a]
57patchIntMapNewElements (PatchIntMap m) = catMaybes $ IntMap.elems m
59-- | Convert the given @'PatchIntMap' a@ into an @'IntMap' a@ with all
60-- the inserts/updates in the given patch.
61patchIntMapNewElementsMap :: PatchIntMap a -> IntMap a
62patchIntMapNewElementsMap (PatchIntMap m) = IntMap.mapMaybe id m
64-- | Subset the given @'IntMap' a@ to contain only the keys that would be
65-- deleted by the given @'PatchIntMap' a@.
66getDeletions :: PatchIntMap v -> IntMap v' -> IntMap v'
67getDeletions (PatchIntMap m) v = IntMap.intersection v m