@@ -38,84 +38,183 @@ import Reflex.Adjustable.Class
38import Reflex.Dynamic
38import Reflex.Dynamic
39import Reflex.PostBuild.Class
39import Reflex.PostBuild.Class
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))
43+ . (Ord k, Adjustable t m, MonadHold t m)
45+ -> Event t (Map k (Maybe v))
47+ -> m (Dynamic t (Map k a))
42listHoldWithKey m0 m' f = do
48listHoldWithKey m0 m' f = do
43 let dm0 = mapWithFunctorToDMap $ Map.mapWithKey f m0
49 let dm0 = mapWithFunctorToDMap $ Map.mapWithKey f m0
44− dm' = fmap (PatchDMap . mapWithFunctorToDMap . Map.mapWithKey (\k v -> ComposeMaybe $ fmap (f k) v)) m'
51+ (PatchDMap . mapWithFunctorToDMap . Map.mapWithKey
52+ (\k v -> ComposeMaybe $ fmap (f k) v)
45 (a0, a') <- sequenceDMapWithAdjust dm0 dm'
55 (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
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'
48−--TODO: Something better than Dynamic t (Map k v) - we want something where the Events carry diffs, not the whole value
61+--TODO: Something better than Dynamic t (Map k v) - we want something
62+--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))
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))
50listWithKey vals mkChild = do
69listWithKey vals mkChild = do
51 postBuild <- getPostBuild
70 postBuild <- getPostBuild
52 let childValChangedSelector = fanMap $ updated vals
71 let childValChangedSelector = fanMap $ updated vals
53− -- We keep track of changes to children values in the mkChild function we pass to listHoldWithKey
73+ -- We keep track of changes to children values in the mkChild
74+ -- function we pass to listHoldWithKey The other changes we need
54− -- The other changes we need to keep track of are child insertions and deletions. diffOnlyKeyChanges
75+ -- to keep track of are child insertions and
76+ -- deletions. diffOnlyKeyChanges keeps track of insertions and
55− -- keeps track of insertions and deletions but ignores value changes, since they're already accounted for.
77+ -- deletions but ignores value changes, since they're already
79+ diffOnlyKeyChanges olds news =
56− diffOnlyKeyChanges olds news = flip Map.mapMaybe (align olds news) $ \case
80+ flip Map.mapMaybe (align olds news) $ \case
57− This _ -> Just Nothing
81+ This _ -> Just Nothing
58− These _ _ -> Nothing
82+ These _ _ -> Nothing
59− That new -> Just $ Just new
83+ That new -> Just $ Just new
60 rec sentVals :: Dynamic t (Map k v) <- foldDyn applyMap Map.empty changeVals
84 rec sentVals :: Dynamic t (Map k v) <- foldDyn applyMap Map.empty changeVals
61 let changeVals :: Event t (Map k (Maybe v))
85 let changeVals :: Event t (Map k (Maybe v))
62− changeVals = attachWith diffOnlyKeyChanges (current sentVals) $ leftmost
87+ attachWith diffOnlyKeyChanges (current sentVals) $ leftmost
63− [ updated vals
88+ [ updated vals
90+ -- TODO: This should probably be added to the
91+ -- attachWith, not to the updated; if we were using
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
92+ -- diffMap instead of diffMapNoEq, I think it might not
94+ , tag (current vals) postBuild
66 listHoldWithKey Map.empty changeVals $ \k v ->
96 listHoldWithKey Map.empty changeVals $ \k v ->
67 mkChild k =<< holdDyn v (select childValChangedSelector $ Const2 k)
97 mkChild k =<< holdDyn v (select childValChangedSelector $ Const2 k)
69{-# DEPRECATED listWithKey' "listWithKey' has been renamed to listWithKeyShallowDiff; also, its behavior has changed to fix a bug where children were always rebuilt (never updated)" #-}
99{-# 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))
101+ :: (Ord k, Adjustable t m, MonadFix m, MonadHold t m)
103+ -> Event t (Map k (Maybe v))
104+ -> (k -> v -> Event t v -> m a)
105+ -> m (Dynamic t (Map k a))
71listWithKey' = listWithKeyShallowDiff
106listWithKey' = listWithKeyShallowDiff
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.
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
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))
114+ :: (Ord k, Adjustable t m, MonadFix m, MonadHold t m)
116+ -> Event t (Map k (Maybe v))
117+ -> (k -> v -> Event t v -> m a)
118+ -> m (Dynamic t (Map k a))
75listWithKeyShallowDiff initialVals valsChanged mkChild = do
119listWithKeyShallowDiff initialVals valsChanged mkChild = do
76 let childValChangedSelector = fanMap $ fmap (Map.mapMaybe id) valsChanged
120 let childValChangedSelector = fanMap $ fmap (Map.mapMaybe id) valsChanged
77 sentVals <- foldDyn applyMap (void initialVals) $ fmap (fmap void) valsChanged
121 sentVals <- foldDyn applyMap (void initialVals) $ fmap (fmap void) valsChanged
78 let relevantPatch patch _ = case patch of
122 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
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
127+ Nothing -> Just Nothing
80− Just _ -> Nothing -- We don't want to let spurious re-creations of items through
129+ -- 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 ->
133+ (attachWith (flip (Map.differenceWith relevantPatch))
82− mkChild k v $ select childValChangedSelector $ Const2 k
137+ $ \k v -> mkChild k v $ select childValChangedSelector $ Const2 k
84−--TODO: Something better than Dynamic t (Map k v) - we want something where the Events carry diffs, not the whole value
139+--TODO: Something better than Dynamic t (Map k v) - we want something
140+--where the Events carry diffs, not the whole value
85−-- | Create a dynamically-changing set of Event-valued widgets.
141+-- | Create a dynamically-changing set of Event-valued widgets. This
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'.
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'.
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))
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 =
88−listViewWithKey vals mkChild = switch . fmap mergeMap <$> listViewWithKey' vals mkChild
152+ switch . fmap mergeMap <$> listViewWithKey' vals mkChild
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))
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))
91listViewWithKey' vals mkChild = current <$> listWithKey vals mkChild
159listViewWithKey' vals mkChild = current <$> listWithKey vals mkChild
93−-- | Create a dynamically-changing set of widgets, one of which is selected at any time.
161+-- | Create a dynamically-changing set of widgets, one of which is
162+-- selected at any time.
163+selectViewListWithKey
94−selectViewListWithKey :: forall t m k v a. (Adjustable t m, Ord k, PostBuild t m, MonadHold t m, MonadFix m)
165+ . (Adjustable t m, Ord k, PostBuild t m, MonadHold t m, MonadFix m)
95− => Dynamic t k -- ^ Current selection key
167+ -- ^ Current selection key
168+ -> Dynamic t (Map k v)
96− -> Dynamic t (Map k v) -- ^ Dynamic key/value map
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
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
172+ -- and Dynamic Bool indicating if this widget is currently selected
173+ -> m (Event t (k, a))
98− -> m (Event t (k, a)) -- ^ Event that fires when any child's return Event fires. Contains key of an arbitrary firing widget.
174+ -- ^ Event that fires when any child's return Event fires. Contains
175+ -- key of an arbitrary firing widget.
99selectViewListWithKey selection vals mkChild = do
176selectViewListWithKey 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
101 selectChild <- listWithKey vals $ \k v -> do
179 selectChild <- listWithKey vals $ \k v -> do
102 let selected = demuxed selectionDemux k
180 let selected = demuxed selectionDemux k
103 selectSelf <- mkChild k v selected
181 selectSelf <- mkChild k v selected
104 return $ fmap ((,) k) selectSelf
182 return $ fmap ((,) k) selectSelf
105 return $ switchPromptlyDyn $ leftmost . Map.elems <$> selectChild
183 return $ switchPromptlyDyn $ leftmost . Map.elems <$> selectChild
185+selectViewListWithKey_
107−selectViewListWithKey_ :: forall t m k v a. (Adjustable t m, Ord k, PostBuild t m, MonadHold t m, MonadFix m)
187+ . (Adjustable t m, Ord k, PostBuild t m, MonadHold t m, MonadFix m)
108− => Dynamic t k -- ^ Current selection key
189+ -- ^ Current selection key
190+ -> Dynamic t (Map k v)
109− -> Dynamic t (Map k v) -- ^ Dynamic key/value map
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
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
194+ -- 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.
196+ -- ^ Event that fires when any child's return Event fires. Contains
197+ -- key of an arbitrary firing widget.
198+selectViewListWithKey_ selection vals mkChild =
112−selectViewListWithKey_ selection vals mkChild = fmap fst <$> selectViewListWithKey selection vals mkChild
199+ fmap fst <$> selectViewListWithKey selection vals mkChild
114−-- | Create a dynamically-changing set of widgets from a Dynamic key/value map.
201+-- | Create a dynamically-changing set of widgets from a Dynamic
202+-- key/value map. Unlike the 'withKey' variants, the child widgets
115−-- Unlike the 'withKey' variants, the child widgets are insensitive to which key they're associated with.
203+-- 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))
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))
117list dm mkChild = listWithKey dm (\_ dv -> mkChild dv)
209list dm mkChild = listWithKey dm (\_ dv -> mkChild dv)
119-- | Create a dynamically-changing set of widgets from a Dynamic list.
211-- | 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])
213+ :: (Adjustable t m, MonadHold t m, PostBuild t m, MonadFix m)
215+ -> (Dynamic t v -> m a)
216+ -> m (Dynamic t [a])
217+simpleList xs mkChild =
121−simpleList xs mkChild = fmap (fmap (map snd . Map.toList)) $ flip list mkChild $ fmap (Map.fromList . zip [(1::Int)..]) xs
218+ fmap (fmap (map snd . Map.toList)) $ flip list mkChild $ fmap
219+ (Map.fromList . zip [(1 :: Int) ..])