e79511e · patch · git.iko.soy

git.iko.soy/patch

complete doc comments for Data.Map.Misc, Reflex.FastWeak, Reflex.Patch.DMap, Reflex.Patch.DMapWithMove, Reflex.Patch.IntMap, and Reflex.Patch.Map

e79511eRoss MacLeod8 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

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+46−5

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

5{-# LANGUAGE ForeignFunctionInterface #-}

6{-# LANGUAGE JavaScriptFFI #-}

7#endif

9+-- |Contains 'FastWeak', a weak pointer to some value, and 'FastWeakTicket' which ensures the value referred to by a 'FastWeak' stays live while the ticket is

10+-- held (live).

11+--

12+-- On GHC or GHCJS when not built with the @fast-weak@ cabal flag, 'FastWeak' is a wrapper around the simple version of 'System.Mem.Weak.Weak' where the key

13+-- and value are the same.

14+--

15+-- On GHCJS when built with the @fast-weak@ cabal flag, 'FastWeak' is implemented directly in JS using @h$FastWeak@ and @h$FastWeakTicket@ which are a

16+-- nonstandard part of the GHCJS RTS. __FIXME__

8module Reflex.FastWeak

17module Reflex.FastWeak

9 ( FastWeakTicket

18 ( FastWeakTicket

10 , FastWeak

19 , FastWeak

@@ -35,29 +44,52 @@ 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' can be used to get the referred to value without fear of @Nothing,

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

49+--

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

38newtype FastWeakTicket a = FastWeakTicket JSVal

51newtype FastWeakTicket a = FastWeakTicket JSVal

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

54+--

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

56+--

57+-- The value in a @FastWeak@ can also be kept alive by obtaining a 'FastWeakTicket' using 'getFastWeakTicket' if the value hasn't been collected yet.

58+--

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

40newtype FastWeak a = FastWeak JSVal

60newtype FastWeak a = FastWeak JSVal

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

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

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

63data 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'

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

46unsafeFromRawJSVal :: JSVal -> a

66unsafeFromRawJSVal :: JSVal -> a

47unsafeFromRawJSVal v = unVal (unsafeCoerce v)

67unsafeFromRawJSVal v = unVal (unsafeCoerce v)

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

49unsafeToRawJSVal :: a -> JSVal

70unsafeToRawJSVal :: a -> JSVal

50unsafeToRawJSVal v = unsafeCoerce (Val v)

71unsafeToRawJSVal v = unsafeCoerce (Val v)

51#else

72#else

73+-- |A 'FastWeak' which has been promoted to a strong reference. 'getFastWeakTicketValue' can be used to get the referred to value without fear of @Nothing,

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

52data FastWeakTicket a = FastWeakTicket

75data FastWeakTicket a = FastWeakTicket

53 { _fastWeakTicket_val :: !a

76 { _fastWeakTicket_val :: !a

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

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

55 }

78 }

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

81+--

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

83+--

84+-- The value in a @FastWeak@ can also be kept alive by obtaining a 'FastWeakTicket' using 'getFastWeakTicket' if the value hasn't been collected yet.

85+--

86+-- Synonymous with 'Weak'.

57type FastWeak a = Weak a

87type FastWeak a = Weak a

58#endif

88#endif

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

91+--

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

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

61getFastWeakTicketValue :: FastWeakTicket a -> IO a

93getFastWeakTicketValue :: FastWeakTicket a -> IO a

62#ifdef GHCJS_FAST_WEAK

94#ifdef GHCJS_FAST_WEAK

63getFastWeakTicketValue t = do

95getFastWeakTicketValue t = do

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

69getFastWeakTicketValue = return . _fastWeakTicket_val

101getFastWeakTicketValue = return . _fastWeakTicket_val

70#endif

102#endif

103

104+-- |Get the value referred to by a 'FastWeak' if it hasn't yet been collected, or @Nothing@ if it has been collected.

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

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

73#ifdef GHCJS_FAST_WEAK

106#ifdef GHCJS_FAST_WEAK

74getFastWeakValue w = do

107getFastWeakValue w = do

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

84getFastWeakValue = deRefWeak

117getFastWeakValue = deRefWeak

85#endif

118#endif

119

120+-- |Try to create a 'FastWeakTicket' for the given 'FastWeak' which will ensure the referred to value remains alive. Returns @Just@ if the value hasn't been

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

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

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

88#ifdef GHCJS_FAST_WEAK

123#ifdef GHCJS_FAST_WEAK

89getFastWeakTicket w = do

124getFastWeakTicket w = do

@@ -103,8 +138,10 @@ getFastWeakTicket w = do

103 }

138 }

104#endif

139#endif

105

140

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

141+-- |Create a 'FastWeakTicket' directly from a value, creating a 'FastWeak' in the process which can be obtained with 'getFastWeakTicketValue'.

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

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

143+-- 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

144+-- associated FastWeak to actually be weak

108#ifdef GHCJS_FAST_WEAK

145#ifdef GHCJS_FAST_WEAK

109mkFastWeakTicket v = js_fastWeakTicket (unsafeToRawJSVal v)

146mkFastWeakTicket v = js_fastWeakTicket (unsafeToRawJSVal v)

110

147

@@ -119,11 +156,15 @@ mkFastWeakTicket v = do

119 }

156 }

120#endif

157#endif

121

158

159+-- |Demote a 'FastWeakTicket' which ensures the value is alive to a 'FastWeak' which doesn't. Note that unless the ticket or another for the same 'FastWeak' is

160+-- held some other way the value might be collected immediately.

161+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

162-- 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

163#ifdef GHCJS_FAST_WEAK

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

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

165+{-# INLINE getFastWeakTicketWeak #-}

166+getFastWeakTicketWeak = getFastWeakTicketWeak'

125#else

167#else

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

127getFastWeakTicketWeak = return . _fastWeakTicket_weak

168getFastWeakTicketWeak = return . _fastWeakTicket_weak

128#endif

169#endif

129

170

src/Reflex/Patch/DMap.hs+16−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,15 @@ 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. Insertions are represented as @'ComposeMaybe' (Just value)@, while

24−-- deleted.

25+-- deletions are represented as @'ComposeMaybe' Nothing@.

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

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

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

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

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

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

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

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

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

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

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

35 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 +39,38 @@ instance GCompare k => Patch (PatchDMap k v) where

37 Nothing -> Just $ Constant ()

39 Nothing -> Just $ Constant ()

38 Just _ -> Nothing

40 Just _ -> Nothing

42+-- | Map a function @v a -> v' a@ over any inserts/updates in the given @'PatchDMap' k v@ to produce a @'PatchDMap' k v'@.

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

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

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

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

46+-- | Map an effectful function @v a -> f (v' a)@ over any inserts/updates in the given @'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')

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

44traversePatchDMap f = traversePatchDMapWithKey $ const f

48traversePatchDMap f = traversePatchDMapWithKey $ const f

50+-- | Map an effectful function @k a -> v a -> f (v' a)@ over any inserts/updates 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')

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

52traversePatchDMapWithKey f (PatchDMap p) = PatchDMap <$> DMap.traverseWithKey (\k (ComposeMaybe v) -> ComposeMaybe <$> traverse (f k) v) p

54+-- | Weaken a @'PatchDMap' k v@ to a @'PatchMap' (Some k) v'@ using a function @v a -> v'@ to weaken each value contained in the patch.

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

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

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

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

58+-- | Convert a weak @'PatchDMap' ('Const2' k a) v@ where the @a@ is known by way of 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'

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

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

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

62+-- | 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

63+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

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

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

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

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

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

68+-- | 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

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

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

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

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

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

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

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

74+-- | 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'

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

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

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

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

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

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

122 unbalancedMove _ = Nothing

123

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

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

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

125 PatchDMapWithMove a == PatchDMapWithMove b = a == b

126 PatchDMapWithMove a == PatchDMapWithMove b = a == b

126

127

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

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

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

363 }

364 }

364

365

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

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

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

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

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

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

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

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

377 From_Delete -> Just $ Constant ()

379 From_Delete -> Just $ Constant ()

378 _ -> Nothing

380 _ -> Nothing

379

381

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

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

381−-- to the given 'DMap'.

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

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

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

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

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

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

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

@@ -4,6 +4,7 @@

4{-# LANGUAGE DeriveTraversable #-}

5{-# LANGUAGE GeneralizedNewtypeDeriving #-}

6{-# LANGUAGE TypeFamilies #-}

7+-- |Module containing 'PatchIntMap', a 'Patch' for 'IntMap' which allows for insert/update or delete of associations.

7module Reflex.Patch.IntMap where

8module Reflex.Patch.IntMap where

9import Prelude hiding (lookup)

10import Prelude hiding (lookup)

@@ -13,8 +14,11 @@ import Data.Maybe

13import Data.Semigroup

14import Data.Semigroup

14import Reflex.Patch.Class

15import Reflex.Patch.Class

17+-- |'Patch' for 'IntMap' which represents insertion or deletion of keys in the mapping. Internally represented by 'IntMap (Maybe a)', where @Just@ means

18+-- insert/update and @Nothing@ means delete.

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

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

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

18instance Patch (PatchIntMap a) where

22instance Patch (PatchIntMap a) where

19 type PatchTarget (PatchIntMap a) = IntMap a

23 type PatchTarget (PatchIntMap a) = IntMap a

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

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

@@ -37,14 +41,22 @@ instance Semigroup (PatchIntMap v) where

37 GT -> x

41 GT -> x

38#endif

42#endif

44+-- |Map a function @Int -> a -> b@ over all @a@s in the given @'PatchIntMap' a@ (that is, all inserts/updates), producing a @PatchIntMap b@.

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

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

47+

48+-- |Map an effectful function @Int -> a -> f b@ over all @a@s in the given @'PatchIntMap' a@ (that is, all inserts/updates), producing a @f (PatchIntMap b)@.

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

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

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

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

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

43patchIntMapNewElements :: PatchIntMap a -> [a]

53patchIntMapNewElements :: PatchIntMap a -> [a]

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

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

56+-- |Convert the given @'PatchIntMap' a@ into an @'IntMap' a@ with all the inserts/updates in the given patch.

46patchIntMapNewElementsMap :: PatchIntMap a -> IntMap a

57patchIntMapNewElementsMap :: PatchIntMap a -> IntMap a

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

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

60+-- |Subset the given @'IntMap' a@ to contain only the keys that would be deleted by the given @'PatchIntMap' a@.

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

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

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

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

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

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

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 #-}