53bfa66 · patch · git.iko.soy

git.iko.soy/patch

on develop help sign in

Merge pull request #195 from reflex-frp/rmm-docallthethings2

53bfa66Luigy Leon8 years ago

src/Data/Map/Misc.hs+24−9

compare with develop

unifiedsplit

@@ -1,4 +1,5 @@

1{-# LANGUAGE LambdaCase #-}

2+-- | Additional functions for manipulating 'Map's.

2module Data.Map.Misc

3module Data.Map.Misc

3 (

4 (

4 -- * Working with Maps

5 -- * Working with Maps

@@ -10,7 +11,6 @@ module Data.Map.Misc

10 ) where

11 ) where

12import Data.Align

13import Data.Align

13−import Data.Either (isLeft)

14import Data.Map (Map)

15import qualified Data.Map as Map

16import Data.Maybe

@@ -18,12 +18,21 @@ import Data.Set (Set)

18import qualified Data.Set as Set

19import Data.These

21+-- |Produce a @'Map' k (Maybe v)@ by comparing two @'Map' k v@s, @old@ and @new@ respectively. @Just@ represents an association present in @new@ and @Nothing@

22+-- represents an association only present in @old@ but no longer present in @new@.

23+--

24+-- Similar to 'diffMap' but doesn't require 'Eq' on the values, thus can't tell if a value has changed or not.

21diffMapNoEq :: (Ord k) => Map k v -> Map k v -> Map k (Maybe v)

25diffMapNoEq :: (Ord k) => Map k v -> Map k v -> Map k (Maybe v)

22diffMapNoEq olds news = flip Map.mapMaybe (align olds news) $ \case

26diffMapNoEq olds news = flip Map.mapMaybe (align olds news) $ \case

23 This _ -> Just Nothing

27 This _ -> Just Nothing

24 These _ new -> Just $ Just new

28 These _ new -> Just $ Just new

25 That new -> Just $ Just new

29 That new -> Just $ Just new

31+-- |Produce a @'Map' k (Maybe v)@ by comparing two @'Map' k v@s, @old@ and @new respectively. @Just@ represents an association present in @new@ and either not

32+-- present in @old@ or where the value has changed. @Nothing@ represents an association only present in @old@ but no longer present in @new@.

33+--

34+-- See also 'diffMapNoEq' for a similar but weaker version which does not require 'Eq' on the values but thus can't indicated a value not changing between

35+-- @old@ and @new@ with @Nothing@.

27diffMap :: (Ord k, Eq v) => Map k v -> Map k v -> Map k (Maybe v)

36diffMap :: (Ord k, Eq v) => Map k v -> Map k v -> Map k (Maybe v)

28diffMap olds news = flip Map.mapMaybe (align olds news) $ \case

37diffMap olds news = flip Map.mapMaybe (align olds news) $ \case

29 This _ -> Just Nothing

38 This _ -> Just Nothing

@@ -32,6 +41,9 @@ diffMap olds news = flip Map.mapMaybe (align olds news) $ \case

32 | otherwise -> Just $ Just new

41 | otherwise -> Just $ Just new

33 That new -> Just $ Just new

42 That new -> Just $ Just new

44+-- |Given a @'Map' k (Maybe v)@ representing keys to insert/update (@Just@) or delete (@Nothing@), produce a new map from the given input @'Map' k v@.

45+--

46+-- See also 'Reflex.Patch.Map' and 'Reflex.Patch.MapWithMove'.

35applyMap :: Ord k => Map k (Maybe v) -> Map k v -> Map k v

47applyMap :: Ord k => Map k (Maybe v) -> Map k v -> Map k v

36applyMap patch old = insertions `Map.union` (old `Map.difference` deletions)

48applyMap patch old = insertions `Map.union` (old `Map.difference` deletions)

37 where (deletions, insertions) = mapPartitionEithers $ maybeToEither <$> patch

49 where (deletions, insertions) = mapPartitionEithers $ maybeToEither <$> patch

@@ -39,16 +51,19 @@ applyMap patch old = insertions `Map.union` (old `Map.difference` deletions)

39 Nothing -> Left ()

51 Nothing -> Left ()

40 Just r -> Right r

52 Just r -> Right r

54+-- |Split a @'Map' k (Either a b)@ into @Map k a@ and @Map k b@, equivalent to @'Map.mapEither' id@

42mapPartitionEithers :: Map k (Either a b) -> (Map k a, Map k b)

55mapPartitionEithers :: Map k (Either a b) -> (Map k a, Map k b)

43−mapPartitionEithers m = (fromLeft <$> ls, fromRight <$> rs)

56+mapPartitionEithers = Map.mapEither id

44− where (ls, rs) = Map.partition isLeft m

45− fromLeft (Left l) = l

46− fromLeft _ = error "mapPartitionEithers: fromLeft received a Right value; this should be impossible"

47− fromRight (Right r) = r

48− fromRight _ = error "mapPartitionEithers: fromRight received a Left value; this should be impossible"

50−-- | Apply a map patch to a set

58+-- |Given a @'Map' k (Maybe v)@ representing keys to insert/update (@Just@) or delete (@Nothing@), produce a new @'Set' k@ from the given input set.

59+--

60+-- Equivalent to:

61+--

62+-- @

51−-- > applyMapKeysSet patch (Map.keysSet m) == Map.keysSet (applyMap patch m)

63+-- applyMapKeysSet patch ('Map.keysSet' m) == 'Map.keysSet' ('applyMap' patch m)

64+-- @

65+--

66+-- but avoids the intervening @Map@ and needs no values.

52applyMapKeysSet :: Ord k => Map k (Maybe v) -> Set k -> Set k

67applyMapKeysSet :: Ord k => Map k (Maybe v) -> Set k -> Set k

53applyMapKeysSet patch old = Map.keysSet insertions `Set.union` (old `Set.difference` Map.keysSet deletions)

68applyMapKeysSet patch old = Map.keysSet insertions `Set.union` (old `Set.difference` Map.keysSet deletions)

54 where (insertions, deletions) = Map.partition isJust patch

69 where (insertions, deletions) = Map.partition isJust patch

src/Reflex/FastWeak.hs+55−5

@@ -5,6 +5,15 @@

5{-# LANGUAGE ForeignFunctionInterface #-}

6{-# LANGUAGE JavaScriptFFI #-}

7#endif

9+-- | 'FastWeak' is a weak pointer to some value, and 'FastWeakTicket' ensures the value

10+-- referred to by a 'FastWeak' stays live while the ticket is held (live).

11+--

12+-- On GHC or GHCJS when not built with the @fast-weak@ cabal flag, 'FastWeak' is a wrapper

13+-- around the simple version of 'System.Mem.Weak.Weak' where the key and value are the same.

14+--

15+-- On GHCJS when built with the @fast-weak@ cabal flag, 'FastWeak' is implemented directly

16+-- in JS using @h$FastWeak@ and @h$FastWeakTicket@ which are a nonstandard part of the GHCJS RTS.

8module Reflex.FastWeak

17module Reflex.FastWeak

9 ( FastWeakTicket

18 ( FastWeakTicket

10 , FastWeak

19 , FastWeak

@@ -35,29 +44,57 @@ import System.Mem.Weak

37#ifdef GHCJS_FAST_WEAK

46#ifdef GHCJS_FAST_WEAK

47+-- | A 'FastWeak' which has been promoted to a strong reference. 'getFastWeakTicketValue'

48+-- can be used to get the referred to value without fear of @Nothing,

49+-- and 'getFastWeakTicketWeak' can be used to get the weak version.

50+--

51+-- Implemented by way of special support in the GHCJS RTS, @h$FastWeakTicket@.

38newtype FastWeakTicket a = FastWeakTicket JSVal

52newtype FastWeakTicket a = FastWeakTicket JSVal

54+-- | A reference to some value which can be garbage collected if there are only

55+-- weak references to the value left.

56+--

57+-- 'getFastWeakValue' can be used to try and obtain a strong reference to the value.

58+--

59+-- The value in a @FastWeak@ can also be kept alive by obtaining a 'FastWeakTicket' using

60+-- 'getFastWeakTicket' if the value hasn't been collected yet.

61+--

62+-- Implemented by way of special support in the GHCJS RTS, @h$FastWeak@.

40newtype FastWeak a = FastWeak JSVal

63newtype FastWeak a = FastWeak JSVal

42-- Just designed to mirror JSVal, so that we can unsafeCoerce between the two

65-- Just designed to mirror JSVal, so that we can unsafeCoerce between the two

43data Val a = Val { unVal :: a }

66data Val a = Val { unVal :: a }

45−-- | Coerce a JSVal that represents the heap object of a value of type 'a' into a value of type 'a'

68+-- | Coerce a JSVal that represents the heap object of a value of type @a@ into a value of type @a@

46unsafeFromRawJSVal :: JSVal -> a

69unsafeFromRawJSVal :: JSVal -> a

47unsafeFromRawJSVal v = unVal (unsafeCoerce v)

70unsafeFromRawJSVal v = unVal (unsafeCoerce v)

72+-- | Coerce a heap object of type @a@ into a 'JSVal' which represents that object.

49unsafeToRawJSVal :: a -> JSVal

73unsafeToRawJSVal :: a -> JSVal

50unsafeToRawJSVal v = unsafeCoerce (Val v)

74unsafeToRawJSVal v = unsafeCoerce (Val v)

51#else

75#else

76+-- | A 'FastWeak' which has been promoted to a strong reference. 'getFastWeakTicketValue'

77+-- can be used to get the referred to value without fear of @Nothing@,

78+-- and 'getFastWeakTicketWeak' can be used to get the weak version.

52data FastWeakTicket a = FastWeakTicket

79data FastWeakTicket a = FastWeakTicket

53 { _fastWeakTicket_val :: !a

80 { _fastWeakTicket_val :: !a

54 , _fastWeakTicket_weak :: {-# UNPACK #-} !(Weak a)

81 , _fastWeakTicket_weak :: {-# UNPACK #-} !(Weak a)

55 }

82 }

84+-- | A reference to some value which can be garbage collected if there are only weak references to the value left.

85+--

86+-- 'getFastWeakValue' can be used to try and obtain a strong reference to the value.

87+--

88+-- The value in a @FastWeak@ can also be kept alive by obtaining a 'FastWeakTicket' using 'getFastWeakTicket'

89+-- if the value hasn't been collected yet.

90+--

91+-- Synonymous with 'Weak'.

57type FastWeak a = Weak a

92type FastWeak a = Weak a

58#endif

93#endif

95+-- | Return the @a@ kept alive by the given 'FastWeakTicket'.

96+--

60−-- This needs to be in IO so we know that we've relinquished the ticket

97+-- This needs to be in IO so we know that we've relinquished the ticket.

61getFastWeakTicketValue :: FastWeakTicket a -> IO a

98getFastWeakTicketValue :: FastWeakTicket a -> IO a

62#ifdef GHCJS_FAST_WEAK

99#ifdef GHCJS_FAST_WEAK

63getFastWeakTicketValue t = do

100getFastWeakTicketValue t = do

@@ -69,6 +106,8 @@ foreign import javascript unsafe "$r = $1.val;" js_ticketVal :: FastWeakTicket a

69getFastWeakTicketValue = return . _fastWeakTicket_val

106getFastWeakTicketValue = return . _fastWeakTicket_val

70#endif

107#endif

108

109+-- | Get the value referred to by a 'FastWeak' if it hasn't yet been collected,

110+-- or @Nothing@ if it has been collected.

72getFastWeakValue :: FastWeak a -> IO (Maybe a)

111getFastWeakValue :: FastWeak a -> IO (Maybe a)

73#ifdef GHCJS_FAST_WEAK

112#ifdef GHCJS_FAST_WEAK

74getFastWeakValue w = do

113getFastWeakValue w = do

@@ -84,6 +123,9 @@ foreign import javascript unsafe "$r = ($1.ticket === null) ? null : $1.ticket.v

84getFastWeakValue = deRefWeak

123getFastWeakValue = deRefWeak

85#endif

124#endif

125

126+-- | Try to create a 'FastWeakTicket' for the given 'FastWeak' which will ensure the value referred

127+-- remains alive. Returns @Just@ if the value hasn't been collected

128+-- and a ticket can therefore be obtained, @Nothing@ if it's been collected.

87getFastWeakTicket :: forall a. FastWeak a -> IO (Maybe (FastWeakTicket a))

129getFastWeakTicket :: forall a. FastWeak a -> IO (Maybe (FastWeakTicket a))

88#ifdef GHCJS_FAST_WEAK

130#ifdef GHCJS_FAST_WEAK

89getFastWeakTicket w = do

131getFastWeakTicket w = do

@@ -103,8 +145,11 @@ getFastWeakTicket w = do

103 }

145 }

104#endif

146#endif

105

147

106−-- I think it's fine if this is lazy - it'll retain the 'a', but so would the output; we just need to make sure it's forced before we start relying on the associated FastWeak to actually be weak

148+-- | Create a 'FastWeakTicket' directly from a value, creating a 'FastWeak' in the process

149+-- which can be obtained with 'getFastWeakTicketValue'.

107mkFastWeakTicket :: a -> IO (FastWeakTicket a)

150mkFastWeakTicket :: a -> IO (FastWeakTicket a)

151+-- I think it's fine if this is lazy - it'll retain the 'a', but so would the output; we just need to make sure it's forced before we start relying on the

152+-- associated FastWeak to actually be weak

108#ifdef GHCJS_FAST_WEAK

153#ifdef GHCJS_FAST_WEAK

109mkFastWeakTicket v = js_fastWeakTicket (unsafeToRawJSVal v)

154mkFastWeakTicket v = js_fastWeakTicket (unsafeToRawJSVal v)

110

155

@@ -119,11 +164,16 @@ mkFastWeakTicket v = do

119 }

164 }

120#endif

165#endif

121

166

167+-- | Demote a 'FastWeakTicket'; which ensures the value is alive, to a 'FastWeak' which doesn't.

168+-- Note that unless the ticket for the same 'FastWeak' is held in some other way

169+-- the value might be collected immediately.

170+getFastWeakTicketWeak :: FastWeakTicket a -> IO (FastWeak a)

122-- Needs IO so that it can force the value - otherwise, could end up with a reference to the Ticket, which would retain the value

171-- Needs IO so that it can force the value - otherwise, could end up with a reference to the Ticket, which would retain the value

123#ifdef GHCJS_FAST_WEAK

172#ifdef GHCJS_FAST_WEAK

124−foreign import javascript unsafe "$r = $1.weak;" getFastWeakTicketWeak :: FastWeakTicket a -> IO (FastWeak a)

173+foreign import javascript unsafe "$r = $1.weak;" getFastWeakTicketWeak' :: FastWeakTicket a -> IO (FastWeak a)

174+{-# INLINE getFastWeakTicketWeak #-}

175+getFastWeakTicketWeak = getFastWeakTicketWeak'

125#else

176#else

126−getFastWeakTicketWeak :: FastWeakTicket a -> IO (FastWeak a)

127getFastWeakTicketWeak = return . _fastWeakTicket_weak

177getFastWeakTicketWeak = return . _fastWeakTicket_weak

128#endif

178#endif

129

179

src/Reflex/Patch/DMap.hs+22−8

@@ -5,6 +5,7 @@

5{-# LANGUAGE ScopedTypeVariables #-}

6{-# LANGUAGE StandaloneDeriving #-}

7{-# LANGUAGE TypeFamilies #-}

8+-- | 'Patch'es on 'DMap' that consist only of insertions (or overwrites) and deletions.

8module Reflex.Patch.DMap where

9module Reflex.Patch.DMap where

10import Reflex.Patch.Class

11import Reflex.Patch.Class

@@ -20,14 +21,16 @@ import qualified Data.Map as Map

20import Data.Semigroup (Semigroup (..))

21import Data.Semigroup (Semigroup (..))

21import Data.Some (Some)

22import Data.Some (Some)

23−-- | A set of changes to a 'DMap'. Any element may be inserted/updated or

24+-- | A set of changes to a 'DMap'. Any element may be inserted/updated or deleted.

24−-- deleted.

25+-- Insertions are represented as @'ComposeMaybe' (Just value)@,

26+-- while deletions are represented as @'ComposeMaybe' Nothing@.

25newtype PatchDMap k v = PatchDMap { unPatchDMap :: DMap k (ComposeMaybe v) }

27newtype PatchDMap k v = PatchDMap { unPatchDMap :: DMap k (ComposeMaybe v) }

27deriving instance GCompare k => Semigroup (PatchDMap k v)

29deriving instance GCompare k => Semigroup (PatchDMap k v)

29deriving instance GCompare k => Monoid (PatchDMap k v)

31deriving instance GCompare k => Monoid (PatchDMap k v)

33+-- | Apply the insertions or deletions to a given 'DMap'.

31instance GCompare k => Patch (PatchDMap k v) where

34instance GCompare k => Patch (PatchDMap k v) where

32 type PatchTarget (PatchDMap k v) = DMap k v

35 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?

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,32 +40,43 @@ instance GCompare k => Patch (PatchDMap k v) where

37 Nothing -> Just $ Constant ()

40 Nothing -> Just $ Constant ()

38 Just _ -> Nothing

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'@.

40mapPatchDMap :: (forall a. v a -> v' a) -> PatchDMap k v -> PatchDMap k v'

45mapPatchDMap :: (forall a. v a -> v' a) -> PatchDMap k v -> PatchDMap k v'

41mapPatchDMap f (PatchDMap p) = PatchDMap $ DMap.map (ComposeMaybe . fmap f . getComposeMaybe) p

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'@.

43−traversePatchDMap :: Applicative m => (forall a. v a -> m (v' a)) -> PatchDMap k v -> m (PatchDMap k v')

50+traversePatchDMap :: Applicative f => (forall a. v a -> f (v' a)) -> PatchDMap k v -> f (PatchDMap k v')

44traversePatchDMap f = traversePatchDMapWithKey $ const f

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'@.

46traversePatchDMapWithKey :: Applicative m => (forall a. k a -> v a -> m (v' a)) -> PatchDMap k v -> m (PatchDMap k v')

55traversePatchDMapWithKey :: 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

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.

49weakenPatchDMapWith :: (forall a. v a -> v') -> PatchDMap k v -> PatchMap (Some k) v'

60weakenPatchDMapWith :: (forall a. v a -> v') -> PatchDMap k v -> PatchMap (Some k) v'

50weakenPatchDMapWith f (PatchDMap p) = PatchMap $ weakenDMapWith (fmap f . getComposeMaybe) p

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'@.

52−patchDMapToPatchMapWith :: (f v -> v') -> PatchDMap (Const2 k v) f -> PatchMap k v'

65+patchDMapToPatchMapWith :: (v a -> v') -> PatchDMap (Const2 k a) v -> PatchMap k v'

53patchDMapToPatchMapWith f (PatchDMap p) = PatchMap $ dmapToMapWith (fmap f . getComposeMaybe) p

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@.

55−const2PatchDMapWith :: forall k v f a. (v -> f a) -> PatchMap k v -> PatchDMap (Const2 k a) f

69+const2PatchDMapWith :: forall k v v' a. (v -> v' a) -> PatchMap k v -> PatchDMap (Const2 k a) v'

56const2PatchDMapWith f (PatchMap p) = PatchDMap $ DMap.fromDistinctAscList $ g <$> Map.toAscList p

70const2PatchDMapWith f (PatchMap p) = PatchDMap $ DMap.fromDistinctAscList $ g <$> Map.toAscList p

57− where g :: (k, Maybe v) -> DSum (Const2 k a) (ComposeMaybe f)

71+ where g :: (k, Maybe v) -> DSum (Const2 k a) (ComposeMaybe v')

58 g (k, e) = Const2 k :=> ComposeMaybe (f <$> e)

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@.

60const2IntPatchDMapWith :: forall v f a. (v -> f a) -> PatchIntMap v -> PatchDMap (Const2 IntMap.Key a) f

75const2IntPatchDMapWith :: 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

76const2IntPatchDMapWith f (PatchIntMap p) = PatchDMap $ DMap.fromDistinctAscList $ g <$> IntMap.toAscList p

62 where g :: (IntMap.Key, Maybe v) -> DSum (Const2 IntMap.Key a) (ComposeMaybe f)

77 where g :: (IntMap.Key, Maybe v) -> DSum (Const2 IntMap.Key a) (ComposeMaybe f)

63 g (k, e) = Const2 k :=> ComposeMaybe (f <$> e)

78 g (k, e) = Const2 k :=> ComposeMaybe (f <$> e)

65−-- | Get the values that will be deleted if the given patch is applied to the

80+-- | Get the values that will be replaced or deleted if the given patch is applied to the given 'DMap'.

66−-- given 'DMap'. Includes values that will be replaced.

67getDeletions :: GCompare k => PatchDMap k v -> DMap k v' -> DMap k v'

81getDeletions :: GCompare k => PatchDMap k v -> DMap k v' -> DMap k v'

68getDeletions (PatchDMap p) m = DMap.intersectionWithKey (\_ v _ -> v) m p

82getDeletions (PatchDMap p) m = DMap.intersectionWithKey (\_ v _ -> v) m p

src/Reflex/Patch/DMapWithMove.hs+3−2

@@ -104,6 +104,7 @@ validationErrorsForPatchDMapWithMove m =

104 Just $ "unbalanced move at source key " <> gshow src <> " supposedly going to " <> gshow dst <> " but destination key is not moving"

105 unbalancedMove _ = Nothing

106

107+-- |Test whether two @'PatchDMapWithMove' k v@ contain the same patch operations.

107instance EqTag k (NodeInfo k v) => Eq (PatchDMapWithMove k v) where

108instance EqTag k (NodeInfo k v) => Eq (PatchDMapWithMove k v) where

108 PatchDMapWithMove a == PatchDMapWithMove b = a == b

109 PatchDMapWithMove a == PatchDMapWithMove b = a == b

109

110

@@ -341,6 +342,7 @@ const2PatchDMapWithMoveWith f (PatchMapWithMove p) = PatchDMapWithMove $ DMap.fr

341 , _nodeInfo_to = ComposeMaybe $ Const2 <$> MapWithMove._nodeInfo_to ni

342 , _nodeInfo_to = ComposeMaybe $ Const2 <$> MapWithMove._nodeInfo_to ni

342 }

343 }

343

344

345+-- | Apply the insertions, deletions, and moves to a given 'DMap'.

344instance GCompare k => Patch (PatchDMapWithMove k v) where

346instance GCompare k => Patch (PatchDMapWithMove k v) where

345 type PatchTarget (PatchDMapWithMove k v) = DMap k v

347 type PatchTarget (PatchDMapWithMove k v) = DMap k v

346 apply (PatchDMapWithMove p) 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?

348 apply (PatchDMapWithMove p) 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?

@@ -356,8 +358,7 @@ instance GCompare k => Patch (PatchDMapWithMove k v) where

356 From_Delete -> Just $ Constant ()

358 From_Delete -> Just $ Constant ()

357 _ -> Nothing

359 _ -> Nothing

358

360

359−-- | Get the values that will be deleted or moved if the given patch is applied

361+-- | Get the values that will be replaced, deleted, or moved if the given patch is applied to the given 'DMap'.

360−-- to the given 'DMap'.

361getDeletionsAndMoves :: GCompare k => PatchDMapWithMove k v -> DMap k v' -> DMap k (Product v' (ComposeMaybe k))

362getDeletionsAndMoves :: GCompare k => PatchDMapWithMove k v -> DMap k v' -> DMap k (Product v' (ComposeMaybe k))

362getDeletionsAndMoves (PatchDMapWithMove p) m = DMap.intersectionWithKey f m p

363getDeletionsAndMoves (PatchDMapWithMove p) m = DMap.intersectionWithKey f m p

363 where f _ v ni = Pair v $ _nodeInfo_to ni

364 where f _ v ni = Pair v $ _nodeInfo_to ni

src/Reflex/Patch/IntMap.hs+19−1

@@ -4,6 +4,8 @@

4{-# LANGUAGE DeriveTraversable #-}

5{-# LANGUAGE GeneralizedNewtypeDeriving #-}

6{-# LANGUAGE TypeFamilies #-}

7+-- | Module containing 'PatchIntMap', a 'Patch' for 'IntMap' which allows for

8+-- insert/update or delete of associations.

7module Reflex.Patch.IntMap where

9module Reflex.Patch.IntMap where

9import Data.IntMap.Strict (IntMap)

11import Data.IntMap.Strict (IntMap)

@@ -12,8 +14,12 @@ import Data.Maybe

12import Data.Semigroup

14import Data.Semigroup

13import Reflex.Patch.Class

15import Reflex.Patch.Class

17+-- | 'Patch' for 'IntMap' which represents insertion or deletion of keys in the mapping.

18+-- Internally represented by 'IntMap (Maybe a)', where @Just@ means insert/update

19+-- and @Nothing@ means delete.

15newtype PatchIntMap a = PatchIntMap (IntMap (Maybe a)) deriving (Functor, Foldable, Traversable, Monoid)

20newtype PatchIntMap a = PatchIntMap (IntMap (Maybe a)) deriving (Functor, Foldable, Traversable, Monoid)

22+-- | Apply the insertions or deletions to a given 'IntMap'.

17instance Patch (PatchIntMap a) where

23instance Patch (PatchIntMap a) where

18 type PatchTarget (PatchIntMap a) = IntMap a

24 type PatchTarget (PatchIntMap a) = IntMap a

19 apply (PatchIntMap p) v = if IntMap.null p then Nothing else Just $

25 apply (PatchIntMap p) v = if IntMap.null p then Nothing else Just $

@@ -36,14 +42,26 @@ instance Semigroup (PatchIntMap v) where

36 GT -> x

42 GT -> x

37#endif

43#endif

45+-- | Map a function @Int -> a -> b@ over all @a@s in the given @'PatchIntMap' a@

46+-- (that is, all inserts/updates), producing a @PatchIntMap b@.

47+mapIntMapPatchWithKey :: (Int -> a -> b) -> PatchIntMap a -> PatchIntMap b

48+mapIntMapPatchWithKey f (PatchIntMap m) = PatchIntMap $ IntMap.mapWithKey (\ k mv -> f k <$> mv) m

49+

50+-- | Map an effectful function @Int -> a -> f b@ over all @a@s in the given @'PatchIntMap' a@

51+-- (that is, all inserts/updates), producing a @f (PatchIntMap b)@.

39−traverseIntMapPatchWithKey :: Applicative t => (Int -> a -> t b) -> PatchIntMap a -> t (PatchIntMap b)

52+traverseIntMapPatchWithKey :: Applicative f => (Int -> a -> f b) -> PatchIntMap a -> f (PatchIntMap b)

40traverseIntMapPatchWithKey f (PatchIntMap m) = PatchIntMap <$> IntMap.traverseWithKey (\k mv -> traverse (f k) mv) m

53traverseIntMapPatchWithKey f (PatchIntMap m) = PatchIntMap <$> IntMap.traverseWithKey (\k mv -> traverse (f k) mv) m

55+-- | Extract all @a@s inserted/updated by the given @'PatchIntMap' a@.

42patchIntMapNewElements :: PatchIntMap a -> [a]

56patchIntMapNewElements :: PatchIntMap a -> [a]

43patchIntMapNewElements (PatchIntMap m) = catMaybes $ IntMap.elems m

57patchIntMapNewElements (PatchIntMap m) = catMaybes $ IntMap.elems m

59+-- | Convert the given @'PatchIntMap' a@ into an @'IntMap' a@ with all

60+-- the inserts/updates in the given patch.

45patchIntMapNewElementsMap :: PatchIntMap a -> IntMap a

61patchIntMapNewElementsMap :: PatchIntMap a -> IntMap a

46patchIntMapNewElementsMap (PatchIntMap m) = IntMap.mapMaybe id m

62patchIntMapNewElementsMap (PatchIntMap m) = IntMap.mapMaybe id m

64+-- | Subset the given @'IntMap' a@ to contain only the keys that would be

65+-- deleted by the given @'PatchIntMap' a@.

48getDeletions :: PatchIntMap v -> IntMap v' -> IntMap v'

66getDeletions :: PatchIntMap v -> IntMap v' -> IntMap v'

49getDeletions (PatchIntMap m) v = IntMap.intersection v m

67getDeletions (PatchIntMap m) v = IntMap.intersection v m

src/Reflex/Patch/Map.hs+1−2

@@ -18,8 +18,7 @@ import Data.Semigroup

18newtype PatchMap k v = PatchMap { unPatchMap :: Map k (Maybe v) }

19 deriving (Show, Read, Eq, Ord)

21−-- | Applying a 'PatchMap' will update the 'Map' by performing the insertions

21+-- | Apply the insertions or deletions to a given 'Map'.

22−-- and deletions specified

23instance Ord k => Patch (PatchMap k v) where

22instance Ord k => Patch (PatchMap k v) where

24 type PatchTarget (PatchMap k v) = Map k v

23 type PatchTarget (PatchMap k v) = Map k v

25 {-# INLINABLE apply #-}

24 {-# INLINABLE apply #-}

src/Reflex/Patch/MapWithMove.hs+58−16

@@ -20,7 +20,7 @@ import Data.List

20import Data.Map (Map)

21import qualified Data.Map as Map

22import Data.Maybe

23−import Data.Semigroup

23+import Data.Semigroup (Semigroup (..), (<>))

24import qualified Data.Set as Set

25import Data.These

26import Data.Tuple

@@ -41,6 +41,18 @@ data NodeInfo k v = NodeInfo

41 }

42 deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable)

44+-- | Describe how a key's new value should be produced

45+data From k v

46+ = From_Insert v -- ^ Insert the given value here

47+ | From_Delete -- ^ Delete the existing value, if any, from here

48+ | From_Move !k -- ^ Move the value here from the given key

49+ deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable)

50+

51+-- | Describe where a key's old value will go. If this is 'Just', that means

52+-- the key's old value will be moved to the given other key; if it is 'Nothing',

53+-- that means it will be deleted.

54+type To = Maybe

55+

44-- | Create a 'PatchMapWithMove', validating it

56-- | Create a 'PatchMapWithMove', validating it

45patchMapWithMove :: Ord k => Map k (NodeInfo k v) -> Maybe (PatchMapWithMove k v)

57patchMapWithMove :: Ord k => Map k (NodeInfo k v) -> Maybe (PatchMapWithMove k v)

46patchMapWithMove m = if valid then Just $ PatchMapWithMove m else Nothing

58patchMapWithMove m = if valid then Just $ PatchMapWithMove m else Nothing

@@ -62,22 +74,51 @@ patchMapWithMoveInsertAll m = PatchMapWithMove $ flip fmap m $ \v -> NodeInfo

62unPatchMapWithMove :: PatchMapWithMove k v -> Map k (NodeInfo k v)

74unPatchMapWithMove :: PatchMapWithMove k v -> Map k (NodeInfo k v)

63unPatchMapWithMove (PatchMapWithMove p) = p

75unPatchMapWithMove (PatchMapWithMove p) = p

65−-- | Warning: when using this function, you must ensure that the invariants of

77+-- | Make a @'PatchMapWithMove' k v@ which has the effect of inserting or updating a value @v@ to the given key @k@, like 'Map.insert'.

66−-- 'PatchMapWithMove' are preserved; they will not be checked.

78+insertMapKey :: k -> v -> PatchMapWithMove k v

67−unsafePatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v

79+insertMapKey k v = PatchMapWithMove . Map.singleton k $ NodeInfo (From_Insert v) Nothing

68−unsafePatchMapWithMove = PatchMapWithMove

70−-- | Describe how a key's new value should be produced

81+-- |Make a @'PatchMapWithMove' k v@ which has the effect of moving the value from the first key @k@ to the second key @k@, equivalent to:

71−data From k v

82+--

72− = From_Insert v -- ^ Insert the given value here

83+-- @

73− | From_Delete -- ^ Delete the existing value, if any, from here

84+-- 'Map.delete' src (maybe map ('Map.insert' dst) (Map.lookup src map))

74− | From_Move !k -- ^ Move the value here from the given key

85+-- @

75− deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable)

86+moveMapKey :: Ord k => k -> k -> PatchMapWithMove k v

87+moveMapKey src dst

88+ | src == dst = mempty

89+ | otherwise =

90+ PatchMapWithMove $ Map.fromList

91+ [ (dst, NodeInfo (From_Move src) Nothing)

92+ , (src, NodeInfo From_Delete (Just dst))

93+ ]

77−-- | Describe where a key's old value will go. If this is 'Just', that means

95+-- |Make a @'PatchMapWithMove' k v@ which has the effect of swapping two keys in the mapping, equivalent to:

78−-- the key's old value will be moved to the given other key; if it is 'Nothing',

96+--

79−-- that means it will be deleted.

97+-- @

80−type To = Maybe

98+-- let aMay = Map.lookup a map

99+-- bMay = Map.lookup b map

100+-- in maybe id (Map.insert a) (bMay `mplus` aMay)

101+-- . maybe id (Map.insert b) (aMay `mplus` bMay)

102+-- . Map.delete a . Map.delete b $ map

103+-- @

104+swapMapKey :: Ord k => k -> k -> PatchMapWithMove k v

105+swapMapKey src dst

106+ | src == dst = mempty

107+ | otherwise =

108+ PatchMapWithMove $ Map.fromList

109+ [ (dst, NodeInfo (From_Move src) (Just src))

110+ , (src, NodeInfo (From_Move dst) (Just dst))

111+ ]

112+

113+-- |Make a @'PatchMapWithMove' k v@ which has the effect of deleting a key in the mapping, equivalent to 'Map.delete'.

114+deleteMapKey :: k -> PatchMapWithMove k v

115+deleteMapKey k = PatchMapWithMove . Map.singleton k $ NodeInfo From_Delete Nothing

116+

117+-- | Wrap a @'Map' k (NodeInfo k v)@ representing patch changes into a @'PatchMapWithMove' k v@, without checking any invariants.

118+--

119+-- __Warning:__ when using this function, you must ensure that the invariants of 'PatchMapWithMove' are preserved; they will not be checked.

120+unsafePatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v

121+unsafePatchMapWithMove = PatchMapWithMove

122

82-- | Apply the insertions, deletions, and moves to a given 'Map'

123-- | Apply the insertions, deletions, and moves to a given 'Map'

83instance Ord k => Patch (PatchMapWithMove k v) where

124instance Ord k => Patch (PatchMapWithMove k v) where

@@ -91,10 +132,11 @@ instance Ord k => Patch (PatchMapWithMove k v) where

91 From_Delete -> Just ()

132 From_Delete -> Just ()

92 _ -> Nothing

133 _ -> Nothing

134

94−-- | Returns all the new elements that will be added to the 'Map'

135+-- | Returns all the new elements that will be added to the 'Map'.

95patchMapWithMoveNewElements :: PatchMapWithMove k v -> [v]

136patchMapWithMoveNewElements :: PatchMapWithMove k v -> [v]

96patchMapWithMoveNewElements = Map.elems . patchMapWithMoveNewElementsMap

137patchMapWithMoveNewElements = Map.elems . patchMapWithMoveNewElementsMap

138

139+-- | Return a @'Map' k v@ with all the inserts/updates from the given @'PatchMapWithMove' k v@.

98patchMapWithMoveNewElementsMap :: PatchMapWithMove k v -> Map k v

140patchMapWithMoveNewElementsMap :: PatchMapWithMove k v -> Map k v

99patchMapWithMoveNewElementsMap (PatchMapWithMove p) = Map.mapMaybe f p

141patchMapWithMoveNewElementsMap (PatchMapWithMove p) = Map.mapMaybe f p

100 where f ni = case _nodeInfo_from ni of

142 where f ni = case _nodeInfo_from ni of