git.iko.soy/patch
on develop help sign in
Add Patch*MapWithMove and extend MonadAdjust to support them
145b7d8Ryan Trinkle
src/Data/Functor/Misc.hs+10
compare with develop
unifiedsplit
@@ -20,7 +20,9 @@ module Data.Functor.Misc
20 ( -- * Const2
20 ( -- * Const2
21 Const2 (..)
21 Const2 (..)
22 , dmapToMap
22 , dmapToMap
23+ , dmapToMapWith
23 , mapToDMap
24 , mapToDMap
25+ , weakenDMapWith
24 -- * WrapArg
26 -- * WrapArg
25 , WrapArg (..)
27 , WrapArg (..)
26 -- * Convenience functions for DMap
28 -- * Convenience functions for DMap
@@ -49,6 +51,8 @@ import Data.GADT.Compare
49import Data.GADT.Show
51import Data.GADT.Show
50import Data.Map (Map)
52import Data.Map (Map)
51import qualified Data.Map as Map
53import qualified Data.Map as Map
54+import Data.Some (Some)
55+import qualified Data.Some as Some
52import Data.These
56import Data.These
53import Data.Typeable hiding (Refl)
57import Data.Typeable hiding (Refl)
54
58
@@ -86,6 +90,9 @@ instance Ord k => GCompare (Const2 k v) where
86dmapToMap :: DMap (Const2 k v) Identity -> Map k v
90dmapToMap :: DMap (Const2 k v) Identity -> Map k v
87dmapToMap = Map.fromDistinctAscList . map (\(Const2 k :=> Identity v) -> (k, v)) . DMap.toAscList
91dmapToMap = Map.fromDistinctAscList . map (\(Const2 k :=> Identity v) -> (k, v)) . DMap.toAscList
88
92
93+dmapToMapWith :: (f v -> v') -> DMap (Const2 k v) f -> Map k v'
94+dmapToMapWith f = Map.fromDistinctAscList . map (\(Const2 k :=> v) -> (k, f v)) . DMap.toAscList
95+
89-- | Convert a regular 'Map' to a 'DMap'
96-- | Convert a regular 'Map' to a 'DMap'
90mapToDMap :: Map k v -> DMap (Const2 k v) Identity
97mapToDMap :: Map k v -> DMap (Const2 k v) Identity
91mapToDMap = DMap.fromDistinctAscList . map (\(k, v) -> Const2 k :=> Identity v) . Map.toAscList
98mapToDMap = DMap.fromDistinctAscList . map (\(k, v) -> Const2 k :=> Identity v) . Map.toAscList
@@ -95,6 +102,9 @@ mapToDMap = DMap.fromDistinctAscList . map (\(k, v) -> Const2 k :=> Identity v)
95mapWithFunctorToDMap :: Map k (f v) -> DMap (Const2 k v) f
102mapWithFunctorToDMap :: Map k (f v) -> DMap (Const2 k v) f
96mapWithFunctorToDMap = DMap.fromDistinctAscList . map (\(k, v) -> Const2 k :=> v) . Map.toAscList
103mapWithFunctorToDMap = DMap.fromDistinctAscList . map (\(k, v) -> Const2 k :=> v) . Map.toAscList
97
104
105+weakenDMapWith :: (forall a. v a -> v') -> DMap k v -> Map (Some k) v'
106+weakenDMapWith f = Map.fromDistinctAscList . map (\(k :=> v) -> (Some.This k, f v)) . DMap.toAscList
107+
98--------------------------------------------------------------------------------
108--------------------------------------------------------------------------------
99-- WrapArg
109-- WrapArg
100--------------------------------------------------------------------------------
110--------------------------------------------------------------------------------
src/Reflex/Class.hs+31−6
@@ -42,6 +42,8 @@ module Reflex.Class
42 -- ** Combining 'Event's
42 -- ** Combining 'Event's
43 , leftmost
43 , leftmost
44 , mergeMap
44 , mergeMap
45+ , mergeMapIncremental
46+ , mergeMapIncrementalWithMove
45 , mergeList
47 , mergeList
46 , mergeWith
48 , mergeWith
47 , difference
49 , difference
@@ -86,6 +88,7 @@ module Reflex.Class
86 , traceEventWith
88 , traceEventWith
87 -- * Unsafe functions
89 -- * Unsafe functions
88 , unsafeDynamic
90 , unsafeDynamic
91+ , unsafeMapIncremental
89 -- * 'FunctorMaybe'
92 -- * 'FunctorMaybe'
90 , FunctorMaybe (..)
93 , FunctorMaybe (..)
91 , fforMaybe
94 , fforMaybe
@@ -93,6 +96,8 @@ module Reflex.Class
93 -- * Miscellaneous convenience functions
96 -- * Miscellaneous convenience functions
94 , ffor
97 , ffor
95 , MonadAdjust (..)
98 , MonadAdjust (..)
99+ , sequenceDMapWithAdjust
100+ , sequenceDMapWithAdjustWithMove
96 -- * Deprecated functions
101 -- * Deprecated functions
97 , appendEvents
102 , appendEvents
98 , onceE
103 , onceE
@@ -266,6 +271,8 @@ class ( MonadHold t (PushM t)
266 unsafeBuildIncremental :: Patch p => PullM t (PatchTarget p) -> Event t p -> Incremental t p
271 unsafeBuildIncremental :: Patch p => PullM t (PatchTarget p) -> Event t p -> Incremental t p
267 -- | Create a merge whose parents can change over time
272 -- | Create a merge whose parents can change over time
268 mergeIncremental :: GCompare k => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
273 mergeIncremental :: GCompare k => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
274+ -- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
275+ mergeIncrementalWithMove :: GCompare k => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)
269 -- | Extract the 'Behavior' component of an 'Incremental'
276 -- | Extract the 'Behavior' component of an 'Incremental'
270 currentIncremental :: Patch p => Incremental t p -> Behavior t (PatchTarget p)
277 currentIncremental :: Patch p => Incremental t p -> Behavior t (PatchTarget p)
271 -- | Extract the 'Event' component of an 'Incremental'
278 -- | Extract the 'Event' component of an 'Incremental'
@@ -676,12 +683,23 @@ mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
676mergeList [] = never
683mergeList [] = never
677mergeList es = mergeWithCheap' (:|[]) (<>) es
684mergeList es = mergeWithCheap' (:|[]) (<>) es
678
685
686+unsafeMapIncremental :: (Reflex t, Patch p, Patch p') => (PatchTarget p -> PatchTarget p') -> (p -> p') -> Incremental t p -> Incremental t p'
687+unsafeMapIncremental f g a = unsafeBuildIncremental (fmap f $ sample $ currentIncremental a) $ g <$> updatedIncremental a
688+
679-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
689-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
680-- occurs if at least one of them occurs and has a map of values of all 'Event's
690-- occurs if at least one of them occurs and has a map of values of all 'Event's
681-- occuring at that time.
691-- occuring at that time.
682mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
692mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
683mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
693mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
684
694
695+-- | Create a merge whose parents can change over time
696+mergeMapIncremental :: (Reflex t, Ord k) => Incremental t (PatchMap k (Event t a)) -> Event t (Map k a)
697+mergeMapIncremental = fmap dmapToMap . mergeIncremental . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWith id)
698+
699+-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
700+mergeMapIncrementalWithMove :: (Reflex t, Ord k) => Incremental t (PatchMapWithMove k (Event t a)) -> Event t (Map k a)
701+mergeMapIncrementalWithMove = fmap dmapToMap . mergeIncrementalWithMove . unsafeMapIncremental mapWithFunctorToDMap (const2PatchDMapWithMoveWith id)
702+
685-- | Split the event into separate events for 'Left' and 'Right' values.
703-- | Split the event into separate events for 'Left' and 'Right' values.
686fanEither :: Reflex t => Event t (Either a b) -> (Event t a, Event t b)
704fanEither :: Reflex t => Event t (Either a b) -> (Event t a, Event t b)
687fanEither e =
705fanEither e =
@@ -901,18 +919,25 @@ zipListWithEvent f l e = do
901-- to determine what the best meaning for this class is in such cases.
919-- to determine what the best meaning for this class is in such cases.
902class (Reflex t, Monad m) => MonadAdjust t m | m -> t where
920class (Reflex t, Monad m) => MonadAdjust t m | m -> t where
903 runWithReplace :: m a -> Event t (m b) -> m (a, Event t b)
921 runWithReplace :: m a -> Event t (m b) -> m (a, Event t b)
904− sequenceDMapWithAdjust :: GCompare k => DMap k m -> Event t (PatchDMap k m) -> m (DMap k Identity, Event t (PatchDMap k Identity))
922+ traverseDMapWithKeyWithAdjust :: GCompare k => (forall a. k a -> v a -> m (v' a)) -> DMap k v -> Event t (PatchDMap k v) -> m (DMap k v', Event t (PatchDMap k v'))
923+ traverseDMapWithKeyWithAdjustWithMove :: GCompare k => (forall a. k a -> v a -> m (v' a)) -> DMap k v -> Event t (PatchDMapWithMove k v) -> m (DMap k v', Event t (PatchDMapWithMove k v'))
905
924
906instance (Reflex t, MonadAdjust t m) => MonadAdjust t (ReaderT r m) where
925instance (Reflex t, MonadAdjust t m) => MonadAdjust t (ReaderT r m) where
907 runWithReplace a0 a' = do
926 runWithReplace a0 a' = do
908 r <- ask
927 r <- ask
909 lift $ runWithReplace (runReaderT a0 r) $ fmap (`runReaderT` r) a'
928 lift $ runWithReplace (runReaderT a0 r) $ fmap (`runReaderT` r) a'
910− sequenceDMapWithAdjust dm0 dm' = do
929+ traverseDMapWithKeyWithAdjust f dm0 dm' = do
911 r <- ask
930 r <- ask
912− let loweredDm0 = DMap.map (`runReaderT` r) dm0
931+ lift $ traverseDMapWithKeyWithAdjust (\k v -> runReaderT (f k v) r) dm0 dm'
913− loweredDm' = ffor dm' $ \(PatchDMap p) -> PatchDMap $
932+ traverseDMapWithKeyWithAdjustWithMove f dm0 dm' = do
914− DMap.map (\(ComposeMaybe mv) -> ComposeMaybe $ fmap (`runReaderT` r) mv) p
933+ r <- ask
915− lift $ sequenceDMapWithAdjust loweredDm0 loweredDm'
934+ lift $ traverseDMapWithKeyWithAdjustWithMove (\k v -> runReaderT (f k v) r) dm0 dm'
935+
936+sequenceDMapWithAdjust :: (GCompare k, MonadAdjust t m) => DMap k m -> Event t (PatchDMap k m) -> m (DMap k Identity, Event t (PatchDMap k Identity))
937+sequenceDMapWithAdjust = traverseDMapWithKeyWithAdjust $ \_ -> fmap Identity
938+
939+sequenceDMapWithAdjustWithMove :: (GCompare k, MonadAdjust t m) => DMap k m -> Event t (PatchDMapWithMove k m) -> m (DMap k Identity, Event t (PatchDMapWithMove k Identity))
940+sequenceDMapWithAdjustWithMove = traverseDMapWithKeyWithAdjustWithMove $ \_ -> fmap Identity
916
941
917------------------
942------------------
918-- Cheap Functions
943-- Cheap Functions
src/Reflex/DynamicWriter.hs+61−36
@@ -7,6 +7,7 @@
7{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7{-# LANGUAGE GeneralizedNewtypeDeriving #-}
8{-# LANGUAGE LambdaCase #-}
8{-# LANGUAGE LambdaCase #-}
9{-# LANGUAGE MultiParamTypeClasses #-}
9{-# LANGUAGE MultiParamTypeClasses #-}
10+{-# LANGUAGE RankNTypes #-}
10{-# LANGUAGE ScopedTypeVariables #-}
11{-# LANGUAGE ScopedTypeVariables #-}
11{-# LANGUAGE TypeFamilies #-}
12{-# LANGUAGE TypeFamilies #-}
12{-# LANGUAGE UndecidableInstances #-}
13{-# LANGUAGE UndecidableInstances #-}
@@ -26,14 +27,15 @@ import Control.Monad.IO.Class
26import Control.Monad.Reader
27import Control.Monad.Reader
27import Control.Monad.Ref
28import Control.Monad.Ref
28import Control.Monad.State.Strict
29import Control.Monad.State.Strict
30+import Data.Align
29−import Data.Dependent.Map (DMap, DSum (..))
31+import Data.Dependent.Map (DMap)
30import qualified Data.Dependent.Map as DMap
32import qualified Data.Dependent.Map as DMap
31import Data.Functor.Misc
33import Data.Functor.Misc
32import Data.Map (Map)
34import Data.Map (Map)
33import qualified Data.Map as Map
35import qualified Data.Map as Map
34import Data.Semigroup
36import Data.Semigroup
35import Data.Some (Some)
37import Data.Some (Some)
36−import qualified Data.Some as Some
38+import Data.These
37import Reflex.Class
39import Reflex.Class
38import Reflex.Host.Class
40import Reflex.Host.Class
39import Reflex.PerformEvent.Class
41import Reflex.PerformEvent.Class
@@ -44,26 +46,38 @@ import Reflex.TriggerEvent.Class
44instance MonadTrans (DynamicWriterT t w) where
46instance MonadTrans (DynamicWriterT t w) where
45 lift = DynamicWriterT . lift
47 lift = DynamicWriterT . lift
46
48
47−mapIncrementalMapValuesWithKey :: (Reflex t, Ord k) => (k -> v -> v') -> Incremental t (PatchMap k v) -> Incremental t (PatchMap k v')
49+mapIncrementalMapValues :: (Reflex t, Patch (p v), Patch (p v'), PatchTarget (p v) ~ f v, PatchTarget (p v') ~ f v', Functor p, Functor f) => (v -> v') -> Incremental t (p v) -> Incremental t (p v')
48−mapIncrementalMapValuesWithKey f = unsafeMapIncremental (Map.mapWithKey f) $ \(PatchMap m) -> PatchMap $ Map.mapWithKey (\k mv -> fmap (f k) mv) m
49−
50−mapIncrementalMapValues :: (Reflex t, Ord k) => (v -> v') -> Incremental t (PatchMap k v) -> Incremental t (PatchMap k v')
51−mapIncrementalMapValues f = mapIncrementalMapValuesWithKey $ const f
50+mapIncrementalMapValues f = unsafeMapIncremental (fmap f) (fmap f)
52−
53−unsafeMapIncremental :: (Reflex t, Patch p, Patch p') => (PatchTarget p -> PatchTarget p') -> (p -> p') -> Incremental t p -> Incremental t p'
54−unsafeMapIncremental f g a = unsafeBuildIncremental (fmap f $ sample $ currentIncremental a) $ g <$> updatedIncremental a
55−
56−incrementalExtractFunctorDMap :: (Reflex t, Ord k) => Incremental t (PatchMap k (f v)) -> Incremental t (PatchDMap (Const2 k v) f)
57−incrementalExtractFunctorDMap = unsafeMapIncremental mapWithFunctorToDMap $ \(PatchMap m) -> PatchDMap $ mapWithFunctorToDMap $ fmap ComposeMaybe m
58−
59−mergeIncrementalMap :: (Reflex t, Ord k) => Incremental t (PatchMap k (Event t v)) -> Event t (Map k v)
60−mergeIncrementalMap = fmap dmapToMap . mergeIncremental . incrementalExtractFunctorDMap
61
51
62mergeDynIncremental :: (Reflex t, Ord k) => Incremental t (PatchMap k (Dynamic t v)) -> Incremental t (PatchMap k v)
52mergeDynIncremental :: (Reflex t, Ord k) => Incremental t (PatchMap k (Dynamic t v)) -> Incremental t (PatchMap k v)
63mergeDynIncremental a = unsafeBuildIncremental (mapM (sample . current) =<< sample (currentIncremental a)) $ addedAndRemovedValues <> changedValues
53mergeDynIncremental a = unsafeBuildIncremental (mapM (sample . current) =<< sample (currentIncremental a)) $ addedAndRemovedValues <> changedValues
64− where changedValues = fmap (PatchMap . fmap Just) $ mergeIncrementalMap $ mapIncrementalMapValues updated a
54+ where changedValues = fmap (PatchMap . fmap Just) $ mergeMapIncremental $ mapIncrementalMapValues updated a
65 addedAndRemovedValues = flip pushAlways (updatedIncremental a) $ \(PatchMap m) -> PatchMap <$> mapM (mapM (sample . current)) m
55 addedAndRemovedValues = flip pushAlways (updatedIncremental a) $ \(PatchMap m) -> PatchMap <$> mapM (mapM (sample . current)) m
66
56
57+mergeDynIncrementalWithMove :: (Reflex t, Ord k) => Incremental t (PatchMapWithMove k (Dynamic t v)) -> Incremental t (PatchMapWithMove k v)
58+mergeDynIncrementalWithMove a = unsafeBuildIncremental (mapM (sample . current) =<< sample (currentIncremental a)) $ alignWith f addedAndRemovedValues changedValues
59+ where changedValues = mergeMapIncrementalWithMove $ mapIncrementalMapValues updated a
60+ addedAndRemovedValues = flip pushAlways (updatedIncremental a) $ fmap unsafePatchMapWithMove . mapM (mapM (sample . current)) . unPatchMapWithMove
61+ f x = unsafePatchMapWithMove $
62+ let (p, changed) = case x of
63+ This p_ -> (unPatchMapWithMove p_, mempty)
64+ That c -> (mempty, c)
65+ These p_ c -> (unPatchMapWithMove p_, c)
66+ (pWithNewVals, noLongerMoved) = flip runState [] $ forM p $ \case
67+ MapEdit_Insert moved v -> return $ MapEdit_Insert moved v
68+ MapEdit_Delete moved -> return $ MapEdit_Delete moved
69+ MapEdit_Move moved k -> case Map.lookup k changed of
70+ Nothing -> return $ MapEdit_Move moved k
71+ Just v -> do
72+ modify (k:)
73+ return $ MapEdit_Insert moved v
74+ noLongerMovedMap = Map.fromList $ fmap (\k -> (k, ())) noLongerMoved
75+ removeMovedFlag = \case --TODO: Check if moved was true before, in each case?
76+ MapEdit_Insert _ v -> MapEdit_Insert False v
77+ MapEdit_Delete _ -> MapEdit_Delete False
78+ MapEdit_Move _ k -> MapEdit_Move False k
79+ in Map.differenceWith (\e _ -> Just $ removeMovedFlag e) pWithNewVals noLongerMovedMap --TODO: Check if any in the second map are not covered?
80+
67-- | A basic implementation of 'MonadDynamicWriter'.
81-- | A basic implementation of 'MonadDynamicWriter'.
68newtype DynamicWriterT t w m a = DynamicWriterT { unDynamicWriterT :: StateT [Dynamic t w] m a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadHold t, MonadSample t, MonadAsyncException, MonadException) -- The list is kept in reverse order
82newtype DynamicWriterT t w m a = DynamicWriterT { unDynamicWriterT :: StateT [Dynamic t w] m a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadHold t, MonadSample t, MonadAsyncException, MonadException) -- The list is kept in reverse order
69
83
@@ -120,7 +134,7 @@ instance MonadState s m => MonadState s (DynamicWriterT t w m) where
120 get = lift get
134 get = lift get
121 put = lift . put
135 put = lift . put
122
136
123−newtype DynamicWriterTLoweredResult t w v = DynamicWriterTLoweredResult (v, Dynamic t w)
137+newtype DynamicWriterTLoweredResult t w v a = DynamicWriterTLoweredResult (v a, Dynamic t w)
124
138
125-- | When the execution of a 'DynamicWriterT' action is adjusted using
139-- | When the execution of a 'DynamicWriterT' action is adjusted using
126-- 'MonadAdjust', the 'Dynamic' output of that action will also be updated to
140-- 'MonadAdjust', the 'Dynamic' output of that action will also be updated to
@@ -130,24 +144,35 @@ instance (MonadAdjust t m, MonadFix m, Monoid w, MonadHold t m, Reflex t) => Mon
130 (result0, result') <- lift $ runWithReplace (runDynamicWriterT a0) $ runDynamicWriterT <$> a'
144 (result0, result') <- lift $ runWithReplace (runDynamicWriterT a0) $ runDynamicWriterT <$> a'
131 tellDyn . join =<< holdDyn (snd result0) (snd <$> result')
145 tellDyn . join =<< holdDyn (snd result0) (snd <$> result')
132 return (fst result0, fst <$> result')
146 return (fst result0, fst <$> result')
147+ traverseDMapWithKeyWithAdjust = traverseDMapWithKeyWithAdjustImpl traverseDMapWithKeyWithAdjust mapPatchDMap weakenPatchDMapWith mergeDynIncremental
148+ traverseDMapWithKeyWithAdjustWithMove = traverseDMapWithKeyWithAdjustImpl traverseDMapWithKeyWithAdjustWithMove mapPatchDMapWithMove weakenPatchDMapWithMoveWith mergeDynIncrementalWithMove
149+
150+traverseDMapWithKeyWithAdjustImpl :: forall t w k v' p p' v m. (PatchTarget (p' (Some k) (Dynamic t w)) ~ Map (Some k) (Dynamic t w), PatchTarget (p' (Some k) w) ~ Map (Some k) w, Patch (p' (Some k) w), Patch (p' (Some k) (Dynamic t w)), MonadFix m, Monoid w, Reflex t, MonadHold t m)
151+ => ( (forall a. k a -> v a -> m (DynamicWriterTLoweredResult t w v' a))
152+ -> DMap k v
153+ -> Event t (p k v)
154+ -> m (DMap k (DynamicWriterTLoweredResult t w v'), Event t (p k (DynamicWriterTLoweredResult t w v')))
155+ )
156+ -> ((forall a. DynamicWriterTLoweredResult t w v' a -> v' a) -> p k (DynamicWriterTLoweredResult t w v') -> p k v')
157+ -> ((forall a. DynamicWriterTLoweredResult t w v' a -> Dynamic t w) -> p k (DynamicWriterTLoweredResult t w v') -> p' (Some k) (Dynamic t w))
158+ -> (Incremental t (p' (Some k) (Dynamic t w)) -> Incremental t (p' (Some k) w))
133− sequenceDMapWithAdjust (dm0 :: DMap k (DynamicWriterT t w m)) dm' = do
159+ -> (forall a. k a -> v a -> DynamicWriterT t w m (v' a))
134− let loweredDm0 = mapKeyValuePairsMonotonic (\(k :=> v) -> WrapArg k :=> fmap DynamicWriterTLoweredResult (runDynamicWriterT v)) dm0
160+ -> DMap k v
135− let loweredDm' = ffor dm' $ \(PatchDMap p) -> PatchDMap $
161+ -> Event t (p k v)
136− mapKeyValuePairsMonotonic (\(k :=> ComposeMaybe mv) -> WrapArg k :=> ComposeMaybe (fmap (fmap DynamicWriterTLoweredResult . runDynamicWriterT) mv)) p
162+ -> DynamicWriterT t w m (DMap k v', Event t (p k v'))
137− (result0, result') <- lift $ sequenceDMapWithAdjust loweredDm0 loweredDm'
163+traverseDMapWithKeyWithAdjustImpl base mapPatch weakenPatchWith mergeMyDynIncremental f (dm0 :: DMap k v) dm' = do
164+ (result0, result') <- lift $ base (\k v -> fmap DynamicWriterTLoweredResult $ runDynamicWriterT $ f k v) dm0 dm'
138− let getValue (DynamicWriterTLoweredResult (v, _)) = v
165+ let getValue (DynamicWriterTLoweredResult (v, _)) = v
139− getWritten (DynamicWriterTLoweredResult (_, w)) = w
166+ getWritten (DynamicWriterTLoweredResult (_, w)) = w
140− liftedResult0 = mapKeyValuePairsMonotonic (\(WrapArg k :=> Identity r) -> k :=> Identity (getValue r)) result0
167+ liftedResult0 = DMap.map getValue result0
141− liftedResult' = ffor result' $ \(PatchDMap p) -> PatchDMap $
168+ liftedResult' = ffor result' $ mapPatch getValue
142− mapKeyValuePairsMonotonic (\(WrapArg k :=> ComposeMaybe mr) -> k :=> ComposeMaybe (fmap (Identity . getValue . runIdentity) mr)) p
143− liftedWritten0 :: Map (Some k) (Dynamic t w)
169+ liftedWritten0 :: Map (Some k) (Dynamic t w)
144− liftedWritten0 = Map.fromDistinctAscList $ (\(WrapArg k :=> Identity r) -> (Some.This k, getWritten r)) <$> DMap.toList result0
170+ liftedWritten0 = weakenDMapWith getWritten result0
145− liftedWritten' = ffor result' $ \(PatchDMap p) -> PatchMap $
171+ liftedWritten' = ffor result' $ weakenPatchWith getWritten
146− Map.fromDistinctAscList $ (\(WrapArg k :=> ComposeMaybe mr) -> (Some.This k, fmap (getWritten . runIdentity) mr)) <$> DMap.toList p
147− --TODO: We should be able to improve the performance here by incrementally updating the mconcat of the merged Dynamics
172+ --TODO: We should be able to improve the performance here by incrementally updating the mconcat of the merged Dynamics
148− i <- holdIncremental liftedWritten0 liftedWritten'
173+ i <- holdIncremental liftedWritten0 liftedWritten'
149− tellDyn $ fmap (mconcat . Map.elems) $ incrementalToDynamic $ mergeDynIncremental i
174+ tellDyn $ fmap (mconcat . Map.elems) $ incrementalToDynamic $ mergeMyDynIncremental i
150− return (liftedResult0, liftedResult')
175+ return (liftedResult0, liftedResult')
151
176
152-- | Map a function over the output of a 'DynamicWriterT'.
177-- | Map a function over the output of a 'DynamicWriterT'.
153withDynamicWriterT :: (Monoid w, Monoid w', Reflex t, MonadHold t m, MonadFix m)
178withDynamicWriterT :: (Monoid w, Monoid w', Reflex t, MonadHold t m, MonadFix m)
src/Reflex/EventWriter.hs+32−44
@@ -5,7 +5,6 @@
5{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE FlexibleInstances #-}
6{-# LANGUAGE FunctionalDependencies #-}
6{-# LANGUAGE FunctionalDependencies #-}
7{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7{-# LANGUAGE GeneralizedNewtypeDeriving #-}
8−{-# LANGUAGE KindSignatures #-}
9{-# LANGUAGE MultiParamTypeClasses #-}
8{-# LANGUAGE MultiParamTypeClasses #-}
10{-# LANGUAGE Rank2Types #-}
9{-# LANGUAGE Rank2Types #-}
11{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE ScopedTypeVariables #-}
@@ -17,7 +16,7 @@
17module Reflex.EventWriter
16module Reflex.EventWriter
18 ( EventWriterT (..)
17 ( EventWriterT (..)
19 , runEventWriterT
18 , runEventWriterT
20− , EventWriter(..)
19+ , EventWriter (..)
21 , runWithReplaceEventWriterTWith
20 , runWithReplaceEventWriterTWith
22 , sequenceDMapWithAdjustEventWriterTWith
21 , sequenceDMapWithAdjustEventWriterTWith
23 ) where
22 ) where
@@ -34,18 +33,17 @@ import Control.Monad.Identity
34import Control.Monad.Reader
33import Control.Monad.Reader
35import Control.Monad.Ref
34import Control.Monad.Ref
36import Control.Monad.State.Strict
35import Control.Monad.State.Strict
37−import Data.Dependent.Map (DMap, DSum (..))
36+import Data.Dependent.Map (DMap)
38import qualified Data.Dependent.Map as DMap
37import qualified Data.Dependent.Map as DMap
39import Data.Foldable
38import Data.Foldable
39+import Data.Functor.Compose
40import Data.Functor.Misc
40import Data.Functor.Misc
41import qualified Data.List.NonEmpty as NonEmpty
41import qualified Data.List.NonEmpty as NonEmpty
42−import Data.Maybe
42+import Data.Map (Map)
43import Data.Semigroup
43import Data.Semigroup
44import Data.Sequence
44import Data.Sequence
45import Data.Some (Some)
45import Data.Some (Some)
46−import qualified Data.Some as Some
47import Data.Tuple
46import Data.Tuple
48−import Data.Unique.Tag
49
47
50-- | 'EventWriter' efficiently collects 'Event' values using 'tellEvent'
48-- | 'EventWriter' efficiently collects 'Event' values using 'tellEvent'
51-- and combines them monoidally to provide an 'Event' result.
49-- and combines them monoidally to provide an 'Event' result.
@@ -78,7 +76,8 @@ instance MonadHold t m => MonadHold t (EventWriterT t w m) where
78
76
79instance (Reflex t, MonadAdjust t m, MonadHold t m, Monoid w, Semigroup w) => MonadAdjust t (EventWriterT t w m) where
77instance (Reflex t, MonadAdjust t m, MonadHold t m, Monoid w, Semigroup w) => MonadAdjust t (EventWriterT t w m) where
80 runWithReplace = runWithReplaceEventWriterTWith $ \dm0 dm' -> lift $ runWithReplace dm0 dm'
78 runWithReplace = runWithReplaceEventWriterTWith $ \dm0 dm' -> lift $ runWithReplace dm0 dm'
81− sequenceDMapWithAdjust = sequenceDMapWithAdjustEventWriterTWith $ \dm0 dm' -> lift $ sequenceDMapWithAdjust dm0 dm'
79+ traverseDMapWithKeyWithAdjust = sequenceDMapWithAdjustEventWriterTWith (\f dm0 dm' -> lift $ traverseDMapWithKeyWithAdjust f dm0 dm') mapPatchDMap weakenPatchDMapWith patchMapNewElements mergeMapIncremental
80+ traverseDMapWithKeyWithAdjustWithMove = sequenceDMapWithAdjustEventWriterTWith (\f dm0 dm' -> lift $ traverseDMapWithKeyWithAdjustWithMove f dm0 dm') mapPatchDMapWithMove weakenPatchDMapWithMoveWith patchMapWithMoveNewElements mergeMapIncrementalWithMove
82
81
83instance Requester t m => Requester t (EventWriterT t w m) where
82instance Requester t m => Requester t (EventWriterT t w m) where
84 type Request (EventWriterT t w m) = Request m
83 type Request (EventWriterT t w m) = Request m
@@ -106,32 +105,34 @@ runWithReplaceEventWriterTWith f a0 a' = do
106 return (fst result0, fmapCheap fst result')
105 return (fst result0, fmapCheap fst result')
107
106
108-- | Like 'runWithReplaceEventWriterTWith', but for 'sequenceDMapWithAdjust'.
107-- | Like 'runWithReplaceEventWriterTWith', but for 'sequenceDMapWithAdjust'.
109−sequenceDMapWithAdjustEventWriterTWith :: (GCompare k, Reflex t, MonadHold t m, Monoid w, Semigroup w)
108+sequenceDMapWithAdjustEventWriterTWith :: forall t m p p' w k v v'. (Reflex t, MonadHold t m, Monoid w, Semigroup w, Patch (p' (Some k) (Event t w)), PatchTarget (p' (Some k) (Event t w)) ~ Map (Some k) (Event t w))
110− => (forall k'. GCompare k'
109+ => ( (forall a. k a -> v a -> m (Compose ((,) (Seq (Event t w))) v' a))
111− => DMap k' m
110+ -> DMap k v
112− -> Event t (PatchDMap k' m)
111+ -> Event t (p k v)
113− -> EventWriterT t w m (DMap k' Identity, Event t (PatchDMap k' Identity))
112+ -> EventWriterT t w m (DMap k (Compose ((,) (Seq (Event t w))) v'), Event t (p k (Compose ((,) (Seq (Event t w))) v')))
114 )
113 )
115− -> DMap k (EventWriterT t w m)
114+ -> ((forall a. Compose ((,) (Seq (Event t w))) v' a -> v' a) -> p k (Compose ((,) (Seq (Event t w))) v') -> p k v')
115+ -> ((forall a. Compose ((,) (Seq (Event t w))) v' a -> Event t w) -> p k (Compose ((,) (Seq (Event t w))) v') -> p' (Some k) (Event t w))
116+ -> (p' (Some k) (Event t w) -> [Event t w])
117+ -> (Incremental t (p' (Some k) (Event t w)) -> Event t (Map (Some k) w))
116− -> Event t (PatchDMap k (EventWriterT t w m))
118+ -> (forall a. k a -> v a -> EventWriterT t w m (v' a))
119+ -> DMap k v
120+ -> Event t (p k v)
117− -> EventWriterT t w m (DMap k Identity, Event t (PatchDMap k Identity))
121+ -> EventWriterT t w m (DMap k v', Event t (p k v'))
118−sequenceDMapWithAdjustEventWriterTWith f (dm0 :: DMap k (EventWriterT t w m)) dm' = do
122+sequenceDMapWithAdjustEventWriterTWith base mapPatch weakenPatchWith patchNewElements mergePatchIncremental f dm0 dm' = do
119− let inputTransform :: forall a. DMapTransform a k (WrapArg ((,) (Seq (Event t w))) k) (EventWriterT t w m) m
123+ let f' :: forall a. k a -> v a -> m (Compose ((,) (Seq (Event t w))) v' a)
120− inputTransform = DMapTransform WrapArg (\(EventWriterT v) -> swap <$> runStateT v mempty)
124+ f' k v = Compose . swap <$> runStateT (unEventWriterT $ f k v) mempty
121− (children0, children') <- f (mapKeysAndValuesMonotonic inputTransform dm0) $ mapPatchKeysAndValuesMonotonic inputTransform <$> dm'
125+ (children0, children') <- base f' dm0 dm'
122− let result0 = mapKeyValuePairsMonotonic (\(WrapArg k :=> Identity (_, v)) -> k :=> Identity v) children0
126+ let result0 = DMap.map (snd . getCompose) children0
123− result' = fforCheap children' $ \(PatchDMap p) -> PatchDMap $
127+ result' = fforCheap children' $ mapPatch $ snd . getCompose
124− mapKeyValuePairsMonotonic (\(WrapArg k :=> ComposeMaybe mv) -> k :=> ComposeMaybe (fmap (Identity . snd . runIdentity) mv)) p
125− requests0 :: DMap (Const2 (Some k) w) (Event t)
128+ requests0 :: Map (Some k) (Event t w)
126− requests0 = mapKeyValuePairsMonotonic (\(WrapArg k :=> Identity (r, _)) -> Const2 (Some.This k) :=> mconcat (toList r)) children0
129+ requests0 = weakenDMapWith (mconcat . toList . fst . getCompose) children0
127− requests' :: Event t (PatchDMap (Const2 (Some k) w) (Event t))
130+ requests' :: Event t (p' (Some k) (Event t w))
128− requests' = fforCheap children' $ \(PatchDMap p) -> PatchDMap $
131+ requests' = fforCheap children' $ weakenPatchWith $ mconcat . toList . fst . getCompose
129− mapKeyValuePairsMonotonic (\(WrapArg k :=> ComposeMaybe mv) -> Const2 (Some.This k) :=> ComposeMaybe (fmap (mconcat . toList . fst . runIdentity) mv)) p
130− childRequestMap <- holdIncremental requests0 requests'
132+ childRequestMap :: Incremental t (p' (Some k) (Event t w)) <- holdIncremental requests0 requests'
131 -- We add these two separately to take advantage of the free merge being done later. The coincidence case must come first so that it has precedence if both fire simultaneously. (Really, we should probably block the 'switch' whenever 'updated' fires, but switchPromptlyDyn has the same issue.)
133 -- We add these two separately to take advantage of the free merge being done later. The coincidence case must come first so that it has precedence if both fire simultaneously. (Really, we should probably block the 'switch' whenever 'updated' fires, but switchPromptlyDyn has the same issue.)
132− EventWriterT $ modify $ flip (|>) $ coincidence $ fforCheap requests' $ \(PatchDMap p) -> mconcat $ toList $ catMaybes $ ffor (DMap.toList p) $ \(Const2 _ :=> ComposeMaybe me) -> me
134+ EventWriterT $ modify $ flip (|>) $ coincidence $ fforCheap requests' $ \p -> mconcat $ patchNewElements p --TODO: Create a mergeIncrementalPromptly, and use that to eliminate this 'coincidence'
133− EventWriterT $ modify $ flip (|>) $ ffor (mergeIncremental childRequestMap) $ \m ->
135+ EventWriterT $ modify $ flip (|>) $ fold <$> mergePatchIncremental childRequestMap
134− mconcat $ (\(Const2 _ :=> Identity reqs) -> reqs) <$> DMap.toList m
135 return (result0, result')
136 return (result0, result')
136
137
137instance PerformEvent t m => PerformEvent t (EventWriterT t w m) where
138instance PerformEvent t m => PerformEvent t (EventWriterT t w m) where
@@ -164,16 +165,3 @@ instance MonadAtomicRef m => MonadAtomicRef (EventWriterT t w m) where
164instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (EventWriterT t w m) where
165instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (EventWriterT t w m) where
165 newEventWithTrigger = lift . newEventWithTrigger
166 newEventWithTrigger = lift . newEventWithTrigger
166 newFanEventWithTrigger f = lift $ newFanEventWithTrigger f
167 newFanEventWithTrigger f = lift $ newFanEventWithTrigger f
167−
168−--------------------------------------------------------------------------------
169−-- Internal functions
170−--------------------------------------------------------------------------------
171−
172−data DMapTransform (a :: *) k k' v v' = forall (b :: *). DMapTransform !(k a -> k' b) !(v a -> v' b)
173−
174−mapPatchKeysAndValuesMonotonic :: (forall a. DMapTransform a k k' v v') -> PatchDMap k v -> PatchDMap k' v'
175−mapPatchKeysAndValuesMonotonic x (PatchDMap p) = PatchDMap $ mapKeyValuePairsMonotonic (\(k :=> ComposeMaybe mv) -> case x of DMapTransform f g -> f k :=> ComposeMaybe (fmap g mv)) p
176−
177−mapKeysAndValuesMonotonic :: (forall a. DMapTransform a k k' v v') -> DMap k v -> DMap k' v'
178−mapKeysAndValuesMonotonic x = mapKeyValuePairsMonotonic $ \(k :=> v) -> case x of
179− DMapTransform f g -> f k :=> g v
src/Reflex/Patch.hs+240−4
@@ -1,28 +1,69 @@
1-- | This module defines the 'Patch' class, which is used by Reflex to manage
1-- | This module defines the 'Patch' class, which is used by Reflex to manage
2-- changes to 'Reflex.Class.Incremental' values.
2-- changes to 'Reflex.Class.Incremental' values.
3{-# LANGUAGE CPP #-}
3{-# LANGUAGE CPP #-}
4+{-# LANGUAGE DeriveFoldable #-}
4{-# LANGUAGE DeriveFunctor #-}
5{-# LANGUAGE DeriveFunctor #-}
6+{-# LANGUAGE DeriveTraversable #-}
7+{-# LANGUAGE GADTs #-}
8+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5{-# LANGUAGE LambdaCase #-}
9{-# LANGUAGE LambdaCase #-}
10+{-# LANGUAGE PolyKinds #-}
11+{-# LANGUAGE Rank2Types #-}
12+{-# LANGUAGE ScopedTypeVariables #-}
6{-# LANGUAGE StandaloneDeriving #-}
13{-# LANGUAGE StandaloneDeriving #-}
7{-# LANGUAGE TypeFamilies #-}
14{-# LANGUAGE TypeFamilies #-}
8−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
9module Reflex.Patch
15module Reflex.Patch
10 ( Patch (..)
16 ( Patch (..)
11 , PatchDMap (..)
17 , PatchDMap (..)
18+ , mapPatchDMap
19+ , traversePatchDMap
20+ , traversePatchDMapWithKey
21+ , weakenPatchDMapWith
22+ , patchDMapToPatchMapWith
23+ , const2PatchDMapWith
12 , ComposeMaybe (..)
24 , ComposeMaybe (..)
13 , PatchMap (..)
25 , PatchMap (..)
26+ , patchMapNewElements
14 , Group (..)
27 , Group (..)
15 , Additive
28 , Additive
16 , AdditivePatch (..)
29 , AdditivePatch (..)
30+ , PatchMapWithMove
31+ , unPatchMapWithMove
32+ , unsafePatchMapWithMove
33+ , patchMapWithMoveNewElements
34+ , MapEdit (..)
35+ , mapEditMoved
36+ , PatchDMapWithMove
37+ , unPatchDMapWithMove
38+ , unsafePatchDMapWithMove
39+ , patchThatSortsMapWith
40+ , mapPatchDMapWithMove
41+ , traversePatchDMapWithMove
42+ , traversePatchDMapWithMoveWithKey
43+ , weakenPatchDMapWithMoveWith
44+ , patchDMapWithMoveToPatchMapWithMoveWith
45+ , const2PatchDMapWithMoveWith
46+ , DMapEdit (..)
47+ , dmapEditMoved
48+ -- * Test functions
49+ , validPatchMapWithMove
50+ , knownValidPatchMapWithMove
51+ , knownInvalidPatchMapWithMove
17 ) where
52 ) where
18
53
19import Control.Monad.Identity
54import Control.Monad.Identity
20−import Data.Dependent.Map (DMap, GCompare (..))
55+import Data.Dependent.Map (DMap, DSum (..), GCompare (..))
21import qualified Data.Dependent.Map as DMap
56import qualified Data.Dependent.Map as DMap
57+import Data.Function
22import Data.Functor.Constant
58import Data.Functor.Constant
59+import Data.Functor.Misc
60+import Data.List
23import Data.Map (Map)
61import Data.Map (Map)
24import qualified Data.Map as Map
62import qualified Data.Map as Map
63+import Data.Maybe
25import Data.Semigroup (Semigroup (..), stimesIdempotentMonoid, (<>))
64import Data.Semigroup (Semigroup (..), stimesIdempotentMonoid, (<>))
65+import Data.Some (Some)
66+import qualified Data.Some as Some
26
67
27-- | A 'Patch' type represents a kind of change made to a datastructure.
68-- | A 'Patch' type represents a kind of change made to a datastructure.
28class Patch p where
69class Patch p where
@@ -59,9 +100,29 @@ instance GCompare k => Patch (PatchDMap k v) where
59 Nothing -> Just $ Constant ()
100 Nothing -> Just $ Constant ()
60 Just _ -> Nothing
101 Just _ -> Nothing
61
102
103+mapPatchDMap :: (forall a. v a -> v' a) -> PatchDMap k v -> PatchDMap k v'
104+mapPatchDMap f (PatchDMap p) = PatchDMap $ DMap.map (ComposeMaybe . fmap f . getComposeMaybe) p
105+
106+traversePatchDMap :: Applicative m => (forall a. v a -> m (v' a)) -> PatchDMap k v -> m (PatchDMap k v')
107+traversePatchDMap f = traversePatchDMapWithKey $ const f
108+
109+traversePatchDMapWithKey :: Applicative m => (forall a. k a -> v a -> m (v' a)) -> PatchDMap k v -> m (PatchDMap k v')
110+traversePatchDMapWithKey f (PatchDMap p) = PatchDMap <$> DMap.traverseWithKey (\k (ComposeMaybe v) -> ComposeMaybe <$> traverse (f k) v) p
111+
112+weakenPatchDMapWith :: (forall a. v a -> v') -> PatchDMap k v -> PatchMap (Some k) v'
113+weakenPatchDMapWith f (PatchDMap p) = PatchMap $ weakenDMapWith (fmap f . getComposeMaybe) p
114+
115+patchDMapToPatchMapWith :: (f v -> v') -> PatchDMap (Const2 k v) f -> PatchMap k v'
116+patchDMapToPatchMapWith f (PatchDMap p) = PatchMap $ dmapToMapWith (fmap f . getComposeMaybe) p
117+
118+const2PatchDMapWith :: forall k v f a. (v -> f a) -> PatchMap k v -> PatchDMap (Const2 k a) f
119+const2PatchDMapWith f (PatchMap p) = PatchDMap $ DMap.fromDistinctAscList $ g <$> Map.toAscList p
120+ where g :: (k, Maybe v) -> DSum (Const2 k a) (ComposeMaybe f)
121+ g (k, e) = Const2 k :=> ComposeMaybe (f <$> e)
122+
62-- | A set of changes to a 'Map'. Any element may be inserted/updated or
123-- | A set of changes to a 'Map'. Any element may be inserted/updated or
63-- deleted.
124-- deleted.
64−newtype PatchMap k v = PatchMap (Map k (Maybe v))
125+newtype PatchMap k v = PatchMap { unPatchMap :: Map k (Maybe v) }
65
126
66instance Ord k => Patch (PatchMap k v) where
127instance Ord k => Patch (PatchMap k v) where
67 type PatchTarget (PatchMap k v) = Map k v
128 type PatchTarget (PatchMap k v) = Map k v
@@ -88,6 +149,13 @@ instance Ord k => Monoid (PatchMap k v) where
88 mempty = PatchMap mempty
149 mempty = PatchMap mempty
89 mappend = (<>)
150 mappend = (<>)
90
151
152+instance Functor (PatchMap k) where
153+ fmap f = PatchMap . fmap (fmap f) . unPatchMap
154+
155+-- | Returns all the new elements that will be added to the 'Map'
156+patchMapNewElements :: PatchMap k v -> [v]
157+patchMapNewElements (PatchMap p) = catMaybes $ Map.elems p
158+
91---- Patches based on commutative groups
159---- Patches based on commutative groups
92
160
93-- | A 'Group' is a 'Monoid' where every element has an inverse.
161-- | A 'Group' is a 'Monoid' where every element has an inverse.
@@ -96,7 +164,7 @@ class (Semigroup q, Monoid q) => Group q where
96 (~~) :: q -> q -> q
164 (~~) :: q -> q -> q
97 r ~~ s = r <> negateG s
165 r ~~ s = r <> negateG s
98
166
99−-- | An 'Additive' 'Semigroup' is one where the multiplication is commutative
167+-- | An 'Additive' 'Semigroup' is one where (<>) is commutative
100class Semigroup q => Additive q where
168class Semigroup q => Additive q where
101
169
102-- | The elements of an 'Additive' 'Semigroup' can be considered as patches of their own type.
170-- | The elements of an 'Additive' 'Semigroup' can be considered as patches of their own type.
@@ -105,3 +173,171 @@ newtype AdditivePatch p = AdditivePatch { unAdditivePatch :: p }
105instance Additive p => Patch (AdditivePatch p) where
173instance Additive p => Patch (AdditivePatch p) where
106 type PatchTarget (AdditivePatch p) = p
174 type PatchTarget (AdditivePatch p) = p
107 apply (AdditivePatch p) q = Just $ p <> q
175 apply (AdditivePatch p) q = Just $ p <> q
176+
177+data MapEdit k v
178+ = MapEdit_Insert Bool v -- ^ Insert the given value here
179+ | MapEdit_Delete Bool -- ^ Delete the existing value, if any, from here
180+ | MapEdit_Move Bool k -- ^ Move the value here from the given key
181+ deriving (Functor, Foldable, Traversable)
182+
183+mapEditMoved :: MapEdit k v -> Bool
184+mapEditMoved = \case
185+ MapEdit_Insert moved _ -> moved
186+ MapEdit_Delete moved -> moved
187+ MapEdit_Move moved _ -> moved
188+
189+-- | Patch a DMap with additions, deletions, and moves.
190+-- Invariants:
191+-- * The same source key may not be moved to two destination keys.
192+-- * Any key that is the source of a Move must also be edited
193+-- (otherwise, the Move would duplicate it)
194+data PatchMapWithMove k v = PatchMapWithMove (Map k (MapEdit k v)) deriving (Functor, Foldable, Traversable)
195+
196+unPatchMapWithMove :: PatchMapWithMove k v -> Map k (MapEdit k v)
197+unPatchMapWithMove (PatchMapWithMove p) = p
198+
199+-- | Warning: when using this function, you must ensure that the invariants of
200+-- 'PatchMapWithMove' are preserved; they will not be checked.
201+unsafePatchMapWithMove :: Map k (MapEdit k v) -> PatchMapWithMove k v
202+unsafePatchMapWithMove = PatchMapWithMove
203+
204+instance Ord k => Patch (PatchMapWithMove k v) where
205+ type PatchTarget (PatchMapWithMove k v) = Map k v
206+ apply (PatchMapWithMove p) old = Just $! insertions `Map.union` (old `Map.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?
207+ where insertions = flip Map.mapMaybeWithKey p $ const $ \case
208+ MapEdit_Insert _ v -> Just v
209+ MapEdit_Move _ k -> Map.lookup k old
210+ MapEdit_Delete _ -> Nothing
211+ deletions = flip Map.mapMaybeWithKey p $ const $ \case
212+ MapEdit_Delete _ -> Nothing
213+ _ -> Just ()
214+
215+-- | Returns all the new elements that will be added to the 'Map'
216+patchMapWithMoveNewElements :: PatchMapWithMove k v -> [v]
217+patchMapWithMoveNewElements (PatchMapWithMove p) = catMaybes $ flip fmap (Map.elems p) $ \case
218+ MapEdit_Insert _ v -> Just v
219+ MapEdit_Move _ _ -> Nothing
220+ MapEdit_Delete _ -> Nothing
221+
222+validPatchMapWithMove :: Ord k => PatchMapWithMove k v -> Bool
223+validPatchMapWithMove (PatchMapWithMove p) =
224+ let moveSources = catMaybes $ flip fmap (Map.elems p) $ \case
225+ MapEdit_Move _ k -> Just k
226+ _ -> Nothing
227+ in and
228+ [ -- All Moves must have unique source keys - a single source key can't be moved to two destinations
229+ all (==1) $ Map.fromListWith (+) $ fmap (\k -> (k, 1 :: Integer )) moveSources
230+ , -- All Move source keys must also be patched - since the value's being moved elsewhere, the original must either be Deleted or replaced (with Insert or Move)
231+ all (isJust . flip Map.lookup p) moveSources
232+ ]
233+
234+knownValidPatchMapWithMove :: [PatchMapWithMove Int Int]
235+knownValidPatchMapWithMove =
236+ [ PatchMapWithMove mempty
237+ , PatchMapWithMove $ Map.fromList
238+ [ (1, MapEdit_Move True 2)
239+ , (2, MapEdit_Move True 1)
240+ ]
241+ ]
242+
243+knownInvalidPatchMapWithMove :: [PatchMapWithMove Int Int]
244+knownInvalidPatchMapWithMove =
245+ [ -- Invalid because we move 2 to 1, but don't specify what to do with 2
246+ PatchMapWithMove $ Map.singleton 1 $ MapEdit_Move False 2
247+ , -- Invalid because we have multiple moves from 3
248+ PatchMapWithMove $ Map.fromList
249+ [ (1, MapEdit_Move False 3)
250+ , (2, MapEdit_Move False 3)
251+ , (3, MapEdit_Delete True)
252+ ]
253+ ]
254+
255+patchThatSortsMapWith :: Ord k => (v -> v -> Ordering) -> Map k v -> PatchMapWithMove k v
256+patchThatSortsMapWith cmp m = PatchMapWithMove $ Map.fromList $ catMaybes $ zipWith g l $ sortBy (cmp `on` snd) l
257+ where l = Map.toList m
258+ g (to, _) (from, _) = if to == from
259+ then Nothing
260+ else Just (to, MapEdit_Move True from)
261+
262+data DMapEdit (k :: a -> *) (v :: a -> *) :: a -> * where
263+ -- | Insert the given value here
264+ DMapEdit_Insert :: Bool -> v a -> DMapEdit k v a
265+ -- | Delete the existing value, if any, from here
266+ DMapEdit_Delete :: Bool -> DMapEdit k v a
267+ -- | Move the value here from the given key
268+ DMapEdit_Move :: Bool -> k a -> DMapEdit k v a
269+
270+dmapEditMoved :: DMapEdit k v a -> Bool
271+dmapEditMoved = \case
272+ DMapEdit_Insert moved _ -> moved
273+ DMapEdit_Delete moved -> moved
274+ DMapEdit_Move moved _ -> moved
275+
276+-- | Like 'PatchMapWithMove', but for 'DMap'.
277+newtype PatchDMapWithMove k v = PatchDMapWithMove (DMap k (DMapEdit k v))
278+
279+unPatchDMapWithMove :: PatchDMapWithMove k v -> DMap k (DMapEdit k v)
280+unPatchDMapWithMove (PatchDMapWithMove p) = p
281+
282+-- | Warning: when using this function, you must ensure that the invariants of
283+-- 'PatchDMapWithMove' are preserved; they will not be checked.
284+unsafePatchDMapWithMove :: DMap k (DMapEdit k v) -> PatchDMapWithMove k v
285+unsafePatchDMapWithMove = PatchDMapWithMove
286+
287+mapPatchDMapWithMove :: forall k v v'. (forall a. v a -> v' a) -> PatchDMapWithMove k v -> PatchDMapWithMove k v'
288+mapPatchDMapWithMove f (PatchDMapWithMove p) = PatchDMapWithMove $ DMap.map g p
289+ where g :: forall a. DMapEdit k v a -> DMapEdit k v' a
290+ g = \case
291+ DMapEdit_Insert moved v -> DMapEdit_Insert moved $ f v
292+ DMapEdit_Delete moved -> DMapEdit_Delete moved
293+ DMapEdit_Move moved k -> DMapEdit_Move moved k
294+
295+traversePatchDMapWithMove :: forall m k v v'. Applicative m => (forall a. v a -> m (v' a)) -> PatchDMapWithMove k v -> m (PatchDMapWithMove k v')
296+traversePatchDMapWithMove f = traversePatchDMapWithMoveWithKey $ const f
297+
298+traversePatchDMapWithMoveWithKey :: forall m k v v'. Applicative m => (forall a. k a -> v a -> m (v' a)) -> PatchDMapWithMove k v -> m (PatchDMapWithMove k v')
299+traversePatchDMapWithMoveWithKey f (PatchDMapWithMove p) = PatchDMapWithMove <$> DMap.traverseWithKey g p
300+ where g :: forall a. k a -> DMapEdit k v a -> m (DMapEdit k v' a)
301+ g k = \case
302+ DMapEdit_Insert moved v -> DMapEdit_Insert moved <$> f k v
303+ DMapEdit_Delete moved -> pure $ DMapEdit_Delete moved
304+ DMapEdit_Move moved fromKey -> pure $ DMapEdit_Move moved fromKey
305+
306+weakenPatchDMapWithMoveWith :: forall k v v'. (forall a. v a -> v') -> PatchDMapWithMove k v -> PatchMapWithMove (Some k) v'
307+weakenPatchDMapWithMoveWith f (PatchDMapWithMove p) = PatchMapWithMove $ weakenDMapWith g p
308+ where g :: forall a. DMapEdit k v a -> MapEdit (Some k) v'
309+ g = \case
310+ DMapEdit_Insert moved v -> MapEdit_Insert moved $ f v
311+ DMapEdit_Delete moved -> MapEdit_Delete moved
312+ DMapEdit_Move moved k -> MapEdit_Move moved $ Some.This k
313+
314+patchDMapWithMoveToPatchMapWithMoveWith :: forall k f v v'. (f v -> v') -> PatchDMapWithMove (Const2 k v) f -> PatchMapWithMove k v'
315+patchDMapWithMoveToPatchMapWithMoveWith f (PatchDMapWithMove p) = PatchMapWithMove $ dmapToMapWith g p
316+ where g :: DMapEdit (Const2 k v) f v -> MapEdit k v'
317+ g = \case
318+ DMapEdit_Insert moved v -> MapEdit_Insert moved $ f v
319+ DMapEdit_Delete moved -> MapEdit_Delete moved
320+ DMapEdit_Move moved (Const2 k) -> MapEdit_Move moved k
321+
322+const2PatchDMapWithMoveWith :: forall k v f a. (v -> f a) -> PatchMapWithMove k v -> PatchDMapWithMove (Const2 k a) f
323+const2PatchDMapWithMoveWith f (PatchMapWithMove p) = PatchDMapWithMove $ DMap.fromDistinctAscList $ g <$> Map.toAscList p
324+ where g :: (k, MapEdit k v) -> DSum (Const2 k a) (DMapEdit (Const2 k a) f)
325+ g (k, e) = Const2 k :=> case e of
326+ MapEdit_Insert moved v -> DMapEdit_Insert moved $ f v
327+ MapEdit_Delete moved -> DMapEdit_Delete moved
328+ MapEdit_Move moved fromKey -> DMapEdit_Move moved $ Const2 fromKey
329+
330+instance GCompare k => Patch (PatchDMapWithMove k v) where
331+ type PatchTarget (PatchDMapWithMove k v) = DMap k v
332+ 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?
333+ where insertions = DMap.mapMaybeWithKey insertFunc p
334+ insertFunc :: forall a. k a -> DMapEdit k v a -> Maybe (v a)
335+ insertFunc _ = \case
336+ DMapEdit_Insert _ v -> Just v
337+ DMapEdit_Move _ k -> DMap.lookup k old
338+ DMapEdit_Delete _ -> Nothing
339+ deletions = DMap.mapMaybeWithKey deleteFunc p
340+ deleteFunc :: forall a. k a -> DMapEdit k v a -> Maybe (Constant () a)
341+ deleteFunc _ = \case
342+ DMapEdit_Delete _ -> Nothing
343+ _ -> Just $ Constant ()
src/Reflex/PerformEvent/Base.hs+13−7
@@ -76,13 +76,19 @@ instance (ReflexHost t, PrimMonad (HostFrame t)) => MonadAdjust t (PerformEventT
76 result0 <- lift a0
76 result0 <- lift a0
77 result' <- requestingIdentity a'
77 result' <- requestingIdentity a'
78 return (result0, result')
78 return (result0, result')
79+ traverseDMapWithKeyWithAdjust f outerDm0 outerDm' = PerformEventT $ sequenceDMapWithAdjustRequesterTWith (defaultAdjustBase traversePatchDMapWithKey) mapPatchDMap weakenPatchDMapWith patchMapNewElements mergeMapIncremental (\k v -> unPerformEventT $ f k v) (coerce outerDm0) (coerceEvent outerDm')
79− sequenceDMapWithAdjust (outerDm0 :: DMap k (PerformEventT t m)) outerDm' = PerformEventT $ sequenceDMapWithAdjustRequesterTWith f (coerce outerDm0) (coerceEvent outerDm')
80+ traverseDMapWithKeyWithAdjustWithMove f outerDm0 outerDm' = PerformEventT $ sequenceDMapWithAdjustRequesterTWith (defaultAdjustBase traversePatchDMapWithMoveWithKey) mapPatchDMapWithMove weakenPatchDMapWithMoveWith patchMapWithMoveNewElements mergeMapIncrementalWithMove (\k v -> unPerformEventT $ f k v) (coerce outerDm0) (coerceEvent outerDm')
81+
82+defaultAdjustBase :: forall t v v2 k' p. (Monad (HostFrame t), PrimMonad (HostFrame t), Reflex t)
83+ => ((forall a. k' a -> v a -> HostFrame t (v2 a)) -> p k' v -> HostFrame t (p k' v2))
84+ -> (forall a. k' a -> v a -> HostFrame t (v2 a))
85+ -> DMap k' v
86+ -> Event t (p k' v)
80− where f :: DMap k' (HostFrame t) -> Event t (PatchDMap k' (HostFrame t)) -> RequesterT t (HostFrame t) Identity (HostFrame t) (DMap k' Identity, Event t (PatchDMap k' Identity))
87+ -> RequesterT t (HostFrame t) Identity (HostFrame t) (DMap k' v2, Event t (p k' v2))
81− f dm0 dm' = do
88+defaultAdjustBase traversePatchWithKey f' dm0 dm' = do
82− result0 <- lift $ DMap.traverseWithKey (\_ v -> Identity <$> v) dm0
89+ result0 <- lift $ DMap.traverseWithKey f' dm0
83− result' <- requestingIdentity $ ffor dm' $ \(PatchDMap p) -> do
90+ result' <- requestingIdentity $ ffor dm' $ traversePatchWithKey f'
84− PatchDMap <$> DMap.traverseWithKey (\_ (ComposeMaybe mv) -> ComposeMaybe <$> mapM (fmap Identity) mv) p
85− return (result0, result')
91+ return (result0, result')
86
92
87instance ReflexHost t => MonadReflexCreateTrigger t (PerformEventT t m) where
93instance ReflexHost t => MonadReflexCreateTrigger t (PerformEventT t m) where
88 {-# INLINABLE newEventWithTrigger #-}
94 {-# INLINABLE newEventWithTrigger #-}
src/Reflex/PostBuild/Base.hs+32−9
@@ -5,6 +5,7 @@
5{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE FlexibleInstances #-}
6{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
8+{-# LANGUAGE RankNTypes #-}
8{-# LANGUAGE RecursiveDo #-}
9{-# LANGUAGE RecursiveDo #-}
9{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE TypeFamilies #-}
11{-# LANGUAGE TypeFamilies #-}
@@ -25,11 +26,14 @@ import Reflex.PostBuild.Class
25import Reflex.TriggerEvent.Class
26import Reflex.TriggerEvent.Class
26
27
27import Control.Monad.Exception
28import Control.Monad.Exception
29+import Control.Monad.Identity
28import Control.Monad.Primitive
30import Control.Monad.Primitive
29import Control.Monad.Reader
31import Control.Monad.Reader
30import Control.Monad.Ref
32import Control.Monad.Ref
31import Control.Monad.Trans.Control
33import Control.Monad.Trans.Control
34+import Data.Dependent.Map (DMap)
32import qualified Data.Dependent.Map as DMap
35import qualified Data.Dependent.Map as DMap
36+import Data.Functor.Compose
33
37
34-- | Provides a basic implementation of 'PostBuild'.
38-- | Provides a basic implementation of 'PostBuild'.
35newtype PostBuildT t m a = PostBuildT { unPostBuildT :: ReaderT (Event t ()) m a } deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadTrans, MonadException, MonadAsyncException)
39newtype PostBuildT t m a = PostBuildT { unPostBuildT :: ReaderT (Event t ()) m a } deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadTrans, MonadException, MonadAsyncException)
@@ -108,12 +112,31 @@ instance (Reflex t, MonadHold t m, MonadFix m, MonadAdjust t m, PerformEvent t m
108 rec result@(_, result') <- runWithReplace (runPostBuildT a0 postBuild) $ fmap (\v -> runPostBuildT v =<< headE voidResult') a'
112 rec result@(_, result') <- runWithReplace (runPostBuildT a0 postBuild) $ fmap (\v -> runPostBuildT v =<< headE voidResult') a'
109 let voidResult' = fmapCheap (\_ -> ()) result'
113 let voidResult' = fmapCheap (\_ -> ()) result'
110 return result
114 return result
111− sequenceDMapWithAdjust dm0 dm' = do
115+ traverseDMapWithKeyWithAdjust = mapDMapWithAdjustImpl traverseDMapWithKeyWithAdjust mapPatchDMap
116+ traverseDMapWithKeyWithAdjustWithMove = mapDMapWithAdjustImpl traverseDMapWithKeyWithAdjustWithMove mapPatchDMapWithMove
117+
118+mapDMapWithAdjustImpl :: forall t m k v v' p. (Reflex t, MonadFix m, MonadHold t m)
119+ => ( (forall a. k a -> Compose ((,) (Bool, Event t ())) v a -> m (v' a))
120+ -> DMap k (Compose ((,) (Bool, Event t ())) v)
121+ -> Event t (p k (Compose ((,) (Bool, Event t ())) v))
122+ -> m (DMap k v', Event t (p k v'))
123+ )
124+ -> ((forall a. v a -> Compose ((,) (Bool, Event t ())) v a) -> p k v -> p k (Compose ((,) (Bool, Event t ())) v))
125+ -> (forall a. k a -> v a -> PostBuildT t m (v' a))
126+ -> DMap k v
127+ -> Event t (p k v)
128+ -> PostBuildT t m (DMap k v', Event t (p k v'))
129+mapDMapWithAdjustImpl base mapPatch f dm0 dm' = do
112− postBuild <- getPostBuild
130+ postBuild <- getPostBuild
113− let loweredDm0 = DMap.map (`runPostBuildT` postBuild) dm0
131+ let loweredDm0 = DMap.map (Compose . (,) (False, postBuild)) dm0
114− lift $ do
132+ f' :: forall a. k a -> Compose ((,) (Bool, Event t ())) v a -> m (v' a)
115− rec (result0, result') <- sequenceDMapWithAdjust loweredDm0 loweredDm'
133+ f' k (Compose ((shouldHeadE, e), v)) = do
116− let voidResult' = fmapCheap (\_ -> ()) result'
134+ eOnce <- if shouldHeadE
117− let loweredDm' = ffor dm' $ \(PatchDMap p) -> PatchDMap $
118− DMap.map (ComposeMaybe . fmap (\v -> runPostBuildT v =<< headE voidResult') . getComposeMaybe) p --TODO: Avoid doing this headE so many times; once per loweredDm' firing ought to be OK, but it's not totally trivial to do because result' might be firing at the same time, and we don't want *that* to be the postBuild occurrence
135+ then headE e --TODO: Avoid doing this headE so many times; once per loweredDm' firing ought to be OK, but it's not totally trivial to do because result' might be firing at the same time, and we don't want *that* to be the postBuild occurrence
136+ else return e
137+ runPostBuildT (f k v) eOnce
138+ lift $ do
139+ rec (result0, result') <- base f' loweredDm0 loweredDm'
140+ let voidResult' = fmapCheap (\_ -> ()) result'
141+ let loweredDm' = ffor dm' $ mapPatch (Compose . (,) (True, voidResult'))
119− return (result0, result')
142+ return (result0, result')
src/Reflex/Pure.hs+9−5
@@ -108,11 +108,8 @@ instance (Enum t, HasTrie t, Ord t) => Reflex (Pure t) where
108 --a) -> Incremental (Pure t) p a
108 --a) -> Incremental (Pure t) p a
109 unsafeBuildIncremental readV0 p = Incremental $ \t -> (readV0 t, unEvent p t)
109 unsafeBuildIncremental readV0 p = Incremental $ \t -> (readV0 t, unEvent p t)
110
110
111− mergeIncremental i = Event $ \t ->
111+ mergeIncremental = mergeIncrementalImpl
112− let results = DMap.mapMaybeWithKey (\_ (Event e) -> Identity <$> e t) $ fst $ unIncremental i t
112+ mergeIncrementalWithMove = mergeIncrementalImpl
113− in if DMap.null results
114− then Nothing
115− else Just results
116
113
117 currentIncremental i = Behavior $ \t -> fst $ unIncremental i t
114 currentIncremental i = Behavior $ \t -> fst $ unIncremental i t
118
115
@@ -128,6 +125,13 @@ instance (Enum t, HasTrie t, Ord t) => Reflex (Pure t) where
128 eventCoercion Coercion = Coercion
125 eventCoercion Coercion = Coercion
129 dynamicCoercion Coercion = Coercion
126 dynamicCoercion Coercion = Coercion
130
127
128+mergeIncrementalImpl :: (PatchTarget p ~ DMap k (Event (Pure t)), GCompare k) => Incremental (Pure t) p -> Event (Pure t) (DMap k Identity)
129+mergeIncrementalImpl i = Event $ \t ->
130+ let results = DMap.mapMaybeWithKey (\_ (Event e) -> Identity <$> e t) $ fst $ unIncremental i t
131+ in if DMap.null results
132+ then Nothing
133+ else Just results
134+
131instance Functor (Dynamic (Pure t)) where
135instance Functor (Dynamic (Pure t)) where
132 fmap f d = Dynamic $ \t -> let (cur, upd) = unDynamic d t
136 fmap f d = Dynamic $ \t -> let (cur, upd) = unDynamic d t
133 in (f cur, fmap f upd)
137 in (f cur, fmap f upd)
src/Reflex/Requester/Base.hs+35−18
@@ -38,7 +38,9 @@ import Data.Coerce
38import Data.Dependent.Map (DMap, DSum (..))
38import Data.Dependent.Map (DMap, DSum (..))
39import qualified Data.Dependent.Map as DMap
39import qualified Data.Dependent.Map as DMap
40import Data.Functor.Misc
40import Data.Functor.Misc
41+import Data.Map (Map)
41import Data.Unique.Tag
42import Data.Unique.Tag
43+import Data.Some (Some)
42
44
43-- | A basic implementation of 'Requester'.
45-- | A basic implementation of 'Requester'.
44newtype RequesterT t request response m a = RequesterT { unRequesterT :: EventWriterT t (DMap (Tag (PrimState m)) request) (ReaderT (EventSelector t (WrapArg response (Tag (PrimState m)))) m) a }
46newtype RequesterT t request response m a = RequesterT { unRequesterT :: EventWriterT t (DMap (Tag (PrimState m)) request) (ReaderT (EventSelector t (WrapArg response (Tag (PrimState m)))) m) a }
@@ -98,7 +100,8 @@ instance MonadReader r m => MonadReader r (RequesterT t request response m) wher
98
100
99instance (Reflex t, MonadAdjust t m, MonadHold t m) => MonadAdjust t (RequesterT t request response m) where
101instance (Reflex t, MonadAdjust t m, MonadHold t m) => MonadAdjust t (RequesterT t request response m) where
100 runWithReplace (RequesterT a) em = RequesterT $ runWithReplace a (coerceEvent em)
102 runWithReplace (RequesterT a) em = RequesterT $ runWithReplace a (coerceEvent em)
101− sequenceDMapWithAdjust dm edm = RequesterT $ sequenceDMapWithAdjust (coerce dm) (coerceEvent edm)
103+ traverseDMapWithKeyWithAdjust f dm edm = RequesterT $ traverseDMapWithKeyWithAdjust (\k v -> unRequesterT $ f k v) (coerce dm) (coerceEvent edm)
104+ traverseDMapWithKeyWithAdjustWithMove f dm edm = RequesterT $ traverseDMapWithKeyWithAdjustWithMove (\k v -> unRequesterT $ f k v) (coerce dm) (coerceEvent edm)
102
105
103runWithReplaceRequesterTWith :: forall m t request response a b. (Reflex t, MonadHold t m)
106runWithReplaceRequesterTWith :: forall m t request response a b. (Reflex t, MonadHold t m)
104 => (forall a' b'. m a' -> Event t (m b') -> RequesterT t request response m (a', Event t b'))
107 => (forall a' b'. m a' -> Event t (m b') -> RequesterT t request response m (a', Event t b'))
@@ -114,20 +117,34 @@ runWithReplaceRequesterTWith f a0 a' =
114 unRequesterT (f (runReaderT x r) (fmapCheap (`runReaderT` r) y))
117 unRequesterT (f (runReaderT x r) (fmapCheap (`runReaderT` r) y))
115 in RequesterT $ runWithReplaceEventWriterTWith f' (coerce a0) (coerceEvent a')
118 in RequesterT $ runWithReplaceEventWriterTWith f' (coerce a0) (coerceEvent a')
116
119
117−sequenceDMapWithAdjustRequesterTWith :: (GCompare k, Reflex t, MonadHold t m)
120+sequenceDMapWithAdjustRequesterTWith :: forall k t request response m v v' p p'.
121+ ( GCompare k
122+ , Reflex t
123+ , MonadHold t m
124+ , PatchTarget (p' (Some k) (Event t (DMap (Tag (PrimState m)) request))) ~ Map (Some k) (Event t (DMap (Tag (PrimState m)) request))
125+ , Patch (p' (Some k) (Event t (DMap (Tag (PrimState m)) request)))
126+ )
127+ => (forall k' v1 v2. GCompare k'
128+ => (forall a. k' a -> v1 a -> m (v2 a))
129+ -> DMap k' v1
130+ -> Event t (p k' v1)
118− => (forall k'. GCompare k' => DMap k' m -> Event t (PatchDMap k' m) -> RequesterT t request response m (DMap k' Identity, Event t (PatchDMap k' Identity)))
131+ -> RequesterT t request response m (DMap k' v2, Event t (p k' v2))
119− -> DMap k (RequesterT t request response m)
132+ )
120− -> Event t (PatchDMap k (RequesterT t request response m))
133+ -> (forall v1. (forall a. v1 a -> v' a) -> p k v1 -> p k v')
134+ -> (forall v1 v2. (forall a. v1 a -> v2) -> p k v1 -> p' (Some k) v2)
135+ -> (forall v2. p' (Some k) v2 -> [v2])
136+ -> (forall a. Incremental t (p' (Some k) (Event t a)) -> Event t (Map (Some k) a))
121− -> RequesterT t request response m (DMap k Identity, Event t (PatchDMap k Identity))
137+ -> (forall a. k a -> v a -> RequesterT t request response m (v' a))
122−sequenceDMapWithAdjustRequesterTWith f (dm0 :: DMap k (RequesterT t request response m)) dm' =
138+ -> DMap k v
123− let dmapUnwrap r = mapKeyValuePairsMonotonic $ \(k :=> v) -> k :=> runReaderT v r
139+ -> Event t (p k v)
124− patchDmapUnwrap r (PatchDMap p) = PatchDMap $ mapKeyValuePairsMonotonic
140+ -> RequesterT t request response m (DMap k v', Event t (p k v'))
125− (\(k :=> ComposeMaybe mv) -> k :=> ComposeMaybe (fmap (`runReaderT` r) mv)) p
141+sequenceDMapWithAdjustRequesterTWith base mapPatch weakenPatchWith patchNewElements mergePatchIncremental f dm0 dm' =
126− f' :: forall k'. GCompare k'
142+ let base' :: forall v1 v2.
127− => DMap k' (ReaderT (EventSelector t (WrapArg response (Tag (PrimState m)))) m)
143+ (forall a. k a -> v1 a -> ReaderT (EventSelector t (WrapArg response (Tag (PrimState m)))) m (v2 a))
128− -> Event t (PatchDMap k' (ReaderT (EventSelector t (WrapArg response (Tag (PrimState m)))) m))
144+ -> DMap k v1
145+ -> Event t (p k v1)
129− -> EventWriterT t (DMap (Tag (PrimState m)) request) (ReaderT (EventSelector t (WrapArg response (Tag (PrimState m)))) m) (DMap k' Identity, Event t (PatchDMap k' Identity))
146+ -> EventWriterT t (DMap (Tag (PrimState m)) request) (ReaderT (EventSelector t (WrapArg response (Tag (PrimState m)))) m) (DMap k v2, Event t (p k v2))
130− f' x y = do
147+ base' f' x y = do
131− r <- EventWriterT $ ask
148+ r <- EventWriterT ask
132− unRequesterT (f (dmapUnwrap r x) (fmap (patchDmapUnwrap r) y))
149+ unRequesterT $ base (\k v -> runReaderT (f' k v) r) x y
133− in RequesterT $ sequenceDMapWithAdjustEventWriterTWith f' (coerce dm0) (coerceEvent dm')
150+ in RequesterT $ sequenceDMapWithAdjustEventWriterTWith base' mapPatch weakenPatchWith patchNewElements mergePatchIncremental (\k v -> unRequesterT $ f k v) (coerce dm0) (coerceEvent dm')
src/Reflex/Spider/Internal.hs+129−36
@@ -960,6 +960,11 @@ runComputeM (ComputeM a) = liftIO . runReaderT a =<< getDeferralQueue
960
960
961newtype MergeSubscribedParent x a = MergeSubscribedParent { unMergeSubscribedParent :: EventSubscription x }
961newtype MergeSubscribedParent x a = MergeSubscribedParent { unMergeSubscribedParent :: EventSubscription x }
962
962
963+data MergeSubscribedParentWithMove x k a = MergeSubscribedParentWithMove
964+ { _mergeSubscribedParentWithMove_subscription :: !(EventSubscription x)
965+ , _mergeSubscribedParentWithMove_key :: !(IORef (k a))
966+ }
967+
963data HeightBag = HeightBag
968data HeightBag = HeightBag
964 { _heightBag_size :: {-# UNPACK #-} !Int
969 { _heightBag_size :: {-# UNPACK #-} !Int
965 , _heightBag_contents :: !(IntMap Word) -- Number of excess in each bucket
970 , _heightBag_contents :: !(IntMap Word) -- Number of excess in each bucket
@@ -1550,14 +1555,121 @@ subscribeCoincidenceSubscribed subscribed sub = WeakBag.insert sub (coincidenceS
1550merge :: forall k x. (HasSpiderTimeline x, GCompare k) => Dynamic x (PatchDMap k (Event x)) -> Event x (DMap k Identity)
1555merge :: forall k x. (HasSpiderTimeline x, GCompare k) => Dynamic x (PatchDMap k (Event x)) -> Event x (DMap k Identity)
1551merge d = cacheEvent (mergeCheap d)
1556merge d = cacheEvent (mergeCheap d)
1552
1557
1558+{-# INLINE mergeWithMove #-}
1559+mergeWithMove :: forall k x. (HasSpiderTimeline x, GCompare k) => Dynamic x (PatchDMapWithMove k (Event x)) -> Event x (DMap k Identity)
1560+mergeWithMove d = cacheEvent (mergeCheapWithMove d)
1561+
1553{-# INLINE [1] mergeCheap #-}
1562{-# INLINE [1] mergeCheap #-}
1554mergeCheap :: forall k x. (HasSpiderTimeline x, GCompare k) => Dynamic x (PatchDMap k (Event x)) -> Event x (DMap k Identity)
1563mergeCheap :: forall k x. (HasSpiderTimeline x, GCompare k) => Dynamic x (PatchDMap k (Event x)) -> Event x (DMap k Identity)
1555−mergeCheap d = Event $ \sub -> do
1564+mergeCheap = mergeCheap' getInitialSubscribers updateMe destroy DMap.size
1565+ where
1566+ updateMe :: MergeUpdateFunc k x (PatchDMap k (Event x)) (MergeSubscribedParent x)
1567+ updateMe subscriber heightBagRef oldParents (PatchDMap p) = do
1568+ let f (subscriptionsToKill, ps) (k :=> ComposeMaybe me) = do
1569+ (mOldSubd, newPs) <- case me of
1570+ Nothing -> return $ DMap.updateLookupWithKey (\_ _ -> Nothing) k ps
1571+ Just e -> do
1572+ let s = subscriber $ return k
1573+ subscription@(EventSubscription _ subd) <- subscribe e s
1574+ newParentHeight <- liftIO $ getEventSubscribedHeight subd
1575+ let newParent = MergeSubscribedParent subscription
1576+ liftIO $ modifyIORef' heightBagRef $ heightBagAdd newParentHeight
1577+ return $ DMap.insertLookupWithKey' (\_ new _ -> new) k newParent ps
1578+ forM_ mOldSubd $ \oldSubd -> do
1579+ oldHeight <- liftIO $ getEventSubscribedHeight $ _eventSubscription_subscribed $ unMergeSubscribedParent oldSubd
1580+ liftIO $ modifyIORef heightBagRef $ heightBagRemove oldHeight
1581+ return (maybeToList (unMergeSubscribedParent <$> mOldSubd) ++ subscriptionsToKill, newPs)
1582+ foldM f ([], oldParents) $ DMap.toList p
1583+ getInitialSubscribers :: MergeInitFunc k x (MergeSubscribedParent x)
1584+ getInitialSubscribers initialParents subscriber = do
1585+ subscribers <- forM (DMap.toList initialParents) $ \(k :=> e) -> do
1586+ let s = subscriber $ return k
1587+ (subscription@(EventSubscription _ parentSubd), parentOcc) <- subscribeAndRead e s
1588+ height <- liftIO $ getEventSubscribedHeight parentSubd
1589+ return (fmap (\x -> k :=> Identity x) parentOcc, height, k :=> MergeSubscribedParent subscription)
1590+ return ( DMap.fromDistinctAscList $ mapMaybe (\(x, _, _) -> x) subscribers
1591+ , fmap (\(_, h, _) -> h) subscribers --TODO: Assert that there's no invalidHeight in here
1592+ , DMap.fromDistinctAscList $ map (\(_, _, x) -> x) subscribers
1593+ )
1594+ destroy :: MergeDestroyFunc k (MergeSubscribedParent x)
1595+ destroy s = forM_ (DMap.toList s) $ \(_ :=> MergeSubscribedParent sub) -> unsubscribe sub
1596+
1597+{-# INLINE [1] mergeCheapWithMove #-}
1598+mergeCheapWithMove :: forall k x. (HasSpiderTimeline x, GCompare k) => Dynamic x (PatchDMapWithMove k (Event x)) -> Event x (DMap k Identity)
1599+mergeCheapWithMove = mergeCheap' getInitialSubscribers updateMe destroy DMap.size
1600+ where
1601+ updateMe :: MergeUpdateFunc k x (PatchDMapWithMove k (Event x)) (MergeSubscribedParentWithMove x k)
1602+ updateMe subscriber heightBagRef oldParents pWrapped = do
1603+ let p = unPatchDMapWithMove pWrapped
1604+ let f (subscriptionsToKill, ps) (k :=> edit) = do
1605+ let deleteHere = return $ DMap.updateLookupWithKey (\_ _ -> Nothing) k ps
1606+ insertHere e = do
1607+ keyRef <- liftIO $ newIORef k
1608+ let s = subscriber $ liftIO $ readIORef keyRef
1609+ subscription@(EventSubscription _ subd) <- subscribe e s
1610+ liftIO $ do
1611+ newParentHeight <- getEventSubscribedHeight subd
1612+ let newParent = MergeSubscribedParentWithMove subscription keyRef
1613+ modifyIORef' heightBagRef $ heightBagAdd newParentHeight
1614+ return $ DMap.insertLookupWithKey' (\_ new _ -> new) k newParent ps
1615+ (mOldSubd, newPs) <- case edit of
1616+ DMapEdit_Delete moved -> do
1617+ (toDelete, newPs) <- deleteHere
1618+ return (if moved then Nothing else toDelete, newPs)
1619+ DMapEdit_Insert moved e -> do
1620+ (toDelete, newPs) <- insertHere e
1621+ return (if moved then Nothing else toDelete, newPs)
1622+ DMapEdit_Move moved sourceKey -> do
1623+ (toDelete, newPs) <- case DMap.lookup sourceKey ps of
1624+ Nothing -> deleteHere
1625+ Just s@(MergeSubscribedParentWithMove _ keyRef) -> do
1626+ liftIO $ writeIORef keyRef k
1627+ return $ DMap.insertLookupWithKey' (\_ new _ -> new) k s ps
1628+ return (if moved then Nothing else toDelete, newPs)
1629+ forM_ mOldSubd $ \oldSubd -> do
1630+ oldHeight <- liftIO $ getEventSubscribedHeight $ _eventSubscription_subscribed $ _mergeSubscribedParentWithMove_subscription oldSubd
1631+ liftIO $ modifyIORef heightBagRef $ heightBagRemove oldHeight
1632+ return (maybeToList (_mergeSubscribedParentWithMove_subscription <$> mOldSubd) ++ subscriptionsToKill, newPs)
1633+ foldM f ([], oldParents) $ DMap.toList p
1634+ getInitialSubscribers :: MergeInitFunc k x (MergeSubscribedParentWithMove x k)
1635+ getInitialSubscribers initialParents subscriber = do
1636+ subscribers <- forM (DMap.toList initialParents) $ \(k :=> e) -> do
1637+ keyRef <- liftIO $ newIORef k
1638+ let s = subscriber $ liftIO $ readIORef keyRef
1639+ (subscription@(EventSubscription _ parentSubd), parentOcc) <- subscribeAndRead e s
1640+ height <- liftIO $ getEventSubscribedHeight parentSubd
1641+ return (fmap (\x -> k :=> Identity x) parentOcc, height, k :=> MergeSubscribedParentWithMove subscription keyRef)
1642+ return ( DMap.fromDistinctAscList $ mapMaybe (\(x, _, _) -> x) subscribers
1643+ , fmap (\(_, h, _) -> h) subscribers --TODO: Assert that there's no invalidHeight in here
1644+ , DMap.fromDistinctAscList $ map (\(_, _, x) -> x) subscribers
1645+ )
1646+ destroy :: MergeDestroyFunc k (MergeSubscribedParentWithMove x k)
1647+ destroy s = forM_ (DMap.toList s) $ \(_ :=> MergeSubscribedParentWithMove sub _) -> unsubscribe sub
1648+
1649+type MergeUpdateFunc k x p s
1650+ = (forall a. EventM x (k a) -> Subscriber x a)
1651+ -> IORef HeightBag
1652+ -> DMap k s
1653+ -> p
1654+ -> EventM x ([EventSubscription x], DMap k s)
1655+
1656+type MergeInitFunc k x s
1657+ = DMap k (Event x)
1658+ -> (forall a. EventM x (k a) -> Subscriber x a)
1659+ -> EventM x (DMap k Identity, [Height], DMap k s)
1660+
1661+type MergeDestroyFunc k s
1662+ = DMap k s
1663+ -> IO ()
1664+
1665+{-# INLINE mergeCheap' #-}
1666+mergeCheap' :: forall k x p s. (HasSpiderTimeline x, GCompare k, PatchTarget p ~ DMap k (Event x)) => MergeInitFunc k x s -> MergeUpdateFunc k x p s -> MergeDestroyFunc k s -> (DMap k s -> Int) -> Dynamic x p -> Event x (DMap k Identity)
1667+mergeCheap' getInitialSubscribers updateFunc destroy numParents d = Event $ \sub -> do
1556 initialParents <- readBehaviorUntracked $ dynamicCurrent d
1668 initialParents <- readBehaviorUntracked $ dynamicCurrent d
1557 accumRef <- liftIO $ newIORef $ error "merge: accumRef not yet initialized"
1669 accumRef <- liftIO $ newIORef $ error "merge: accumRef not yet initialized"
1558 heightRef <- liftIO $ newIORef $ error "merge: heightRef not yet initialized"
1670 heightRef <- liftIO $ newIORef $ error "merge: heightRef not yet initialized"
1559 heightBagRef <- liftIO $ newIORef $ error "merge: heightBagRef not yet initialized"
1671 heightBagRef <- liftIO $ newIORef $ error "merge: heightBagRef not yet initialized"
1560− parentsRef <- liftIO $ newIORef $ error "merge: parentsRef not yet initialized"
1672+ parentsRef :: IORef (DMap k s) <- liftIO $ newIORef $ error "merge: parentsRef not yet initialized"
1561 let scheduleSelf height = scheduleMerge' height heightRef $ do
1673 let scheduleSelf height = scheduleMerge' height heightRef $ do
1562 m <- liftIO $ readIORef accumRef
1674 m <- liftIO $ readIORef accumRef
1563 liftIO $ writeIORef accumRef $! DMap.empty
1675 liftIO $ writeIORef accumRef $! DMap.empty
@@ -1574,7 +1686,7 @@ mergeCheap d = Event $ \sub -> do
1574 heights <- readIORef heightBagRef
1686 heights <- readIORef heightBagRef
1575 parents <- readIORef parentsRef
1687 parents <- readIORef parentsRef
1576 -- When the number of heights in the bag reaches the number of parents, we should have a valid height
1688 -- When the number of heights in the bag reaches the number of parents, we should have a valid height
1577− case heightBagSize heights `compare` DMap.size parents of
1689+ case heightBagSize heights `compare` numParents parents of
1578 LT -> return ()
1690 LT -> return ()
1579 EQ -> do
1691 EQ -> do
1580 let height = succHeight $ heightBagMax heights
1692 let height = succHeight $ heightBagMax heights
@@ -1582,10 +1694,11 @@ mergeCheap d = Event $ \sub -> do
1582 writeIORef heightRef $! height
1694 writeIORef heightRef $! height
1583 subscriberRecalculateHeight sub height
1695 subscriberRecalculateHeight sub height
1584 GT -> error $ "revalidateMergeHeight: more heights than parents for Merge"
1696 GT -> error $ "revalidateMergeHeight: more heights than parents for Merge"
1585− subscriber :: forall a. k a -> Subscriber x a
1697+ subscriber :: forall a. EventM x (k a) -> Subscriber x a
1586− subscriber k = Subscriber
1698+ subscriber getKey = Subscriber
1587 { subscriberPropagate = \a -> do
1699 { subscriberPropagate = \a -> do
1588 oldM <- liftIO $ readIORef accumRef
1700 oldM <- liftIO $ readIORef accumRef
1701+ k <- getKey
1589 let newM = DMap.insertWith (error $ "Same key fired multiple times for Merge") k (Identity a) oldM
1702 let newM = DMap.insertWith (error $ "Same key fired multiple times for Merge") k (Identity a) oldM
1590 tracePropagate (Proxy :: Proxy x) $ " DMap.size oldM = " <> show (DMap.size oldM) <> "; DMap.size newM = " <> show (DMap.size newM)
1703 tracePropagate (Proxy :: Proxy x) $ " DMap.size oldM = " <> show (DMap.size oldM) <> "; DMap.size newM = " <> show (DMap.size newM)
1591 liftIO $ writeIORef accumRef $! newM
1704 liftIO $ writeIORef accumRef $! newM
@@ -1615,14 +1728,13 @@ mergeCheap d = Event $ \sub -> do
1615 modifyIORef' heightBagRef $ heightBagAdd new
1728 modifyIORef' heightBagRef $ heightBagAdd new
1616 revalidateMyHeight
1729 revalidateMyHeight
1617 }
1730 }
1618− subscribers :: [(Maybe (DSum k Identity), Height, DSum k (MergeSubscribedParent x))] <- forM (DMap.toList initialParents) $ \(k :=> e) -> do
1731+ let updateMe x = do
1619− let s = subscriber k
1732+ oldParents <- liftIO $ readIORef parentsRef
1620− (subscription@(EventSubscription _ parentSubd), parentOcc) <- subscribeAndRead e s
1733+ (subscriptionsToKill, newParents) <- updateFunc subscriber heightBagRef oldParents x
1621− height <- liftIO $ getEventSubscribedHeight parentSubd
1734+ liftIO $ writeIORef parentsRef $! newParents
1622− return $ (fmap (\x -> k :=> Identity x) parentOcc, height, k :=> MergeSubscribedParent subscription)
1735+ return subscriptionsToKill
1623− let dm = DMap.fromDistinctAscList $ mapMaybe (\(x, _, _) -> x) subscribers
1736+ (dm, heights, initialParentState) <- getInitialSubscribers initialParents subscriber
1624− heights = fmap (\(_, h, _) -> h) subscribers --TODO: Assert that there's no invalidHeight in here
1625− myHeightBag = heightBagFromList $ filter (/= invalidHeight) heights
1737+ let myHeightBag = heightBagFromList $ filter (/= invalidHeight) heights
1626 myHeight = if invalidHeight `elem` heights
1738 myHeight = if invalidHeight `elem` heights
1627 then invalidHeight
1739 then invalidHeight
1628 else succHeight $ heightBagMax myHeightBag
1740 else succHeight $ heightBagMax myHeightBag
@@ -1638,26 +1750,7 @@ mergeCheap d = Event $ \sub -> do
1638 liftIO $ writeIORef heightRef $! myHeight
1750 liftIO $ writeIORef heightRef $! myHeight
1639 liftIO $ writeIORef heightBagRef $! myHeightBag
1751 liftIO $ writeIORef heightBagRef $! myHeightBag
1640 changeSubdRef <- liftIO $ newIORef $ error "getMergeSubscribed: changeSubdRef not yet initialized"
1752 changeSubdRef <- liftIO $ newIORef $ error "getMergeSubscribed: changeSubdRef not yet initialized"
1641− liftIO $ writeIORef parentsRef $! DMap.fromDistinctAscList $ map (\(_, _, x) -> x) subscribers
1753+ liftIO $ writeIORef parentsRef $! initialParentState
1642− let updateMe (PatchDMap p) = do
1643− oldParents <- liftIO $ readIORef parentsRef
1644− let f (subscriptionsToKill, ps) (k :=> ComposeMaybe me) = do
1645− (mOldSubd, newPs) <- case me of
1646− Nothing -> return $ DMap.updateLookupWithKey (\_ _ -> Nothing) k ps
1647− Just e -> do
1648− let s = subscriber k
1649− subscription@(EventSubscription _ subd) <- subscribe e s
1650− newParentHeight <- liftIO $ getEventSubscribedHeight subd
1651− let newParent = MergeSubscribedParent subscription
1652− liftIO $ modifyIORef' heightBagRef $ heightBagAdd newParentHeight
1653− return $ DMap.insertLookupWithKey' (\_ new _ -> new) k newParent ps
1654− forM_ mOldSubd $ \oldSubd -> do
1655− oldHeight <- liftIO $ getEventSubscribedHeight $ _eventSubscription_subscribed $ unMergeSubscribedParent oldSubd
1656− liftIO $ modifyIORef heightBagRef $ heightBagRemove oldHeight
1657− return (maybeToList (unMergeSubscribedParent <$> mOldSubd) ++ subscriptionsToKill, newPs)
1658− (subscriptionsToKill, newParents) <- foldM f ([], oldParents) $ DMap.toList p --TODO: I think this runEventM is OK, since no events are firing at this time, but it might not be
1659− liftIO $ writeIORef parentsRef $! newParents
1660− return subscriptionsToKill
1661 defer $ SomeMergeInit $ do
1754 defer $ SomeMergeInit $ do
1662 let s = Subscriber
1755 let s = Subscriber
1663 { subscriberPropagate = \a -> {-# SCC "traverseMergeChange" #-} do
1756 { subscriberPropagate = \a -> {-# SCC "traverseMergeChange" #-} do
@@ -1672,9 +1765,7 @@ mergeCheap d = Event $ \sub -> do
1672 -- If we don't do this, there are certain cases where mergeCheap will fail to properly retain
1765 -- If we don't do this, there are certain cases where mergeCheap will fail to properly retain
1673 -- its subscription.
1766 -- its subscription.
1674 liftIO $ writeIORef changeSubdRef (s, changeSubscription)
1767 liftIO $ writeIORef changeSubdRef (s, changeSubscription)
1675− let unsubscribeAll = do
1676− parents <- readIORef parentsRef
1768+ let unsubscribeAll = destroy =<< readIORef parentsRef
1677− forM_ (DMap.toList parents) $ \(_ :=> MergeSubscribedParent s) -> unsubscribe s
1678 return ( EventSubscription unsubscribeAll $ EventSubscribed heightRef $ toAny (parentsRef, changeSubdRef)
1769 return ( EventSubscription unsubscribeAll $ EventSubscribed heightRef $ toAny (parentsRef, changeSubdRef)
1679 , occ
1770 , occ
1680 )
1771 )
@@ -1972,6 +2063,8 @@ instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where
1972 unsafeBuildIncremental readV0 dv = SpiderIncremental $ dynamicDyn $ unsafeDyn (coerce readV0) $ unSpiderEvent dv
2063 unsafeBuildIncremental readV0 dv = SpiderIncremental $ dynamicDyn $ unsafeDyn (coerce readV0) $ unSpiderEvent dv
1973 {-# INLINABLE mergeIncremental #-}
2064 {-# INLINABLE mergeIncremental #-}
1974 mergeIncremental = SpiderEvent . merge . (unsafeCoerce :: Dynamic x (PatchDMap k (R.Event (SpiderTimeline x))) -> Dynamic x (PatchDMap k (Event x))) . unSpiderIncremental
2065 mergeIncremental = SpiderEvent . merge . (unsafeCoerce :: Dynamic x (PatchDMap k (R.Event (SpiderTimeline x))) -> Dynamic x (PatchDMap k (Event x))) . unSpiderIncremental
2066+ {-# INLINABLE mergeIncrementalWithMove #-}
2067+ mergeIncrementalWithMove = SpiderEvent . mergeWithMove . (unsafeCoerce :: Dynamic x (PatchDMapWithMove k (R.Event (SpiderTimeline x))) -> Dynamic x (PatchDMapWithMove k (Event x))) . unSpiderIncremental
1975 {-# INLINABLE currentIncremental #-}
2068 {-# INLINABLE currentIncremental #-}
1976 currentIncremental = SpiderBehavior . dynamicCurrent . unSpiderIncremental
2069 currentIncremental = SpiderBehavior . dynamicCurrent . unSpiderIncremental
1977 {-# INLINABLE updatedIncremental #-}
2070 {-# INLINABLE updatedIncremental #-}
test/hlint.hs+1
@@ -8,6 +8,7 @@ main = do
8 , "--ignore=Redundant do"
8 , "--ignore=Redundant do"
9 , "--ignore=Use camelCase"
9 , "--ignore=Use camelCase"
10 , "--ignore=Redundant $"
10 , "--ignore=Redundant $"
11+ , "--ignore=Use &&"
11 , "--ignore=Use &&&"
12 , "--ignore=Use &&&"
12 , "--ignore=Use const"
13 , "--ignore=Use const"
13 , "--ignore=Use >=>"
14 , "--ignore=Use >=>"