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