git.iko.soy/patch
on 2d67124 help sign in
patch/src/Reflex/Patch/DMap.hs
68 lines 3.5 kB history raw
1{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2{-# LANGUAGE LambdaCase #-}
3{-# LANGUAGE PolyKinds #-}
4{-# LANGUAGE Rank2Types #-}
5{-# LANGUAGE ScopedTypeVariables #-}
6{-# LANGUAGE StandaloneDeriving #-}
7{-# LANGUAGE TypeFamilies #-}
8module Reflex.Patch.DMap where
10import Reflex.Patch.Class
11import Reflex.Patch.IntMap
12import Reflex.Patch.Map
14import Data.Dependent.Map (DMap, DSum (..), GCompare (..))
15import qualified Data.Dependent.Map as DMap
16import Data.Functor.Constant
17import Data.Functor.Misc
18import qualified Data.IntMap as IntMap
19import qualified Data.Map as Map
20import Data.Semigroup (Semigroup (..))
21import Data.Some (Some)
23-- | A set of changes to a 'DMap'. Any element may be inserted/updated or
24-- deleted.
25newtype PatchDMap k v = PatchDMap { unPatchDMap :: DMap k (ComposeMaybe v) }
27deriving instance GCompare k => Semigroup (PatchDMap k v)
29deriving instance GCompare k => Monoid (PatchDMap k v)
31instance GCompare k => Patch (PatchDMap k v) where
32 type PatchTarget (PatchDMap k v) = DMap k v
33 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?
34 where insertions = DMap.mapMaybeWithKey (const $ getComposeMaybe) diff
35 deletions = DMap.mapMaybeWithKey (const $ nothingToJust . getComposeMaybe) diff
36 nothingToJust = \case
37 Nothing -> Just $ Constant ()
38 Just _ -> Nothing
40mapPatchDMap :: (forall a. v a -> v' a) -> PatchDMap k v -> PatchDMap k v'
41mapPatchDMap f (PatchDMap p) = PatchDMap $ DMap.map (ComposeMaybe . fmap f . getComposeMaybe) p
43traversePatchDMap :: Applicative m => (forall a. v a -> m (v' a)) -> PatchDMap k v -> m (PatchDMap k v')
44traversePatchDMap f = traversePatchDMapWithKey $ const f
46traversePatchDMapWithKey :: Applicative m => (forall a. k a -> v a -> m (v' a)) -> PatchDMap k v -> m (PatchDMap k v')
47traversePatchDMapWithKey f (PatchDMap p) = PatchDMap <$> DMap.traverseWithKey (\k (ComposeMaybe v) -> ComposeMaybe <$> traverse (f k) v) p
49weakenPatchDMapWith :: (forall a. v a -> v') -> PatchDMap k v -> PatchMap (Some k) v'
50weakenPatchDMapWith f (PatchDMap p) = PatchMap $ weakenDMapWith (fmap f . getComposeMaybe) p
52patchDMapToPatchMapWith :: (f v -> v') -> PatchDMap (Const2 k v) f -> PatchMap k v'
53patchDMapToPatchMapWith f (PatchDMap p) = PatchMap $ dmapToMapWith (fmap f . getComposeMaybe) p
55const2PatchDMapWith :: forall k v f a. (v -> f a) -> PatchMap k v -> PatchDMap (Const2 k a) f
56const2PatchDMapWith f (PatchMap p) = PatchDMap $ DMap.fromDistinctAscList $ g <$> Map.toAscList p
57 where g :: (k, Maybe v) -> DSum (Const2 k a) (ComposeMaybe f)
58 g (k, e) = Const2 k :=> ComposeMaybe (f <$> e)
60const2IntPatchDMapWith :: forall v f a. (v -> f a) -> PatchIntMap v -> PatchDMap (Const2 IntMap.Key a) f
61const2IntPatchDMapWith f (PatchIntMap p) = PatchDMap $ DMap.fromDistinctAscList $ g <$> IntMap.toAscList p
62 where g :: (IntMap.Key, Maybe v) -> DSum (Const2 IntMap.Key a) (ComposeMaybe f)
63 g (k, e) = Const2 k :=> ComposeMaybe (f <$> e)
65-- | Get the values that will be deleted if the given patch is applied to the
66-- given 'DMap'. Includes values that will be replaced.
67getDeletions :: GCompare k => PatchDMap k v -> DMap k v' -> DMap k v'
68getDeletions (PatchDMap p) m = DMap.intersectionWithKey (\_ v _ -> v) m p