git.iko.soy/patch
on patch-dmap-reset help sign in
patch/src/Data/Patch/DMap.hs
82 lines 4.6 kB history raw
1{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2{-# LANGUAGE LambdaCase #-}
3{-# LANGUAGE PolyKinds #-}
4{-# LANGUAGE Rank2Types #-}
5{-# LANGUAGE ScopedTypeVariables #-}
6{-# LANGUAGE StandaloneDeriving #-}
7{-# LANGUAGE TypeFamilies #-}
8-- | 'Patch'es on 'DMap' that consist only of insertions (or overwrites) and deletions.
9module Data.Patch.DMap where
11import Data.Patch.Class
12import Data.Patch.IntMap
13import Data.Patch.Map
15import Data.Dependent.Map (DMap, DSum (..), GCompare (..))
16import qualified Data.Dependent.Map as DMap
17import Data.Functor.Constant
18import Data.Functor.Misc
19import qualified Data.IntMap as IntMap
20import qualified Data.Map as Map
21import Data.Semigroup (Semigroup (..))
22import Data.Some (Some)
24-- | A set of changes to a 'DMap'. Any element may be inserted/updated or deleted.
25-- Insertions are represented as @'ComposeMaybe' (Just value)@,
26-- while deletions are represented as @'ComposeMaybe' Nothing@.
27newtype PatchDMap k v = PatchDMap { unPatchDMap :: DMap k (ComposeMaybe v) }
29deriving instance GCompare k => Semigroup (PatchDMap k v)
31deriving instance GCompare k => Monoid (PatchDMap k v)
33-- | Apply the insertions or deletions to a given 'DMap'.
34instance GCompare k => Patch (PatchDMap k v) where
35 type PatchTarget (PatchDMap k v) = DMap k v
36 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?
37 where insertions = DMap.mapMaybeWithKey (const $ getComposeMaybe) diff
38 deletions = DMap.mapMaybeWithKey (const $ nothingToJust . getComposeMaybe) diff
39 nothingToJust = \case
40 Nothing -> Just $ Constant ()
41 Just _ -> Nothing
43-- | Map a function @v a -> v' a@ over any inserts/updates in the given
44-- @'PatchDMap' k v@ to produce a @'PatchDMap' k v'@.
45mapPatchDMap :: (forall a. v a -> v' a) -> PatchDMap k v -> PatchDMap k v'
46mapPatchDMap f (PatchDMap p) = PatchDMap $ DMap.map (ComposeMaybe . fmap f . getComposeMaybe) p
48-- | Map an effectful function @v a -> f (v' a)@ over any inserts/updates in the given
49-- @'PatchDMap' k v@ to produce a @'PatchDMap' k v'@.
50traversePatchDMap :: Applicative f => (forall a. v a -> f (v' a)) -> PatchDMap k v -> f (PatchDMap k v')
51traversePatchDMap f = traversePatchDMapWithKey $ const f
53-- | Map an effectful function @k a -> v a -> f (v' a)@ over any inserts/updates
54-- in the given @'PatchDMap' k v@ to produce a @'PatchDMap' k v'@.
55traversePatchDMapWithKey :: Applicative m => (forall a. k a -> v a -> m (v' a)) -> PatchDMap k v -> m (PatchDMap k v')
56traversePatchDMapWithKey f (PatchDMap p) = PatchDMap <$> DMap.traverseWithKey (\k (ComposeMaybe v) -> ComposeMaybe <$> traverse (f k) v) p
58-- | Weaken a @'PatchDMap' k v@ to a @'PatchMap' (Some k) v'@ using a function
59-- @v a -> v'@ to weaken each value contained in the patch.
60weakenPatchDMapWith :: (forall a. v a -> v') -> PatchDMap k v -> PatchMap (Some k) v'
61weakenPatchDMapWith f (PatchDMap p) = PatchMap $ weakenDMapWith (fmap f . getComposeMaybe) p
63-- | Convert a weak @'PatchDMap' ('Const2' k a) v@ where the @a@ is known by way of
64-- the @Const2@ into a @'PatchMap' k v'@ using a rank 1 function @v a -> v'@.
65patchDMapToPatchMapWith :: (v a -> v') -> PatchDMap (Const2 k a) v -> PatchMap k v'
66patchDMapToPatchMapWith f (PatchDMap p) = PatchMap $ dmapToMapWith (fmap f . getComposeMaybe) p
68-- | Convert a @'PatchMap' k v@ into a @'PatchDMap' ('Const2' k a) v'@ using a function @v -> v' a@.
69const2PatchDMapWith :: forall k v v' a. (v -> v' a) -> PatchMap k v -> PatchDMap (Const2 k a) v'
70const2PatchDMapWith f (PatchMap p) = PatchDMap $ DMap.fromDistinctAscList $ g <$> Map.toAscList p
71 where g :: (k, Maybe v) -> DSum (Const2 k a) (ComposeMaybe v')
72 g (k, e) = Const2 k :=> ComposeMaybe (f <$> e)
74-- | Convert a @'PatchIntMap' v@ into a @'PatchDMap' ('Const2' Int a) v'@ using a function @v -> v' a@.
75const2IntPatchDMapWith :: forall v f a. (v -> f a) -> PatchIntMap v -> PatchDMap (Const2 IntMap.Key a) f
76const2IntPatchDMapWith f (PatchIntMap p) = PatchDMap $ DMap.fromDistinctAscList $ g <$> IntMap.toAscList p
77 where g :: (IntMap.Key, Maybe v) -> DSum (Const2 IntMap.Key a) (ComposeMaybe f)
78 g (k, e) = Const2 k :=> ComposeMaybe (f <$> e)
80-- | Get the values that will be replaced or deleted if the given patch is applied to the given 'DMap'.
81getDeletions :: GCompare k => PatchDMap k v -> DMap k v' -> DMap k v'
82getDeletions (PatchDMap p) m = DMap.intersectionWithKey (\_ v _ -> v) m p