git.iko.soy/patch
on 6ef716a help sign in
patch/src/Data/Patch/IntMap.hs
78 lines 3.3 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE DeriveTraversable #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5{-# LANGUAGE MultiParamTypeClasses #-}
6{-# LANGUAGE StandaloneDeriving #-}
7{-# LANGUAGE TemplateHaskell #-}
8{-# LANGUAGE TypeFamilies #-}
10-- | Module containing 'PatchIntMap', a 'Patch' for 'IntMap' which allows for
11-- insert/update or delete of associations.
12module Data.Patch.IntMap where
14import Control.Lens
15import Data.IntMap.Strict (IntMap)
16import qualified Data.IntMap.Strict as IntMap
17import Data.Maybe
18import Data.Monoid.DecidablyEmpty
19#if !MIN_VERSION_base(4,11,0)
20import Data.Semigroup (Semigroup (..))
21#endif
22import Data.Patch.Class
24-- | 'Patch' for 'IntMap' which represents insertion or deletion of keys in the mapping.
25-- Internally represented by 'IntMap (Maybe a)', where @Just@ means insert/update
26-- and @Nothing@ means delete.
27newtype PatchIntMap a = PatchIntMap { unPatchIntMap :: IntMap (Maybe a) }
28 deriving ( Show, Read, Eq, Ord
29 , Functor, Foldable, Traversable
30 , Monoid, DecidablyEmpty
31 )
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.
36deriving instance Semigroup (PatchIntMap v)
38makeWrapped ''PatchIntMap
40-- | Apply the insertions or deletions to a given 'IntMap'.
41instance PatchHet (PatchIntMap a) where
42 type PatchSource (PatchIntMap a) = IntMap a
43 type PatchTarget (PatchIntMap a) = IntMap a
44instance Patch (PatchIntMap a) where
45 apply (PatchIntMap p) v = if IntMap.null p then Nothing else Just $
46 let removes = IntMap.filter isNothing p
47 adds = IntMap.mapMaybe id p
48 in IntMap.union adds $ v `IntMap.difference` removes
50instance FunctorWithIndex Int PatchIntMap
51instance FoldableWithIndex Int PatchIntMap
52instance TraversableWithIndex Int PatchIntMap where
53 itraverse = itraversed . Indexed
54 itraversed = _Wrapped .> itraversed <. traversed
56-- | Map a function @Int -> a -> b@ over all @a@s in the given @'PatchIntMap' a@
57-- (that is, all inserts/updates), producing a @PatchIntMap b@.
58mapIntMapPatchWithKey :: (Int -> a -> b) -> PatchIntMap a -> PatchIntMap b
59mapIntMapPatchWithKey f (PatchIntMap m) = PatchIntMap $ IntMap.mapWithKey (\ k mv -> f k <$> mv) m
61-- | Map an effectful function @Int -> a -> f b@ over all @a@s in the given @'PatchIntMap' a@
62-- (that is, all inserts/updates), producing a @f (PatchIntMap b)@.
63traverseIntMapPatchWithKey :: Applicative f => (Int -> a -> f b) -> PatchIntMap a -> f (PatchIntMap b)
64traverseIntMapPatchWithKey f (PatchIntMap m) = PatchIntMap <$> IntMap.traverseWithKey (traverse . f) m
66-- | Extract all @a@s inserted/updated by the given @'PatchIntMap' a@.
67patchIntMapNewElements :: PatchIntMap a -> [a]
68patchIntMapNewElements (PatchIntMap m) = catMaybes $ IntMap.elems m
70-- | Convert the given @'PatchIntMap' a@ into an @'IntMap' a@ with all
71-- the inserts/updates in the given patch.
72patchIntMapNewElementsMap :: PatchIntMap a -> IntMap a
73patchIntMapNewElementsMap (PatchIntMap m) = IntMap.mapMaybe id m
75-- | Subset the given @'IntMap' a@ to contain only the keys that would be
76-- deleted by the given @'PatchIntMap' a@.
77getDeletions :: PatchIntMap v -> IntMap v' -> IntMap v'
78getDeletions (PatchIntMap m) v = IntMap.intersection v m