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