src/Reflex/Patch/IntMap.hs · patch

on 278f4cf help sign in

50 lines 2.0 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 Prelude hiding (lookup)

14import Reflex.Patch.Class

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

18instance Patch (PatchIntMap a) where

19 type PatchTarget (PatchIntMap a) = IntMap a

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

21 let removes = IntMap.filter isNothing p

22 adds = IntMap.mapMaybe id p

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

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.

28instance 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#if MIN_VERSION_semigroups(0,17,0)

32 stimes = stimesIdempotentMonoid

33#else

34 times1p n x = case compare n 0 of

35 LT -> error "stimesIdempotentMonoid: negative multiplier"

36 EQ -> mempty

37 GT -> x

38#endif

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

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

43patchIntMapNewElements :: PatchIntMap a -> [a]

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

46patchIntMapNewElementsMap :: PatchIntMap a -> IntMap a

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

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

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