@@ -37,84 +37,183 @@ import Reflex.Class
3737import Reflex.Dynamic
3838import Reflex.PostBuild.Class
3939
40−listHoldWithKey :: forall t m k v a. (Ord k, Adjustable t m, MonadHold t m) => Map k v -> Event t (Map k (Maybe v)) -> (k -> v -> m a) -> m (Dynamic t (Map k a))
40+listHoldWithKey
41+ :: forall t m k v a
42+ . (Ord k, Adjustable t m, MonadHold t m)
43+ => Map k v
44+ -> Event t (Map k (Maybe v))
45+ -> (k -> v -> m a)
46+ -> m (Dynamic t (Map k a))
4147listHoldWithKey m0 m' f = do
4248 let dm0 = mapWithFunctorToDMap $ Map.mapWithKey f m0
43− dm' = fmap (PatchDMap . mapWithFunctorToDMap . Map.mapWithKey (\k v -> ComposeMaybe $ fmap (f k) v)) m'
49+ dm' = fmap
50+ (PatchDMap . mapWithFunctorToDMap . Map.mapWithKey
51+ (\k v -> ComposeMaybe $ fmap (f k) v)
52+ )
53+ m'
4454 (a0, a') <- sequenceDMapWithAdjust dm0 dm'
45− fmap dmapToMap . incrementalToDynamic <$> holdIncremental a0 a' --TODO: Move the dmapToMap to the righthand side so it doesn't get fully redone every time
4655
47−--TODO: Something better than Dynamic t (Map k v) - we want something where the Events carry diffs, not the whole value
48−listWithKey :: forall t k v m a. (Ord k, Adjustable t m, PostBuild t m, MonadFix m, MonadHold t m) => Dynamic t (Map k v) -> (k -> Dynamic t v -> m a) -> m (Dynamic t (Map k a))
56+ --TODO: Move the dmapToMap to the righthand side so it doesn't get
57+ --fully redone every time
58+ fmap dmapToMap . incrementalToDynamic <$> holdIncremental a0 a'
59+
60+--TODO: Something better than Dynamic t (Map k v) - we want something
61+--where the Events carry diffs, not the whole value
62+listWithKey
63+ :: forall t k v m a
64+ . (Ord k, Adjustable t m, PostBuild t m, MonadFix m, MonadHold t m)
65+ => Dynamic t (Map k v)
66+ -> (k -> Dynamic t v -> m a)
67+ -> m (Dynamic t (Map k a))
4968listWithKey vals mkChild = do
5069 postBuild <- getPostBuild
5170 let childValChangedSelector = fanMap $ updated vals
52− -- We keep track of changes to children values in the mkChild function we pass to listHoldWithKey
53− -- The other changes we need to keep track of are child insertions and deletions. diffOnlyKeyChanges
54− -- keeps track of insertions and deletions but ignores value changes, since they're already accounted for.
55− diffOnlyKeyChanges olds news = flip Map.mapMaybe (align olds news) $ \case
56− This _ -> Just Nothing
57− These _ _ -> Nothing
58− That new -> Just $ Just new
71+
72+ -- We keep track of changes to children values in the mkChild
73+ -- function we pass to listHoldWithKey The other changes we need
74+ -- to keep track of are child insertions and
75+ -- deletions. diffOnlyKeyChanges keeps track of insertions and
76+ -- deletions but ignores value changes, since they're already
77+ -- accounted for.
78+ diffOnlyKeyChanges olds news =
79+ flip Map.mapMaybe (align olds news) $ \case
80+ This _ -> Just Nothing
81+ These _ _ -> Nothing
82+ That new -> Just $ Just new
5983 rec sentVals :: Dynamic t (Map k v) <- foldDyn applyMap Map.empty changeVals
6084 let changeVals :: Event t (Map k (Maybe v))
61− changeVals = attachWith diffOnlyKeyChanges (current sentVals) $ leftmost
62− [ updated vals
63− , tag (current vals) postBuild --TODO: This should probably be added to the attachWith, not to the updated; if we were using diffMap instead of diffMapNoEq, I think it might not work
64− ]
85+ changeVals =
86+ attachWith diffOnlyKeyChanges (current sentVals) $ leftmost
87+ [ updated vals
88+
89+ -- TODO: This should probably be added to the
90+ -- attachWith, not to the updated; if we were using
91+ -- diffMap instead of diffMapNoEq, I think it might not
92+ -- work
93+ , tag (current vals) postBuild
94+ ]
6595 listHoldWithKey Map.empty changeVals $ \k v ->
6696 mkChild k =<< holdDyn v (select childValChangedSelector $ Const2 k)
6797
6898{-# DEPRECATED listWithKey' "listWithKey' has been renamed to listWithKeyShallowDiff; also, its behavior has changed to fix a bug where children were always rebuilt (never updated)" #-}
69−listWithKey' :: (Ord k, Adjustable t m, MonadFix m, MonadHold t m) => Map k v -> Event t (Map k (Maybe v)) -> (k -> v -> Event t v -> m a) -> m (Dynamic t (Map k a))
99+listWithKey'
100+ :: (Ord k, Adjustable t m, MonadFix m, MonadHold t m)
101+ => Map k v
102+ -> Event t (Map k (Maybe v))
103+ -> (k -> v -> Event t v -> m a)
104+ -> m (Dynamic t (Map k a))
70105listWithKey' = listWithKeyShallowDiff
71106
72−-- | Display the given map of items (in key order) using the builder function provided, and update it with the given event. 'Nothing' update entries will delete the corresponding children, and 'Just' entries will create them if they do not exist or send an update event to them if they do.
73−listWithKeyShallowDiff :: (Ord k, Adjustable t m, MonadFix m, MonadHold t m) => Map k v -> Event t (Map k (Maybe v)) -> (k -> v -> Event t v -> m a) -> m (Dynamic t (Map k a))
107+-- | Display the given map of items (in key order) using the builder
108+-- function provided, and update it with the given event. 'Nothing'
109+-- update entries will delete the corresponding children, and 'Just'
110+-- entries will create them if they do not exist or send an update
111+-- event to them if they do.
112+listWithKeyShallowDiff
113+ :: (Ord k, Adjustable t m, MonadFix m, MonadHold t m)
114+ => Map k v
115+ -> Event t (Map k (Maybe v))
116+ -> (k -> v -> Event t v -> m a)
117+ -> m (Dynamic t (Map k a))
74118listWithKeyShallowDiff initialVals valsChanged mkChild = do
75119 let childValChangedSelector = fanMap $ fmap (Map.mapMaybe id) valsChanged
76120 sentVals <- foldDyn applyMap (void initialVals) $ fmap (fmap void) valsChanged
77121 let relevantPatch patch _ = case patch of
78− Nothing -> Just Nothing -- Even if we let a Nothing through when the element doesn't already exist, this doesn't cause a problem because it is ignored
79− Just _ -> Nothing -- We don't want to let spurious re-creations of items through
80− listHoldWithKey initialVals (attachWith (flip (Map.differenceWith relevantPatch)) (current sentVals) valsChanged) $ \k v ->
81− mkChild k v $ select childValChangedSelector $ Const2 k
82−
83−--TODO: Something better than Dynamic t (Map k v) - we want something where the Events carry diffs, not the whole value
84−-- | Create a dynamically-changing set of Event-valued widgets.
85−-- This is like listWithKey, specialized for widgets returning (Event t a). listWithKey would return 'Dynamic t (Map k (Event t a))' in this scenario, but listViewWithKey flattens this to 'Event t (Map k a)' via 'switch'.
86−listViewWithKey :: (Ord k, Adjustable t m, PostBuild t m, MonadHold t m, MonadFix m) => Dynamic t (Map k v) -> (k -> Dynamic t v -> m (Event t a)) -> m (Event t (Map k a))
87−listViewWithKey vals mkChild = switch . fmap mergeMap <$> listViewWithKey' vals mkChild
88−
89−listViewWithKey' :: (Ord k, Adjustable t m, PostBuild t m, MonadHold t m, MonadFix m) => Dynamic t (Map k v) -> (k -> Dynamic t v -> m a) -> m (Behavior t (Map k a))
122+
123+ -- Even if we let a Nothing through when the element doesn't
124+ -- already exist, this doesn't cause a problem because it is
125+ -- ignored
126+ Nothing -> Just Nothing
127+
128+ -- We don't want to let spurious re-creations of items through
129+ Just _ -> Nothing
130+ listHoldWithKey
131+ initialVals
132+ (attachWith (flip (Map.differenceWith relevantPatch))
133+ (current sentVals)
134+ valsChanged
135+ )
136+ $ \k v -> mkChild k v $ select childValChangedSelector $ Const2 k
137+
138+--TODO: Something better than Dynamic t (Map k v) - we want something
139+--where the Events carry diffs, not the whole value
140+-- | Create a dynamically-changing set of Event-valued widgets. This
141+-- is like listWithKey, specialized for widgets returning (Event t
142+-- a). listWithKey would return 'Dynamic t (Map k (Event t a))' in
143+-- this scenario, but listViewWithKey flattens this to 'Event t (Map
144+-- k a)' via 'switch'.
145+listViewWithKey
146+ :: (Ord k, Adjustable t m, PostBuild t m, MonadHold t m, MonadFix m)
147+ => Dynamic t (Map k v)
148+ -> (k -> Dynamic t v -> m (Event t a))
149+ -> m (Event t (Map k a))
150+listViewWithKey vals mkChild =
151+ switch . fmap mergeMap <$> listViewWithKey' vals mkChild
152+
153+listViewWithKey'
154+ :: (Ord k, Adjustable t m, PostBuild t m, MonadHold t m, MonadFix m)
155+ => Dynamic t (Map k v)
156+ -> (k -> Dynamic t v -> m a)
157+ -> m (Behavior t (Map k a))
90158listViewWithKey' vals mkChild = current <$> listWithKey vals mkChild
91159
92−-- | Create a dynamically-changing set of widgets, one of which is selected at any time.
93−selectViewListWithKey :: forall t m k v a. (Adjustable t m, Ord k, PostBuild t m, MonadHold t m, MonadFix m)
94− => Dynamic t k -- ^ Current selection key
95− -> Dynamic t (Map k v) -- ^ Dynamic key/value map
96− -> (k -> Dynamic t v -> Dynamic t Bool -> m (Event t a)) -- ^ Function to create a widget for a given key from Dynamic value and Dynamic Bool indicating if this widget is currently selected
97− -> m (Event t (k, a)) -- ^ Event that fires when any child's return Event fires. Contains key of an arbitrary firing widget.
160+-- | Create a dynamically-changing set of widgets, one of which is
161+-- selected at any time.
162+selectViewListWithKey
163+ :: forall t m k v a
164+ . (Adjustable t m, Ord k, PostBuild t m, MonadHold t m, MonadFix m)
165+ => Dynamic t k
166+ -- ^ Current selection key
167+ -> Dynamic t (Map k v)
168+ -- ^ Dynamic key/value map
169+ -> (k -> Dynamic t v -> Dynamic t Bool -> m (Event t a))
170+ -- ^ Function to create a widget for a given key from Dynamic value
171+ -- and Dynamic Bool indicating if this widget is currently selected
172+ -> m (Event t (k, a))
173+ -- ^ Event that fires when any child's return Event fires. Contains
174+ -- key of an arbitrary firing widget.
98175selectViewListWithKey selection vals mkChild = do
99− let selectionDemux = demux selection -- For good performance, this value must be shared across all children
176+ -- For good performance, this value must be shared across all children
177+ let selectionDemux = demux selection
100178 selectChild <- listWithKey vals $ \k v -> do
101179 let selected = demuxed selectionDemux k
102180 selectSelf <- mkChild k v selected
103181 return $ fmap ((,) k) selectSelf
104182 return $ switchPromptlyDyn $ leftmost . Map.elems <$> selectChild
105183
106−selectViewListWithKey_ :: forall t m k v a. (Adjustable t m, Ord k, PostBuild t m, MonadHold t m, MonadFix m)
107− => Dynamic t k -- ^ Current selection key
108− -> Dynamic t (Map k v) -- ^ Dynamic key/value map
109− -> (k -> Dynamic t v -> Dynamic t Bool -> m (Event t a)) -- ^ Function to create a widget for a given key from Dynamic value and Dynamic Bool indicating if this widget is currently selected
110− -> m (Event t k) -- ^ Event that fires when any child's return Event fires. Contains key of an arbitrary firing widget.
111−selectViewListWithKey_ selection vals mkChild = fmap fst <$> selectViewListWithKey selection vals mkChild
184+selectViewListWithKey_
185+ :: forall t m k v a
186+ . (Adjustable t m, Ord k, PostBuild t m, MonadHold t m, MonadFix m)
187+ => Dynamic t k
188+ -- ^ Current selection key
189+ -> Dynamic t (Map k v)
190+ -- ^ Dynamic key/value map
191+ -> (k -> Dynamic t v -> Dynamic t Bool -> m (Event t a))
192+ -- ^ Function to create a widget for a given key from Dynamic value
193+ -- and Dynamic Bool indicating if this widget is currently selected
194+ -> m (Event t k)
195+ -- ^ Event that fires when any child's return Event fires. Contains
196+ -- key of an arbitrary firing widget.
197+selectViewListWithKey_ selection vals mkChild =
198+ fmap fst <$> selectViewListWithKey selection vals mkChild
112199
113−-- | Create a dynamically-changing set of widgets from a Dynamic key/value map.
114−-- Unlike the 'withKey' variants, the child widgets are insensitive to which key they're associated with.
115−list :: (Ord k, Adjustable t m, MonadHold t m, PostBuild t m, MonadFix m) => Dynamic t (Map k v) -> (Dynamic t v -> m a) -> m (Dynamic t (Map k a))
200+-- | Create a dynamically-changing set of widgets from a Dynamic
201+-- key/value map. Unlike the 'withKey' variants, the child widgets
202+-- are insensitive to which key they're associated with.
203+list
204+ :: (Ord k, Adjustable t m, MonadHold t m, PostBuild t m, MonadFix m)
205+ => Dynamic t (Map k v)
206+ -> (Dynamic t v -> m a)
207+ -> m (Dynamic t (Map k a))
116208list dm mkChild = listWithKey dm (\_ dv -> mkChild dv)
117209
118210-- | Create a dynamically-changing set of widgets from a Dynamic list.
119−simpleList :: (Adjustable t m, MonadHold t m, PostBuild t m, MonadFix m) => Dynamic t [v] -> (Dynamic t v -> m a) -> m (Dynamic t [a])
120−simpleList xs mkChild = fmap (fmap (map snd . Map.toList)) $ flip list mkChild $ fmap (Map.fromList . zip [(1::Int)..]) xs
211+simpleList
212+ :: (Adjustable t m, MonadHold t m, PostBuild t m, MonadFix m)
213+ => Dynamic t [v]
214+ -> (Dynamic t v -> m a)
215+ -> m (Dynamic t [a])
216+simpleList xs mkChild =
217+ fmap (fmap (map snd . Map.toList)) $ flip list mkChild $ fmap
218+ (Map.fromList . zip [(1 :: Int) ..])
219+ xs