git.iko.soy/patch
on develop help sign in
patch/src/Data/Patch/DMap.hs
93 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)
18import Data.Dependent.Sum (DSum (..))
19import Data.GADT.Compare (GCompare (..))
20import qualified Data.Dependent.Map as DMap
21import Data.Functor.Constant
22import Data.Functor.Misc
23import qualified Data.IntMap as IntMap
24import qualified Data.Map as Map
25import Data.Monoid.DecidablyEmpty
26#if !MIN_VERSION_base(4,11,0)
27import Data.Semigroup (Semigroup (..))
28#endif
29import Data.Some (Some)
31-- | A set of changes to a 'DMap'. Any element may be inserted/updated or deleted.
32-- Insertions are represented as @'ComposeMaybe' (Just value)@,
33-- while deletions are represented as @'ComposeMaybe' Nothing@.
34newtype PatchDMap k v = PatchDMap { unPatchDMap :: DMap k (ComposeMaybe v) }
36deriving instance GCompare k => Semigroup (PatchDMap k v)
38deriving instance GCompare k => Monoid (PatchDMap k v)
40-- It won't let me derive for some reason
41instance GCompare k => DecidablyEmpty (PatchDMap k v) where
42 isEmpty (PatchDMap m) = DMap.null m
44-- | Apply the insertions or deletions to a given 'DMap'.
45instance GCompare k => Patch (PatchDMap k v) where
46 type PatchTarget (PatchDMap k v) = DMap k v
47 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?
48 where insertions = DMap.mapMaybeWithKey (const $ getComposeMaybe) diff
49 deletions = DMap.mapMaybeWithKey (const $ nothingToJust . getComposeMaybe) diff
50 nothingToJust = \case
51 Nothing -> Just $ Constant ()
52 Just _ -> Nothing
54-- | Map a function @v a -> v' a@ over any inserts/updates in the given
55-- @'PatchDMap' k v@ to produce a @'PatchDMap' k v'@.
56mapPatchDMap :: (forall a. v a -> v' a) -> PatchDMap k v -> PatchDMap k v'
57mapPatchDMap f (PatchDMap p) = PatchDMap $ DMap.map (ComposeMaybe . fmap f . getComposeMaybe) p
59-- | Map an effectful function @v a -> f (v' a)@ over any inserts/updates in the given
60-- @'PatchDMap' k v@ to produce a @'PatchDMap' k v'@.
61traversePatchDMap :: Applicative f => (forall a. v a -> f (v' a)) -> PatchDMap k v -> f (PatchDMap k v')
62traversePatchDMap f = traversePatchDMapWithKey $ const f
64-- | Map an effectful function @k a -> v a -> f (v' a)@ over any inserts/updates
65-- in the given @'PatchDMap' k v@ to produce a @'PatchDMap' k v'@.
66traversePatchDMapWithKey :: Applicative m => (forall a. k a -> v a -> m (v' a)) -> PatchDMap k v -> m (PatchDMap k v')
67traversePatchDMapWithKey f (PatchDMap p) = PatchDMap <$> DMap.traverseWithKey (\k (ComposeMaybe v) -> ComposeMaybe <$> traverse (f k) v) p
69-- | Weaken a @'PatchDMap' k v@ to a @'PatchMap' (Some k) v'@ using a function
70-- @v a -> v'@ to weaken each value contained in the patch.
71weakenPatchDMapWith :: (forall a. v a -> v') -> PatchDMap k v -> PatchMap (Some k) v'
72weakenPatchDMapWith f (PatchDMap p) = PatchMap $ weakenDMapWith (fmap f . getComposeMaybe) p
74-- | Convert a weak @'PatchDMap' ('Const2' k a) v@ where the @a@ is known by way of
75-- the @Const2@ into a @'PatchMap' k v'@ using a rank 1 function @v a -> v'@.
76patchDMapToPatchMapWith :: (v a -> v') -> PatchDMap (Const2 k a) v -> PatchMap k v'
77patchDMapToPatchMapWith f (PatchDMap p) = PatchMap $ dmapToMapWith (fmap f . getComposeMaybe) p
79-- | Convert a @'PatchMap' k v@ into a @'PatchDMap' ('Const2' k a) v'@ using a function @v -> v' a@.
80const2PatchDMapWith :: forall k v v' a. (v -> v' a) -> PatchMap k v -> PatchDMap (Const2 k a) v'
81const2PatchDMapWith f (PatchMap p) = PatchDMap $ DMap.fromDistinctAscList $ g <$> Map.toAscList p
82 where g :: (k, Maybe v) -> DSum (Const2 k a) (ComposeMaybe v')
83 g (k, e) = Const2 k :=> ComposeMaybe (f <$> e)
85-- | Convert a @'PatchIntMap' v@ into a @'PatchDMap' ('Const2' Int a) v'@ using a function @v -> v' a@.
86const2IntPatchDMapWith :: forall v f a. (v -> f a) -> PatchIntMap v -> PatchDMap (Const2 IntMap.Key a) f
87const2IntPatchDMapWith f (PatchIntMap p) = PatchDMap $ DMap.fromDistinctAscList $ g <$> IntMap.toAscList p
88 where g :: (IntMap.Key, Maybe v) -> DSum (Const2 IntMap.Key a) (ComposeMaybe f)
89 g (k, e) = Const2 k :=> ComposeMaybe (f <$> e)
91-- | Get the values that will be replaced or deleted if the given patch is applied to the given 'DMap'.
92getDeletions :: GCompare k => PatchDMap k v -> DMap k v' -> DMap k v'
93getDeletions (PatchDMap p) m = DMap.intersectionWithKey (\_ v _ -> v) m p