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