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