git.iko.soy/patch
on b2e2856 help sign in
patch/src/Data/Patch/DMap.hs
91 lines 4.9 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3{-# LANGUAGE LambdaCase #-}
4{-# LANGUAGE PolyKinds #-}
5{-# LANGUAGE Rank2Types #-}
6{-# LANGUAGE ScopedTypeVariables #-}
7{-# LANGUAGE StandaloneDeriving #-}
8{-# LANGUAGE TypeFamilies #-}
10-- | 'Patch'es on 'DMap' that consist only of insertions (or overwrites) and deletions.
11module Data.Patch.DMap where
13import Data.Patch.Class
14import Data.Patch.IntMap
15import Data.Patch.Map
17import Data.Dependent.Map (DMap, DSum (..), GCompare (..))
18import qualified Data.Dependent.Map as DMap
19import Data.Functor.Constant
20import Data.Functor.Misc
21import qualified Data.IntMap as IntMap
22import qualified Data.Map as Map
23import Data.Monoid.DecidablyEmpty
24#if !MIN_VERSION_base(4,11,0)
25import Data.Semigroup (Semigroup (..))
26#endif
27import Data.Some (Some)
29-- | A set of changes to a 'DMap'. Any element may be inserted/updated or deleted.
30-- Insertions are represented as @'ComposeMaybe' (Just value)@,
31-- while deletions are represented as @'ComposeMaybe' Nothing@.
32newtype PatchDMap k v = PatchDMap { unPatchDMap :: DMap k (ComposeMaybe v) }
34deriving instance GCompare k => Semigroup (PatchDMap k v)
36deriving instance GCompare k => Monoid (PatchDMap k v)
38-- It won't let me derive for some reason
39instance GCompare k => DecidablyEmpty (PatchDMap k v) where
40 isEmpty (PatchDMap m) = DMap.null m
42-- | Apply the insertions or deletions to a given 'DMap'.
43instance GCompare k => Patch (PatchDMap k v) where
44 type PatchTarget (PatchDMap k v) = DMap k v
45 apply (PatchDMap diff) old = Just $! insertions `DMap.union` (old `DMap.difference` deletions) --TODO: return Nothing sometimes --Note: the strict application here is critical to ensuring that incremental merges don't hold onto all their prerequisite events forever; can we make this more robust?
46 where insertions = DMap.mapMaybeWithKey (const $ getComposeMaybe) diff
47 deletions = DMap.mapMaybeWithKey (const $ nothingToJust . getComposeMaybe) diff
48 nothingToJust = \case
49 Nothing -> Just $ Constant ()
50 Just _ -> Nothing
52-- | Map a function @v a -> v' a@ over any inserts/updates in the given
53-- @'PatchDMap' k v@ to produce a @'PatchDMap' k v'@.
54mapPatchDMap :: (forall a. v a -> v' a) -> PatchDMap k v -> PatchDMap k v'
55mapPatchDMap f (PatchDMap p) = PatchDMap $ DMap.map (ComposeMaybe . fmap f . getComposeMaybe) p
57-- | Map an effectful function @v a -> f (v' a)@ over any inserts/updates in the given
58-- @'PatchDMap' k v@ to produce a @'PatchDMap' k v'@.
59traversePatchDMap :: Applicative f => (forall a. v a -> f (v' a)) -> PatchDMap k v -> f (PatchDMap k v')
60traversePatchDMap f = traversePatchDMapWithKey $ const f
62-- | Map an effectful function @k a -> v a -> f (v' a)@ over any inserts/updates
63-- in the given @'PatchDMap' k v@ to produce a @'PatchDMap' k v'@.
64traversePatchDMapWithKey :: Applicative m => (forall a. k a -> v a -> m (v' a)) -> PatchDMap k v -> m (PatchDMap k v')
65traversePatchDMapWithKey f (PatchDMap p) = PatchDMap <$> DMap.traverseWithKey (\k (ComposeMaybe v) -> ComposeMaybe <$> traverse (f k) v) p
67-- | Weaken a @'PatchDMap' k v@ to a @'PatchMap' (Some k) v'@ using a function
68-- @v a -> v'@ to weaken each value contained in the patch.
69weakenPatchDMapWith :: (forall a. v a -> v') -> PatchDMap k v -> PatchMap (Some k) v'
70weakenPatchDMapWith f (PatchDMap p) = PatchMap $ weakenDMapWith (fmap f . getComposeMaybe) p
72-- | Convert a weak @'PatchDMap' ('Const2' k a) v@ where the @a@ is known by way of
73-- the @Const2@ into a @'PatchMap' k v'@ using a rank 1 function @v a -> v'@.
74patchDMapToPatchMapWith :: (v a -> v') -> PatchDMap (Const2 k a) v -> PatchMap k v'
75patchDMapToPatchMapWith f (PatchDMap p) = PatchMap $ dmapToMapWith (fmap f . getComposeMaybe) p
77-- | Convert a @'PatchMap' k v@ into a @'PatchDMap' ('Const2' k a) v'@ using a function @v -> v' a@.
78const2PatchDMapWith :: forall k v v' a. (v -> v' a) -> PatchMap k v -> PatchDMap (Const2 k a) v'
79const2PatchDMapWith f (PatchMap p) = PatchDMap $ DMap.fromDistinctAscList $ g <$> Map.toAscList p
80 where g :: (k, Maybe v) -> DSum (Const2 k a) (ComposeMaybe v')
81 g (k, e) = Const2 k :=> ComposeMaybe (f <$> e)
83-- | Convert a @'PatchIntMap' v@ into a @'PatchDMap' ('Const2' Int a) v'@ using a function @v -> v' a@.
84const2IntPatchDMapWith :: forall v f a. (v -> f a) -> PatchIntMap v -> PatchDMap (Const2 IntMap.Key a) f
85const2IntPatchDMapWith f (PatchIntMap p) = PatchDMap $ DMap.fromDistinctAscList $ g <$> IntMap.toAscList p
86 where g :: (IntMap.Key, Maybe v) -> DSum (Const2 IntMap.Key a) (ComposeMaybe f)
87 g (k, e) = Const2 k :=> ComposeMaybe (f <$> e)
89-- | Get the values that will be replaced or deleted if the given patch is applied to the given 'DMap'.
90getDeletions :: GCompare k => PatchDMap k v -> DMap k v' -> DMap k v'
91getDeletions (PatchDMap p) m = DMap.intersectionWithKey (\_ v _ -> v) m p