src/Reflex/Patch/IntMap.hs · patch

on 9813f90 help sign in

49 lines 1.9 kB history raw

1{-# LANGUAGE CPP #-}

2{-# LANGUAGE DeriveFoldable #-}

3{-# LANGUAGE DeriveFunctor #-}

4{-# LANGUAGE DeriveTraversable #-}

5{-# LANGUAGE GeneralizedNewtypeDeriving #-}

6{-# LANGUAGE TypeFamilies #-}

7module Reflex.Patch.IntMap where

9import Data.IntMap.Strict (IntMap)

10import qualified Data.IntMap.Strict as IntMap

11import Data.Maybe

12import Data.Semigroup

13import Reflex.Patch.Class

15newtype PatchIntMap a = PatchIntMap (IntMap (Maybe a)) deriving (Functor, Foldable, Traversable, Monoid)

17instance Patch (PatchIntMap a) where

18 type PatchTarget (PatchIntMap a) = IntMap a

19 apply (PatchIntMap p) v = if IntMap.null p then Nothing else Just $

20 let removes = IntMap.filter isNothing p

21 adds = IntMap.mapMaybe id p

22 in IntMap.union adds $ v `IntMap.difference` removes

24-- | @a <> b@ will apply the changes of @b@ and then apply the changes of @a@.

25-- If the same key is modified by both patches, the one on the left will take

26-- precedence.

27instance Semigroup (PatchIntMap v) where

28 PatchIntMap a <> PatchIntMap b = PatchIntMap $ a `mappend` b --TODO: Add a semigroup instance for Map

29 -- PatchMap is idempotent, so stimes n is id for every n

30#if MIN_VERSION_semigroups(0,17,0)

31 stimes = stimesIdempotentMonoid

32#else

33 times1p n x = case compare n 0 of

34 LT -> error "stimesIdempotentMonoid: negative multiplier"

35 EQ -> mempty

36 GT -> x

37#endif

39traverseIntMapPatchWithKey :: Applicative t => (Int -> a -> t b) -> PatchIntMap a -> t (PatchIntMap b)

40traverseIntMapPatchWithKey f (PatchIntMap m) = PatchIntMap <$> IntMap.traverseWithKey (\k mv -> traverse (f k) mv) m

42patchIntMapNewElements :: PatchIntMap a -> [a]

43patchIntMapNewElements (PatchIntMap m) = catMaybes $ IntMap.elems m

45patchIntMapNewElementsMap :: PatchIntMap a -> IntMap a

46patchIntMapNewElementsMap (PatchIntMap m) = IntMap.mapMaybe id m

48getDeletions :: PatchIntMap v -> IntMap v' -> IntMap v'

49getDeletions (PatchIntMap m) v = IntMap.intersection v m