@@ -1,31 +1,42 @@
1−{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, LambdaCase, ConstraintKinds, TypeFamilies, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, RecursiveDo, GADTs, DataKinds, RankNTypes, TemplateHaskell #-}
1+{-# LANGUAGE ConstraintKinds #-}
2−
2+{-# LANGUAGE DataKinds #-}
3+{-# LANGUAGE FlexibleContexts #-}
4+{-# LANGUAGE FlexibleInstances #-}
6+{-# LANGUAGE LambdaCase #-}
7+{-# LANGUAGE MultiParamTypeClasses #-}
8+{-# LANGUAGE OverloadedStrings #-}
9+{-# LANGUAGE RankNTypes #-}
10+{-# LANGUAGE RecursiveDo #-}
11+{-# LANGUAGE ScopedTypeVariables #-}
12+{-# LANGUAGE TypeFamilies #-}
3module Reflex.Dom.Widget.Basic where
13module Reflex.Dom.Widget.Basic where
15+import Reflex.Dom.Builder.Class
5import Reflex.Dom.Class
16import Reflex.Dom.Class
6import Reflex.Dom.Internal.Foreign ()
17import Reflex.Dom.Internal.Foreign ()
7import Reflex.Dom.PostBuild.Class
18import Reflex.Dom.PostBuild.Class
8−import Reflex.Dom.Builder.Class
21+import Control.Lens hiding (children, element)
10−import Prelude hiding (mapM, mapM_, sequence, sequence_)
22+import Control.Monad.Reader hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
11−import Reflex
23+import Data.Align
12import Data.Functor.Misc
27import Data.Functor.Misc
13import Data.Map (Map)
28import Data.Map (Map)
14import qualified Data.Map as Map
29import qualified Data.Map as Map
16−import qualified Data.Set as Set
18−import Data.Traversable
19−import Control.Monad.Reader hiding (mapM, mapM_, forM, forM_, sequence, sequence_)
20−import Control.Lens hiding (element, children)
23import Data.Maybe
30import Data.Maybe
26import Data.Semigroup
31import Data.Semigroup
33+import qualified Data.Set as Set
27import Data.Text (Text)
34import Data.Text (Text)
28import qualified Data.Text as T
35import qualified Data.Text as T
37+import Data.Traversable
38+import Prelude hiding (mapM, mapM_, sequence, sequence_)
30widgetHoldInternal :: DomBuilder t m => m a -> Event t (m b) -> m (a, Event t b)
41widgetHoldInternal :: DomBuilder t m => m a -> Event t (m b) -> m (a, Event t b)
31widgetHoldInternal child0 child' = do
42widgetHoldInternal child0 child' = do
@@ -65,28 +76,27 @@ listHoldWithKey initialChildren modifyChildren buildChild = do
65 & deleteSelf .~ delete
76 & deleteSelf .~ delete
66 ph <- placeholder myCfg
77 ph <- placeholder myCfg
67 result <- deletable delete $ buildChild k v
78 result <- deletable delete $ buildChild k v
68− return $ ChildResult (result, (fmap (fmap Just) $ _placeholder_insertedAbove ph) <> (Map.singleton k Nothing <$ _placeholder_deleted 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
79+ 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
80 rec initialAugmentedResults <- iforM initialChildren buildAugmentedChild
70 augmentedResults <- foldDyn applyMap initialAugmentedResults $ newInsertedBelow <> newInsertedAbove
81 augmentedResults <- foldDyn applyMap initialAugmentedResults $ newInsertedBelow <> newInsertedAbove
71− let newInsertedAbove = switch $ fmap (mconcat . reverse . fmap (snd . unChildResult) . Map.elems) $ current augmentedResults
82+ 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 ())
83 belowAll <- placeholder $ def & placeholderConfig_insertAbove .~ fmap (imapM buildAugmentedChild) (select placeChildSelector $ Const2 $ Right ())
73− let newInsertedBelow = fmap (fmap Just) $ _placeholder_insertedAbove belowAll
84+ let newInsertedBelow = fmap Just <$> _placeholder_insertedAbove belowAll
74− mapDyn (fmap (fst . unChildResult)) augmentedResults
85+ return $ fmap (fmap (fst . unChildResult)) augmentedResults
76text :: DomBuilder t m => Text -> m ()
87text :: DomBuilder t m => Text -> m ()
77−text t = void $ textNode $ def & textNodeConfig_contents .~ t
88+text t = void $ textNode $ def & textNodeConfig_initialContents .~ t
79−dynText :: (PostBuild t m, DomBuilder t m) => Dynamic t Text -> m ()
90+dynText :: forall t m. (PostBuild t m, DomBuilder t m) => Dynamic t Text -> m ()
80dynText t = do
91dynText t = do
81 postBuild <- getPostBuild
92 postBuild <- getPostBuild
82− _ <- widgetHoldInternal (return ()) $ text <$> leftmost
93+ void $ textNode $ (def :: TextNodeConfig t) & textNodeConfig_setContents .~ leftmost
83 [ updated t
94 [ updated t
84 , tag (current t) postBuild
95 , tag (current t) postBuild
88display :: (PostBuild t m, DomBuilder t m, Show a) => Dynamic t a -> m ()
98display :: (PostBuild t m, DomBuilder t m, Show a) => Dynamic t a -> m ()
89−display = dynText <=< mapDyn (T.pack . show)
99+display = dynText . fmap (T.pack . show)
91button :: DomBuilder t m => Text -> m (Event t ())
101button :: DomBuilder t m => Text -> m (Event t ())
92button t = do
102button t = do
@@ -101,7 +111,7 @@ dyn :: (DomBuilder t m, PostBuild t m) => Dynamic t (m a) -> m (Event t a)
101dyn child = do
111dyn child = do
102 postBuild <- getPostBuild
112 postBuild <- getPostBuild
103 let newChild = leftmost [updated child, tag (current child) postBuild]
113 let newChild = leftmost [updated child, tag (current child) postBuild]
104− liftM snd $ widgetHoldInternal (return ()) newChild
114+ 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.
116-- | 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.
117-- The returned Dynamic of widget results occurs when the Event does.
@@ -167,7 +177,7 @@ listWithKey' = listWithKeyShallowDiff
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))
177listWithKeyShallowDiff :: (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
178listWithKeyShallowDiff initialVals valsChanged mkChild = do
169 let childValChangedSelector = fanMap $ fmap (Map.mapMaybe id) valsChanged
179 let childValChangedSelector = fanMap $ fmap (Map.mapMaybe id) valsChanged
170− sentVals <- foldDyn applyMap Map.empty $ fmap (fmap (fmap (\_ -> ()))) valsChanged
180+ sentVals <- foldDyn applyMap Map.empty $ fmap (fmap void) valsChanged
171 let relevantPatch patch _ = case patch of
181 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
182 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
183 Just _ -> Nothing -- We don't want to let spurious re-creations of items through
@@ -178,10 +188,10 @@ listWithKeyShallowDiff initialVals valsChanged mkChild = do
178-- | Create a dynamically-changing set of Event-valued widgets.
188-- | 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'.
189-- 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))
190listViewWithKey :: (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))
181−listViewWithKey vals mkChild = liftM (switch . fmap mergeMap) $ listViewWithKey' vals mkChild
191+listViewWithKey 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))
193listViewWithKey' :: (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))
184−listViewWithKey' vals mkChild = liftM current $ listWithKey vals mkChild
194+listViewWithKey' vals mkChild = current <$> listWithKey vals mkChild
186-- | Create a dynamically-changing set of widgets, one of which is selected at any time.
196-- | 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)
197selectViewListWithKey :: forall t m k v a. (DomBuilder t m, Ord k, PostBuild t m, MonadHold t m, MonadFix m)
@@ -195,14 +205,14 @@ selectViewListWithKey selection vals mkChild = do
195 selected <- getDemuxed selectionDemux k
205 selected <- getDemuxed selectionDemux k
196 selectSelf <- mkChild k v selected
206 selectSelf <- mkChild k v selected
197 return $ fmap ((,) k) selectSelf
207 return $ fmap ((,) k) selectSelf
198− liftM switchPromptlyDyn $ mapDyn (leftmost . Map.elems) selectChild
208+ 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)
210selectViewListWithKey_ :: 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
211 => Dynamic t k -- ^ Current selection key
202 -> Dynamic t (Map k v) -- ^ Dynamic key/value map
212 -> 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
213 -> (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.
214 -> m (Event t k) -- ^ Event that fires when any child's return Event fires. Contains key of an arbitrary firing widget.
205−selectViewListWithKey_ selection vals mkChild = liftM (fmap fst) $ selectViewListWithKey selection vals mkChild
215+selectViewListWithKey_ selection vals mkChild = fmap fst <$> selectViewListWithKey selection vals mkChild
208{-# INLINABLE elWith #-}
218{-# INLINABLE elWith #-}
@@ -230,34 +240,26 @@ emptyElWith' elementTag cfg = do
230 wrapElement defaultDomEventHandler =<< buildEmptyElementNS (cfg ^. namespace) elementTag (cfg ^. attributes)
240 wrapElement defaultDomEventHandler =<< buildEmptyElementNS (cfg ^. namespace) elementTag (cfg ^. attributes)
233−dynamicAttributesToModifyAttributes :: PostBuild t m => Dynamic t (Map Text Text) -> m (Event t (Map AttributeName (Maybe Text)))
243+{-# INLINABLE el #-}
234−dynamicAttributesToModifyAttributes d = do
244+el :: forall t m a. DomBuilder t m => Text -> m a -> m a
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
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' #-}
245−elDynAttrNS' :: 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)
246−elDynAttrNS' mns elementTag attrs child = do
245+el elementTag child = snd <$> el' elementTag child
247− modifyAttrs <- dynamicAttributesToModifyAttributes attrs
249− & elementConfig_namespace .~ mns
250− & modifyAttributes .~ modifyAttrs
251− element elementTag cfg child
253−{-# INLINABLE elDynAttr' #-}
254−elDynAttr' :: 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)
255−elDynAttr' = elDynAttrNS' Nothing
257{-# INLINABLE elAttr #-}
247{-# INLINABLE elAttr #-}
258elAttr :: forall t m a. DomBuilder t m => Text -> Map Text Text -> m a -> m a
248elAttr :: forall t m a. DomBuilder t m => Text -> Map Text Text -> m a -> m a
259elAttr elementTag attrs child = snd <$> elAttr' elementTag attrs child
249elAttr elementTag attrs child = snd <$> elAttr' elementTag attrs child
251+{-# INLINABLE elClass #-}
252+elClass :: forall t m a. DomBuilder t m => Text -> Text -> m a -> m a
253+elClass elementTag c child = snd <$> elClass' elementTag c child
255+{-# INLINABLE elDynAttr #-}
256+elDynAttr :: forall t m a. (DomBuilder t m, PostBuild t m) => Text -> Dynamic t (Map Text Text) -> m a -> m a
257+elDynAttr elementTag attrs child = snd <$> elDynAttr' elementTag attrs child
259+{-# INLINABLE elDynClass #-}
260+elDynClass :: forall t m a. (DomBuilder t m, PostBuild t m) => Text -> Dynamic t Text -> m a -> m a
261+elDynClass elementTag c child = snd <$> elDynClass' elementTag c child
261{-# INLINABLE el' #-}
263{-# INLINABLE el' #-}
262el' :: forall t m a. DomBuilder t m => Text -> m a -> m (Element EventResult (DomBuilderSpace m) t, a)
264el' :: forall t m a. DomBuilder t m => Text -> m a -> m (Element EventResult (DomBuilderSpace m) t, a)
263el' elementTag = element elementTag def
265el' elementTag = element elementTag def
@@ -265,18 +267,39 @@ el' elementTag = element elementTag def
265{-# INLINABLE elAttr' #-}
267{-# INLINABLE elAttr' #-}
266elAttr' :: forall t m a. DomBuilder t m => Text -> Map Text Text -> m a -> m (Element EventResult (DomBuilderSpace m) t, a)
268elAttr' :: 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
269elAttr' elementTag attrs = element elementTag $ def
268− & initialAttributes .~ (Map.fromList $ fmap (\(k, v) -> ((Nothing, k), v)) $ Map.toList $ attrs)
270+ & initialAttributes .~ Map.mapKeys (\k -> (Nothing, k)) attrs
270−{-# INLINABLE elDynAttr #-}
272+{-# INLINABLE elClass' #-}
271−elDynAttr :: forall t m a. (DomBuilder t m, PostBuild t m) => Text -> Dynamic t (Map Text Text) -> m a -> m a
273+elClass' :: forall t m a. DomBuilder t m => Text -> Text -> m a -> m (Element EventResult (DomBuilderSpace m) t, a)
272−elDynAttr elementTag attrs child = snd <$> elDynAttr' elementTag attrs child
274+elClass' elementTag c = elAttr' elementTag ("class" =: c)
274−{-# INLINABLE el #-}
276+{-# INLINABLE elDynAttr' #-}
275−el :: forall t m a. DomBuilder t m => Text -> m a -> m a
277+elDynAttr' :: 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)
276−el elementTag child = snd <$> el' elementTag child
278+elDynAttr' = elDynAttrNS' Nothing
280+{-# INLINABLE elDynClass' #-}
278−elClass :: forall t m a. DomBuilder t m => Text -> Text -> m a -> m a
281+elDynClass' :: forall t m a. (DomBuilder t m, PostBuild t m) => Text -> Dynamic t Text -> m a -> m (Element EventResult (DomBuilderSpace m) t, a)
279−elClass elementTag c child = fmap snd $ element elementTag (def & initialAttributes .~ (Nothing, "class") =: c) child
282+elDynClass' elementTag c = elDynAttr' elementTag (fmap ("class" =:) c)
284+{-# INLINABLE elDynAttrNS' #-}
285+elDynAttrNS' :: 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)
286+elDynAttrNS' mns elementTag attrs child = do
287+ modifyAttrs <- dynamicAttributesToModifyAttributes attrs
289+ & elementConfig_namespace .~ mns
290+ & modifyAttributes .~ modifyAttrs
291+ element elementTag cfg child
293+dynamicAttributesToModifyAttributes :: PostBuild t m => Dynamic t (Map Text Text) -> m (Event t (Map AttributeName (Maybe Text)))
294+dynamicAttributesToModifyAttributes d = do
295+ postBuild <- getPostBuild
296+ let modificationsNeeded = flip pushAlways (align postBuild $ updated d) $ \case
297+ This () -> fmap (fmap Just) $ sample $ current d
298+ These () new -> return $ fmap Just new
300+ old <- sample $ current d
301+ return $ diffMap old new
302+ return $ Map.fromList . fmap (\(k, v) -> ((Nothing, k), v)) . Map.toList <$> modificationsNeeded
281--------------------------------------------------------------------------------
304--------------------------------------------------------------------------------
282-- Copied and pasted from Reflex.Widget.Class
305-- Copied and pasted from Reflex.Widget.Class
@@ -289,7 +312,7 @@ list dm mkChild = listWithKey dm (\_ dv -> mkChild dv)
290-- | Create a dynamically-changing set of widgets from a Dynamic list.
313-- | 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])
314simpleList :: (DomBuilder t m, MonadHold t m, PostBuild t m, MonadFix m) => Dynamic t [v] -> (Dynamic t v -> m a) -> m (Dynamic t [a])
292−simpleList xs mkChild = mapDyn (map snd . Map.toList) =<< flip list mkChild =<< mapDyn (Map.fromList . zip [(1::Int)..]) xs
315+simpleList xs mkChild = fmap (fmap (map snd . Map.toList)) $ flip list mkChild $ fmap (Map.fromList . zip [(1::Int)..]) xs
295schedulePostBuild x = performEvent_ . (x <$) =<< getPostBuild
318schedulePostBuild x = performEvent_ . (x <$) =<< getPostBuild
@@ -325,17 +348,17 @@ newtype 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)
349workflow :: forall t m a. (DomBuilder t m, MonadFix m, MonadHold t m) => Workflow t m a -> m (Dynamic t a)
327workflow w0 = do
350workflow w0 = do
328− rec eResult <- widgetHold (unWorkflow w0) $ fmap unWorkflow $ switch $ fmap snd $ current eResult
351+ rec eResult <- widgetHold (unWorkflow w0) $ fmap unWorkflow $ switch $ snd <$> current eResult
329− mapDyn fst eResult
352+ 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)
354workflowView :: 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
355workflowView w0 = do
333− rec eResult <- dyn =<< mapDyn unWorkflow =<< holdDyn w0 eReplace
356+ rec eResult <- dyn . fmap unWorkflow =<< holdDyn w0 eReplace
334− eReplace <- liftM switch $ hold never $ fmap snd eResult
357+ eReplace <- fmap switch $ hold never $ fmap snd eResult
335 return $ fmap fst eResult
358 return $ fmap fst eResult
337mapWorkflow :: (DomBuilder t m) => (a -> b) -> Workflow t m a -> Workflow t m b
360mapWorkflow :: (DomBuilder t m) => (a -> b) -> Workflow t m a -> Workflow t m b
338−mapWorkflow f (Workflow x) = Workflow (fmap (\(v,e) -> (f v, fmap (mapWorkflow f) e)) x)
361+mapWorkflow f (Workflow x) = Workflow (fmap (f *** fmap (mapWorkflow f)) x)
340divClass :: forall t m a. DomBuilder t m => Text -> m a -> m a
363divClass :: forall t m a. DomBuilder t m => Text -> m a -> m a
341divClass = elClass "div"
364divClass = elClass "div"
@@ -343,7 +366,7 @@ divClass = elClass "div"
343dtdd :: forall t m a. DomBuilder t m => Text -> m a -> m a
366dtdd :: forall t m a. DomBuilder t m => Text -> m a -> m a
344dtdd h w = do
367dtdd h w = do
345 el "dt" $ text h
368 el "dt" $ text h
346− el "dd" $ w
369+ el "dd" w
348blank :: forall m. Monad m => m ()
371blank :: forall m. Monad m => m ()
349blank = return ()
372blank = return ()
@@ -376,9 +399,9 @@ tabDisplay :: forall t m k. (MonadFix m, DomBuilder t m, MonadHold t m, PostBuil
376tabDisplay ulClass activeClass tabItems = do
399tabDisplay ulClass activeClass tabItems = do
377 let t0 = listToMaybe $ Map.keys tabItems
400 let t0 = listToMaybe $ Map.keys tabItems
378 rec currentTab :: Demux t (Maybe k) <- elAttr "ul" ("class" =: ulClass) $ do
401 rec currentTab :: Demux t (Maybe k) <- elAttr "ul" ("class" =: ulClass) $ do
379− tabClicksList :: [Event t k] <- (liftM Map.elems) $ imapM (\k (s,_) -> headerBarLink s k =<< getDemuxed currentTab (Just k)) tabItems
402+ 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
403 let eTabClicks :: Event t k = leftmost tabClicksList
381− liftM demux $ holdDyn t0 $ fmap Just eTabClicks
404+ fmap demux $ holdDyn t0 $ fmap Just eTabClicks
382 el "div" $ do
405 el "div" $ do
383 iforM_ tabItems $ \k (_, w) -> do
406 iforM_ tabItems $ \k (_, w) -> do
384 isSelected <- getDemuxed currentTab $ Just k
407 isSelected <- getDemuxed currentTab $ Just k
@@ -388,7 +411,7 @@ tabDisplay ulClass activeClass tabItems = do
389 headerBarLink :: Text -> k -> Dynamic t Bool -> m (Event t k)
412 headerBarLink :: Text -> k -> Dynamic t Bool -> m (Event t k)
390 headerBarLink x k isSelected = do
413 headerBarLink x k isSelected = do
391− attrs <- mapDyn (\b -> if b then Map.singleton "class" activeClass else Map.empty) isSelected
414+ let attrs = fmap (\b -> if b then Map.singleton "class" activeClass else Map.empty) isSelected
392 elDynAttr "li" attrs $ do
415 elDynAttr "li" attrs $ do
393 a <- link x
416 a <- link x
394 return $ fmap (const k) (_link_clicked a)
417 return $ fmap (const k) (_link_clicked a)