git.iko.soy/reflex-dom
on a00ce01 help sign in
reflex-dom/src/Reflex/Dom/Widget/Basic.hs
398 lines 22 kB history raw
1{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, LambdaCase, ConstraintKinds, TypeFamilies, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, RecursiveDo, GADTs, DataKinds, RankNTypes #-}
2module Reflex.Dom.Widget.Basic where
4import Reflex.Dom.Class
5import Reflex.Dom.Internal.Foreign ()
6import Reflex.Dom.PostBuild.Class
7import Reflex.Dom.Builder.Class
9import Prelude hiding (mapM, mapM_, sequence, sequence_)
10import Reflex
11import Data.Functor.Misc
12import Data.Map (Map)
13import qualified Data.Map as Map
14import Data.Set (Set)
15import qualified Data.Set as Set
16import Data.Foldable
17import Data.Traversable
18import Control.Arrow
19import Control.Monad.Reader hiding (mapM, mapM_, forM, forM_, sequence, sequence_)
20import Control.Lens hiding (element, children)
21import Data.These
22import Data.Align
23import Data.Maybe
24import Data.Default
25import Data.Either
26import Data.Semigroup
27import Data.Text (Text)
28import qualified Data.Text as T
30widgetHoldInternal :: DomBuilder t m => m a -> Event t (m b) -> m (a, Event t b)
31widgetHoldInternal child0 child' = do
32 childResult0 <- deletable (void child') child0
33 childResult' <- placeholder $ def & placeholderConfig_insertAbove .~ fmap (deletable (void child')) child'
34 return (childResult0, _placeholder_insertedAbove childResult')
36-- | Breaks the given Map into pieces based on the given Set. Each piece will contain only keys that are less than the key of the piece, and greater than or equal to the key of the piece with the next-smaller key. There will be one additional piece containing all keys from the original Map that are larger or equal to the largest key in the Set.
37-- Either k () is used instead of Maybe k so that the resulting map of pieces is sorted so that the additional piece has the largest key.
38-- No empty pieces will be included in the output.
40--TODO: This can probably be done more efficiently by dividing and conquering, re-using the structure of the Set instead of going through the Set linearally
41partitionMapBySetLT :: forall k v. Ord k => Set k -> Map k v -> Map (Either k ()) (Map k v)
42partitionMapBySetLT s m0 = Map.fromDistinctAscList $ go (Set.toAscList s) m0
43 where go :: [k] -> Map k v -> [(Either k (), Map k v)]
44 go [] m = if Map.null m
45 then []
46 else [(Right (), m)]
47 go (h:t) m = let (lt, eq, gt) = Map.splitLookup h m
48 geq = maybe id (Map.insert h) eq gt
49 in if Map.null lt
50 then go t geq
51 else (Left h, lt) : go t geq
53newtype ChildResult t k a = ChildResult { unChildResult :: (a, Event t (Map k (Maybe (ChildResult t k a)))) }
55listHoldWithKey :: forall t m k v a. (Ord k, DomBuilder t m, MonadHold t m, MonadFix m) => Map k v -> Event t (Map k (Maybe v)) -> (k -> v -> m a) -> m (Dynamic t (Map k a))
56listHoldWithKey initialChildren modifyChildren buildChild = do
57 let deleteChildSelector = fanMap $ fmap void modifyChildren
58 liveChildren :: Dynamic t (Set k) <- foldDyn applyMapKeysSet (Map.keysSet initialChildren) modifyChildren
59 let placeChildSelector = fanMap $ attachWith partitionMapBySetLT (current liveChildren) $ fmap (Map.mapMaybe id) modifyChildren
60 buildAugmentedChild :: k -> v -> m (ChildResult t k a)
61 buildAugmentedChild k v = do
62 let delete = select deleteChildSelector $ Const2 k
63 myCfg = def
64 & insertAbove .~ fmap (imapM buildAugmentedChild) (select placeChildSelector $ Const2 $ Left k)
65 & deleteSelf .~ delete
66 ph <- placeholder myCfg
67 result <- deletable delete $ buildChild k v
68 return $ ChildResult (result, (fmap Just <$> _placeholder_insertedAbove ph) <> (Map.singleton k Nothing <$ _placeholder_deletedSelf ph)) --Note: we could also use the "deleted" output on deletable, if it had one; we're using this so that everything changes all at once, instead of deletions being prompt and insertions being delayed
69 rec initialAugmentedResults <- iforM initialChildren buildAugmentedChild
70 augmentedResults <- foldDyn applyMap initialAugmentedResults $ newInsertedBelow <> newInsertedAbove
71 let newInsertedAbove = switch $ mconcat . reverse . fmap (snd . unChildResult) . Map.elems <$> current augmentedResults
72 belowAll <- placeholder $ def & placeholderConfig_insertAbove .~ fmap (imapM buildAugmentedChild) (select placeChildSelector $ Const2 $ Right ())
73 let newInsertedBelow = fmap Just <$> _placeholder_insertedAbove belowAll
74 mapDyn (fmap (fst . unChildResult)) augmentedResults
76text :: DomBuilder t m => Text -> m ()
77text t = void $ textNode $ def & textNodeConfig_contents .~ t
79dynText :: (PostBuild t m, DomBuilder t m) => Dynamic t Text -> m ()
80dynText t = do
81 postBuild <- getPostBuild
82 _ <- widgetHoldInternal (return ()) $ text <$> leftmost
83 [ updated t
84 , tag (current t) postBuild
85 ]
86 return ()
88display :: (PostBuild t m, DomBuilder t m, Show a) => Dynamic t a -> m ()
89display = dynText <=< mapDyn (T.pack . show)
91button :: DomBuilder t m => Text -> m (Event t ())
92button t = do
93 (e, _) <- element "button" def $ text t
94 return $ domEvent Click e
96--TODO: Should this be renamed to 'widgetView' for consistency with 'widgetHold'?
97-- | Given a Dynamic of widget-creating actions, create a widget that is recreated whenever the Dynamic updates.
98-- The returned Event of widget results occurs when the Dynamic does.
99-- Note: Often, the type 'a' is an Event, in which case the return value is an Event-of-Events that would typically be flattened (via 'switchPromptly').
100dyn :: (DomBuilder t m, PostBuild t m) => Dynamic t (m a) -> m (Event t a)
101dyn child = do
102 postBuild <- getPostBuild
103 let newChild = leftmost [updated child, tag (current child) postBuild]
104 snd <$> widgetHoldInternal (return ()) newChild
106-- | Given an initial widget and an Event of widget-creating actions, create a widget that is recreated whenever the Event fires.
107-- The returned Dynamic of widget results occurs when the Event does.
108-- Note: Often, the type 'a' is an Event, in which case the return value is a Dynamic-of-Events that would typically be flattened.
109widgetHold :: (DomBuilder t m, MonadHold t m) => m a -> Event t (m a) -> m (Dynamic t a)
110widgetHold child0 newChild = do
111 (result0, newResult) <- widgetHoldInternal child0 newChild
112 holdDyn result0 newResult
114diffMapNoEq :: (Ord k) => Map k v -> Map k v -> Map k (Maybe v)
115diffMapNoEq olds news = flip Map.mapMaybe (align olds news) $ \case
116 This _ -> Just Nothing
117 These _ new -> Just $ Just new
118 That new -> Just $ Just new
120diffMap :: (Ord k, Eq v) => Map k v -> Map k v -> Map k (Maybe v)
121diffMap olds news = flip Map.mapMaybe (align olds news) $ \case
122 This _ -> Just Nothing
123 These old new
124 | old == new -> Nothing
125 | otherwise -> Just $ Just new
126 That new -> Just $ Just new
128applyMap :: Ord k => Map k (Maybe v) -> Map k v -> Map k v
129applyMap patch old = insertions `Map.union` (old `Map.difference` deletions)
130 where (deletions, insertions) = mapPartitionEithers $ maybeToEither <$> patch
131 maybeToEither = \case
132 Nothing -> Left ()
133 Just r -> Right r
135mapPartitionEithers :: Map k (Either a b) -> (Map k a, Map k b)
136mapPartitionEithers m = (fromLeft <$> ls, fromRight <$> rs)
137 where (ls, rs) = Map.partition isLeft m
138 fromLeft (Left l) = l
139 fromLeft _ = error "mapPartitionEithers: fromLeft received a Right value; this should be impossible"
140 fromRight (Right r) = r
141 fromRight _ = error "mapPartitionEithers: fromRight received a Left value; this should be impossible"
143-- | Apply a map patch to a set
144-- > applyMapKeysSet patch (Map.keysSet m) == Map.keysSet (applyMap patch m)
145applyMapKeysSet :: Ord k => Map k (Maybe v) -> Set k -> Set k
146applyMapKeysSet patch old = Map.keysSet insertions `Set.union` (old `Set.difference` Map.keysSet deletions)
147 where (insertions, deletions) = Map.partition isJust patch
149--TODO: Something better than Dynamic t (Map k v) - we want something where the Events carry diffs, not the whole value
150listWithKey :: forall t k v m a. (Ord k, DomBuilder 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))
151listWithKey vals mkChild = do
152 postBuild <- getPostBuild
153 rec sentVals :: Dynamic t (Map k v) <- foldDyn applyMap Map.empty changeVals
154 let changeVals :: Event t (Map k (Maybe v))
155 changeVals = attachWith diffMapNoEq (current sentVals) $ leftmost
156 [ updated vals
157 , 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
158 ]
159 listWithKeyShallowDiff Map.empty changeVals $ \k v0 dv -> do
160 mkChild k =<< holdDyn v0 dv
162{-# DEPRECATED listWithKey' "listWithKey' has been renamed to listWithKeyShallowDiff; also, its behavior has changed to fix a bug where children were always rebuilt (never updated)" #-}
163listWithKey' :: (Ord k, DomBuilder 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))
164listWithKey' = listWithKeyShallowDiff
166-- | 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.
167listWithKeyShallowDiff :: (Ord k, DomBuilder 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))
168listWithKeyShallowDiff initialVals valsChanged mkChild = do
169 let childValChangedSelector = fanMap $ fmap (Map.mapMaybe id) valsChanged
170 sentVals <- foldDyn applyMap Map.empty $ fmap (fmap void) valsChanged
171 let relevantPatch patch _ = case patch of
172 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
173 Just _ -> Nothing -- We don't want to let spurious re-creations of items through
174 listHoldWithKey initialVals (attachWith (flip (Map.differenceWith relevantPatch)) (current sentVals) valsChanged) $ \k v ->
175 mkChild k v $ Reflex.select childValChangedSelector $ Const2 k
177--TODO: Something better than Dynamic t (Map k v) - we want something where the Events carry diffs, not the whole value
178-- | Create a dynamically-changing set of Event-valued widgets.
179-- 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'.
180listViewWithKey :: (Ord k, DomBuilder 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))
181listViewWithKey vals mkChild = switch . fmap mergeMap <$> listViewWithKey' vals mkChild
183listViewWithKey' :: (Ord k, DomBuilder 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))
184listViewWithKey' vals mkChild = current <$> listWithKey vals mkChild
186-- | Create a dynamically-changing set of widgets, one of which is selected at any time.
187selectViewListWithKey :: forall t m k v a. (DomBuilder t m, Ord k, PostBuild t m, MonadHold t m, MonadFix m)
188 => Dynamic t k -- ^ Current selection key
189 -> Dynamic t (Map k v) -- ^ Dynamic key/value map
190 -> (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
191 -> m (Event t (k, a)) -- ^ Event that fires when any child's return Event fires. Contains key of an arbitrary firing widget.
192selectViewListWithKey selection vals mkChild = do
193 let selectionDemux = demux selection -- For good performance, this value must be shared across all children
194 selectChild <- listWithKey vals $ \k v -> do
195 selected <- getDemuxed selectionDemux k
196 selectSelf <- mkChild k v selected
197 return $ fmap ((,) k) selectSelf
198 return $ switchPromptlyDyn $ leftmost . Map.elems <$> selectChild
200selectViewListWithKey_ :: forall t m k v a. (DomBuilder t m, Ord k, PostBuild t m, MonadHold t m, MonadFix m)
201 => Dynamic t k -- ^ Current selection key
202 -> Dynamic t (Map k v) -- ^ Dynamic key/value map
203 -> (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
204 -> m (Event t k) -- ^ Event that fires when any child's return Event fires. Contains key of an arbitrary firing widget.
205selectViewListWithKey_ selection vals mkChild = fmap fst <$> selectViewListWithKey selection vals mkChild
207{-
208{-# INLINABLE elWith #-}
209elWith :: (DomBuilder t m, Attributes m attrs) => Text -> ElConfig attrs -> m a -> m a
210elWith elementTag cfg child = do
211 (_, result) <- buildElementNS (cfg ^. namespace) elementTag (cfg ^. attributes) child
212 return result
214{-# INLINABLE elWith' #-}
215elWith' :: (DomBuilder t m, Attributes m attrs) => Text -> ElConfig attrs -> m a -> m (El t, a)
216elWith' elementTag cfg child = do
217 (e, result) <- buildElementNS (cfg ^. namespace) elementTag (cfg ^. attributes) child
218 e' <- wrapElement defaultDomEventHandler e
219 return (e', result)
221{-# INLINABLE emptyElWith #-}
222emptyElWith :: (DomBuilder t m, Attributes m attrs) => Text -> ElConfig attrs -> m ()
223emptyElWith elementTag cfg = do
224 _ <- buildEmptyElementNS (cfg ^. namespace) elementTag (cfg ^. attributes)
225 return ()
227{-# INLINABLE emptyElWith' #-}
228emptyElWith' :: (DomBuilder t m, Attributes m attrs) => Text -> ElConfig attrs -> m (El t)
229emptyElWith' elementTag cfg = do
230 wrapElement defaultDomEventHandler =<< buildEmptyElementNS (cfg ^. namespace) elementTag (cfg ^. attributes)
231-}
233dynamicAttributesToModifyAttributes :: PostBuild t m => Dynamic t (Map Text Text) -> m (Event t (Map AttributeName (Maybe Text)))
234dynamicAttributesToModifyAttributes d = do
235 postBuild <- getPostBuild
236 let modificationsNeeded = flip pushAlways (align postBuild $ updated d) $ \case
237 This () -> fmap (fmap Just) $ sample $ current d
238 These () new -> return $ fmap Just new
239 That new -> do
240 old <- sample $ current d
241 return $ diffMap old new
242 return $ Map.fromList . fmap (\(k, v) -> ((Nothing, k), v)) . Map.toList <$> modificationsNeeded
244{-# INLINABLE elDynAttrNS' #-}
245elDynAttrNS' :: forall t m a. (DomBuilder t m, PostBuild t m) => Maybe Text -> Text -> Dynamic t (Map Text Text) -> m a -> m (Element EventResult (DomBuilderSpace m) t, a)
246elDynAttrNS' mns elementTag attrs child = do
247 modifyAttrs <- dynamicAttributesToModifyAttributes attrs
248 let cfg = def
249 & elementConfig_namespace .~ mns
250 & modifyAttributes .~ modifyAttrs
251 element elementTag cfg child
253{-# INLINABLE elDynAttr' #-}
254elDynAttr' :: forall t m a. (DomBuilder t m, PostBuild t m) => Text -> Dynamic t (Map Text Text) -> m a -> m (Element EventResult (DomBuilderSpace m) t, a)
255elDynAttr' = elDynAttrNS' Nothing
257{-# INLINABLE elAttr #-}
258elAttr :: forall t m a. DomBuilder t m => Text -> Map Text Text -> m a -> m a
259elAttr elementTag attrs child = snd <$> elAttr' elementTag attrs child
261{-# INLINABLE el' #-}
262el' :: forall t m a. DomBuilder t m => Text -> m a -> m (Element EventResult (DomBuilderSpace m) t, a)
263el' elementTag = element elementTag def
265{-# INLINABLE elAttr' #-}
266elAttr' :: forall t m a. DomBuilder t m => Text -> Map Text Text -> m a -> m (Element EventResult (DomBuilderSpace m) t, a)
267elAttr' elementTag attrs = element elementTag $ def
268 & initialAttributes .~ Map.mapKeys (\k -> (Nothing, k)) attrs
270{-# INLINABLE elDynAttr #-}
271elDynAttr :: forall t m a. (DomBuilder t m, PostBuild t m) => Text -> Dynamic t (Map Text Text) -> m a -> m a
272elDynAttr elementTag attrs child = snd <$> elDynAttr' elementTag attrs child
274{-# INLINABLE el #-}
275el :: forall t m a. DomBuilder t m => Text -> m a -> m a
276el elementTag child = snd <$> el' elementTag child
278elClass :: forall t m a. DomBuilder t m => Text -> Text -> m a -> m a
279elClass elementTag c child = snd <$> element elementTag (def & initialAttributes .~ (Nothing, "class") =: c) child
281--------------------------------------------------------------------------------
282-- Copied and pasted from Reflex.Widget.Class
283--------------------------------------------------------------------------------
285-- | Create a dynamically-changing set of widgets from a Dynamic key/value map.
286-- Unlike the 'withKey' variants, the child widgets are insensitive to which key they're associated with.
287list :: (Ord k, DomBuilder 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))
288list dm mkChild = listWithKey dm (\_ dv -> mkChild dv)
290-- | Create a dynamically-changing set of widgets from a Dynamic list.
291simpleList :: (DomBuilder t m, MonadHold t m, PostBuild t m, MonadFix m) => Dynamic t [v] -> (Dynamic t v -> m a) -> m (Dynamic t [a])
292simpleList xs mkChild = mapDyn (map snd . Map.toList) =<< flip list mkChild =<< mapDyn (Map.fromList . zip [(1::Int)..]) xs
294{-
295schedulePostBuild x = performEvent_ . (x <$) =<< getPostBuild
297elDynHtml' :: DomBuilder t m => Text -> Dynamic t Text -> m (El t)
298elDynHtml' elementTag html = do
299 e <- buildEmptyElement elementTag (Map.empty :: Map Text Text)
300 schedulePostBuild $ setInnerHTML e . Just =<< sample (current html)
301 performEvent_ $ fmap (setInnerHTML e . Just) $ updated html
302 wrapElement defaultDomEventHandler e
304elDynHtmlAttr' :: DomBuilder t m => Text -> Map Text Text -> Dynamic t Text -> m (El t)
305elDynHtmlAttr' elementTag attrs html = do
306 e <- buildEmptyElement elementTag attrs
307 schedulePostBuild $ setInnerHTML e . Just =<< sample (current html)
308 performEvent_ $ fmap (setInnerHTML e . Just) $ updated html
309 wrapElement defaultDomEventHandler e
310-}
312data Link t
313 = Link { _link_clicked :: Event t ()
314 }
316linkClass :: DomBuilder t m => Text -> Text -> m (Link t)
317linkClass s c = do
318 (l,_) <- elAttr' "a" ("class" =: c) $ text s
319 return $ Link $ domEvent Click l
321link :: DomBuilder t m => Text -> m (Link t)
322link s = linkClass s ""
324newtype Workflow t m a = Workflow { unWorkflow :: m (a, Event t (Workflow t m a)) }
326workflow :: forall t m a. (DomBuilder t m, MonadFix m, MonadHold t m) => Workflow t m a -> m (Dynamic t a)
327workflow w0 = do
328 rec eResult <- widgetHold (unWorkflow w0) $ fmap unWorkflow $ switch $ snd <$> current eResult
329 return $ fmap fst eResult
331workflowView :: forall t m a. (DomBuilder t m, MonadFix m, MonadHold t m, PostBuild t m) => Workflow t m a -> m (Event t a)
332workflowView w0 = do
333 rec eResult <- dyn . fmap unWorkflow =<< holdDyn w0 eReplace
334 eReplace <- fmap switch $ hold never $ fmap snd eResult
335 return $ fmap fst eResult
337mapWorkflow :: (DomBuilder t m) => (a -> b) -> Workflow t m a -> Workflow t m b
338mapWorkflow f (Workflow x) = Workflow (fmap (f *** fmap (mapWorkflow f)) x)
340divClass :: forall t m a. DomBuilder t m => Text -> m a -> m a
341divClass = elClass "div"
343dtdd :: forall t m a. DomBuilder t m => Text -> m a -> m a
344dtdd h w = do
345 el "dt" $ text h
346 el "dd" $ w
348blank :: forall m. Monad m => m ()
349blank = return ()
351-- | A widget to display a table with static columns and dynamic rows.
352tableDynAttr :: forall t m r k v. (Ord k, DomBuilder t m, MonadHold t m, PostBuild t m, MonadFix m)
353 => Text -- ^ Class applied to <table> element
354 -> [(Text, k -> Dynamic t r -> m v)] -- ^ Columns of (header, row key -> row value -> child widget)
355 -> Dynamic t (Map k r) -- ^ Map from row key to row value
356 -> (k -> m (Dynamic t (Map Text Text))) -- ^ Function to compute <tr> element attributes from row key
357 -> m (Dynamic t (Map k (Element EventResult (DomBuilderSpace m) t, [v]))) -- ^ Map from row key to (El, list of widget return values)
358tableDynAttr klass cols dRows rowAttrs = elAttr "div" (Map.singleton "style" "zoom: 1; overflow: auto; background: white;") $ do
359 elAttr "table" (Map.singleton "class" klass) $ do
360 el "thead" $ el "tr" $ do
361 mapM_ (\(h, _) -> el "th" $ text h) cols
362 el "tbody" $ do
363 listWithKey dRows (\k r -> do
364 dAttrs <- rowAttrs k
365 elDynAttr' "tr" dAttrs $ mapM (\x -> el "td" $ snd x k r) cols)
367--TODO preselect a tab on open
368-- | A widget to construct a tabbed view that shows only one of its child widgets at a time.
369-- Creates a header bar containing a <ul> with one <li> per child; clicking a <li> displays
370-- the corresponding child and hides all others.
371tabDisplay :: forall t m k. (MonadFix m, DomBuilder t m, MonadHold t m, PostBuild t m, Ord k)
372 => Text -- ^ Class applied to <ul> element
373 -> Text -- ^ Class applied to currently active <li> element
374 -> Map k (Text, m ()) -- ^ Map from (arbitrary) key to (tab label, child widget)
375 -> m ()
376tabDisplay ulClass activeClass tabItems = do
377 let t0 = listToMaybe $ Map.keys tabItems
378 rec currentTab :: Demux t (Maybe k) <- elAttr "ul" ("class" =: ulClass) $ do
379 tabClicksList :: [Event t k] <- Map.elems <$> imapM (\k (s,_) -> headerBarLink s k =<< getDemuxed currentTab (Just k)) tabItems
380 let eTabClicks :: Event t k = leftmost tabClicksList
381 fmap demux $ holdDyn t0 $ fmap Just eTabClicks
382 el "div" $ do
383 iforM_ tabItems $ \k (_, w) -> do
384 isSelected <- getDemuxed currentTab $ Just k
385 attrs <- forDyn isSelected $ \s -> if s then Map.empty else Map.singleton "style" "display:none;"
386 elDynAttr "div" attrs w
387 return ()
388 where
389 headerBarLink :: Text -> k -> Dynamic t Bool -> m (Event t k)
390 headerBarLink x k isSelected = do
391 attrs <- mapDyn (\b -> if b then Map.singleton "class" activeClass else Map.empty) isSelected
392 elDynAttr "li" attrs $ do
393 a <- link x
394 return $ fmap (const k) (_link_clicked a)
396class HasAttributes a where
397 type Attrs a :: *
398 attributes :: Lens' a (Attrs a)