git.iko.soy/patch
on 9fd59f3 help sign in
patch/src/Reflex/Patch/DMap.hs
61 lines 3.1 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.Map
13import Data.Dependent.Map (DMap, DSum (..), GCompare (..))
14import qualified Data.Dependent.Map as DMap
15import Data.Functor.Constant
16import Data.Functor.Misc
17import qualified Data.Map as Map
18import Data.Semigroup (Semigroup (..))
19import Data.Some (Some)
21-- | A set of changes to a 'DMap'. Any element may be inserted/updated or
22-- deleted.
23newtype PatchDMap k v = PatchDMap { unPatchDMap :: DMap k (ComposeMaybe v) }
25deriving instance GCompare k => Semigroup (PatchDMap k v)
27deriving instance GCompare k => Monoid (PatchDMap k v)
29instance GCompare k => Patch (PatchDMap k v) where
30 type PatchTarget (PatchDMap k v) = DMap k v
31 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?
32 where insertions = DMap.mapMaybeWithKey (const $ getComposeMaybe) diff
33 deletions = DMap.mapMaybeWithKey (const $ nothingToJust . getComposeMaybe) diff
34 nothingToJust = \case
35 Nothing -> Just $ Constant ()
36 Just _ -> Nothing
38mapPatchDMap :: (forall a. v a -> v' a) -> PatchDMap k v -> PatchDMap k v'
39mapPatchDMap f (PatchDMap p) = PatchDMap $ DMap.map (ComposeMaybe . fmap f . getComposeMaybe) p
41traversePatchDMap :: Applicative m => (forall a. v a -> m (v' a)) -> PatchDMap k v -> m (PatchDMap k v')
42traversePatchDMap f = traversePatchDMapWithKey $ const f
44traversePatchDMapWithKey :: Applicative m => (forall a. k a -> v a -> m (v' a)) -> PatchDMap k v -> m (PatchDMap k v')
45traversePatchDMapWithKey f (PatchDMap p) = PatchDMap <$> DMap.traverseWithKey (\k (ComposeMaybe v) -> ComposeMaybe <$> traverse (f k) v) p
47weakenPatchDMapWith :: (forall a. v a -> v') -> PatchDMap k v -> PatchMap (Some k) v'
48weakenPatchDMapWith f (PatchDMap p) = PatchMap $ weakenDMapWith (fmap f . getComposeMaybe) p
50patchDMapToPatchMapWith :: (f v -> v') -> PatchDMap (Const2 k v) f -> PatchMap k v'
51patchDMapToPatchMapWith f (PatchDMap p) = PatchMap $ dmapToMapWith (fmap f . getComposeMaybe) p
53const2PatchDMapWith :: forall k v f a. (v -> f a) -> PatchMap k v -> PatchDMap (Const2 k a) f
54const2PatchDMapWith f (PatchMap p) = PatchDMap $ DMap.fromDistinctAscList $ g <$> Map.toAscList p
55 where g :: (k, Maybe v) -> DSum (Const2 k a) (ComposeMaybe f)
56 g (k, e) = Const2 k :=> ComposeMaybe (f <$> e)
58-- | Get the values that will be deleted if the given patch is applied to the
59-- given 'DMap'. Includes values that will be replaced.
60getDeletions :: GCompare k => PatchDMap k v -> DMap k v' -> DMap k v'
61getDeletions (PatchDMap p) m = DMap.intersectionWithKey (\_ v _ -> v) m p