2{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE LambdaCase #-}
4{-# LANGUAGE MultiParamTypeClasses #-}
5{-# LANGUAGE RankNTypes #-}
6{-# LANGUAGE RecursiveDo #-}
7{-# LANGUAGE ScopedTypeVariables #-}
8{-# LANGUAGE TypeFamilies #-}
9{-# LANGUAGE UndecidableInstances #-}
10#ifdef USE_REFLEX_OPTIMIZER
11{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
16module Reflex.Collection
18 -- * Widgets on Collections
22 , listWithKeyShallowDiff
24 , selectViewListWithKey
25 , selectViewListWithKey_
31import Control.Monad.Identity
33import Data.Functor.Misc
35import qualified Data.Map as Map
40import Reflex.Adjustable.Class
42import Reflex.PostBuild.Class
44-- | Create a set of widgets based on the provided 'Map'. When the
45-- input 'Event' fires, remove widgets for keys with the value 'Nothing'
46-- and add/replace widgets for keys with 'Just' values.
49 . (Ord k, Adjustable t m, MonadHold t m)
51 -> Event t (Map k (Maybe v))
53 -> m (Dynamic t (Map k a))
54listHoldWithKey m0 m' f = do
55 let dm0 = mapWithFunctorToDMap $ Map.mapWithKey f m0
57 (PatchDMap . mapWithFunctorToDMap . Map.mapWithKey
58 (\k v -> ComposeMaybe $ fmap (f k) v)
61 (a0, a') <- sequenceDMapWithAdjust dm0 dm'
63 --TODO: Move the dmapToMap to the righthand side so it doesn't get
64 --fully redone every time
65 fmap dmapToMap . incrementalToDynamic <$> holdIncremental a0 a'
67--TODO: Something better than Dynamic t (Map k v) - we want something
68--where the Events carry diffs, not the whole value
71 . (Ord k, Adjustable t m, PostBuild t m, MonadFix m, MonadHold t m)
72 => Dynamic t (Map k v)
73 -> (k -> Dynamic t v -> m a)
74 -> m (Dynamic t (Map k a))
75listWithKey vals mkChild = do
76 postBuild <- getPostBuild
77 let childValChangedSelector = fanMap $ updated vals
79 -- We keep track of changes to children values in the mkChild
80 -- function we pass to listHoldWithKey The other changes we need
81 -- to keep track of are child insertions and
82 -- deletions. diffOnlyKeyChanges keeps track of insertions and
83 -- deletions but ignores value changes, since they're already
85 diffOnlyKeyChanges olds news =
86 flip Map.mapMaybe (align olds news) $ \case
87 This _ -> Just Nothing
89 That new -> Just $ Just new
90 rec sentVals :: Dynamic t (Map k v) <- foldDyn applyMap Map.empty changeVals
91 let changeVals :: Event t (Map k (Maybe v))
93 attachWith diffOnlyKeyChanges (current sentVals) $ leftmost
96 -- TODO: This should probably be added to the
97 -- attachWith, not to the updated; if we were using
98 -- diffMap instead of diffMapNoEq, I think it might not
100 , tag (current vals) postBuild
102 listHoldWithKey Map.empty changeVals $ \k v ->
103 mkChild k =<< holdDyn v (select childValChangedSelector $ Const2 k)
105{-# DEPRECATED listWithKey' "listWithKey' has been renamed to listWithKeyShallowDiff; also, its behavior has changed to fix a bug where children were always rebuilt (never updated)" #-}
107 :: (Ord k, Adjustable t m, MonadFix m, MonadHold t m)
109 -> Event t (Map k (Maybe v))
110 -> (k -> v -> Event t v -> m a)
111 -> m (Dynamic t (Map k a))
112listWithKey' = listWithKeyShallowDiff
114-- | Display the given map of items (in key order) using the builder
115-- function provided, and update it with the given event. 'Nothing'
116-- update entries will delete the corresponding children, and 'Just'
117-- entries will create them if they do not exist or send an update
118-- event to them if they do.
119listWithKeyShallowDiff
120 :: (Ord k, Adjustable t m, MonadFix m, MonadHold t m)
122 -> Event t (Map k (Maybe v))
123 -> (k -> v -> Event t v -> m a)
124 -> m (Dynamic t (Map k a))
125listWithKeyShallowDiff initialVals valsChanged mkChild = do
126 let childValChangedSelector = fanMap $ fmap (Map.mapMaybe id) valsChanged
127 sentVals <- foldDyn applyMap (void initialVals) $ fmap (fmap void) valsChanged
128 let relevantPatch patch _ = case patch of
130 -- Even if we let a Nothing through when the element doesn't
131 -- already exist, this doesn't cause a problem because it is
133 Nothing -> Just Nothing
135 -- We don't want to let spurious re-creations of items through
139 (attachWith (flip (Map.differenceWith relevantPatch))
143 $ \k v -> mkChild k v $ select childValChangedSelector $ Const2 k
145--TODO: Something better than Dynamic t (Map k v) - we want something
146--where the Events carry diffs, not the whole value
147-- | Create a dynamically-changing set of Event-valued widgets. This
148-- is like 'listWithKey', specialized for widgets returning @/Event t a/@.
149-- 'listWithKey' would return @/Dynamic t (Map k (Event t a))/@ in
150-- this scenario, but 'listViewWithKey' flattens this to
151-- @/Event t (Map k a)/@ via 'switch'.
153 :: (Ord k, Adjustable t m, PostBuild t m, MonadHold t m, MonadFix m)
154 => Dynamic t (Map k v)
155 -> (k -> Dynamic t v -> m (Event t a))
156 -> m (Event t (Map k a))
157listViewWithKey vals mkChild =
158 switch . fmap mergeMap <$> listViewWithKey' vals mkChild
161 :: (Ord k, Adjustable t m, PostBuild t m, MonadHold t m, MonadFix m)
162 => Dynamic t (Map k v)
163 -> (k -> Dynamic t v -> m a)
164 -> m (Behavior t (Map k a))
165listViewWithKey' vals mkChild = current <$> listWithKey vals mkChild
167-- | Create a dynamically-changing set of widgets, one of which is
168-- selected at any time.
171 . (Adjustable t m, Ord k, PostBuild t m, MonadHold t m, MonadFix m)
173 -- ^ Current selection key
174 -> Dynamic t (Map k v)
175 -- ^ Dynamic key/value map
176 -> (k -> Dynamic t v -> Dynamic t Bool -> m (Event t a))
177 -- ^ Function to create a widget for a given key from Dynamic value
178 -- and Dynamic Bool indicating if this widget is currently selected
179 -> m (Event t (k, a))
180 -- ^ Event that fires when any child's return Event fires. Contains
181 -- key of an arbitrary firing widget.
182selectViewListWithKey selection vals mkChild = do
183 -- For good performance, this value must be shared across all children
184 let selectionDemux = demux selection
185 selectChild <- listWithKey vals $ \k v -> do
186 let selected = demuxed selectionDemux k
187 selectSelf <- mkChild k v selected
188 return $ fmap ((,) k) selectSelf
189 return $ switchPromptlyDyn $ leftmost . Map.elems <$> selectChild
191-- | Like 'selectViewListWithKey' but discards the value of the list
192-- item widget's output 'Event'.
193selectViewListWithKey_
195 . (Adjustable t m, Ord k, PostBuild t m, MonadHold t m, MonadFix m)
197 -- ^ Current selection key
198 -> Dynamic t (Map k v)
199 -- ^ Dynamic key/value map
200 -> (k -> Dynamic t v -> Dynamic t Bool -> m (Event t a))
201 -- ^ Function to create a widget for a given key from Dynamic value
202 -- and Dynamic Bool indicating if this widget is currently selected
204 -- ^ Event that fires when any child's return Event fires. Contains
205 -- key of an arbitrary firing widget.
206selectViewListWithKey_ selection vals mkChild =
207 fmap fst <$> selectViewListWithKey selection vals mkChild
209-- | Create a dynamically-changing set of widgets from a Dynamic
210-- key/value map. Unlike the 'withKey' variants, the child widgets
211-- are insensitive to which key they're associated with.
213 :: (Ord k, Adjustable t m, MonadHold t m, PostBuild t m, MonadFix m)
214 => Dynamic t (Map k v)
215 -> (Dynamic t v -> m a)
216 -> m (Dynamic t (Map k a))
217list dm mkChild = listWithKey dm (\_ dv -> mkChild dv)
219-- | Create a dynamically-changing set of widgets from a Dynamic list.
221 :: (Adjustable t m, MonadHold t m, PostBuild t m, MonadFix m)
223 -> (Dynamic t v -> m a)
225simpleList xs mkChild =
226 fmap (fmap (map snd . Map.toList)) $ flip list mkChild $ fmap
227 (Map.fromList . zip [(1 :: Int) ..])
keysesc to close
- j k
- move down, up
- enter
- open
- esc
- back, or up a level
- 1 2 3 4
- readme, files, commits, refs
- /
- filter
- y
- copy the clone command
- c
- compare the chosen commit with another (or shift-click both)
- ?
- show or hide this list