module Reflex.Dom.Contrib.Widgets.DynTabs
( Tab(..)
, tabBar
, tabPane
, activeHelper
) where
import qualified Data.Map as M
import Data.Monoid
import qualified Data.Set as S
import Reflex
import Reflex.Dom
import Reflex.Dom.Contrib.Utils
class (Eq tab, Ord tab) => Tab m tab where
tabIndicator :: tab -> m ()
tabBar
:: forall t m tab. (MonadWidget t m, Tab m tab)
=> String
-> tab
-> [tab]
-> Event t [tab]
-> Event t tab
-> Dynamic t (S.Set tab)
-> m (Dynamic t tab)
tabBar tabClass initialSelected initialTabs tabs curTab disabledTabs = do
divClass "dyn-tab-bar" $ do
elAttr "ul" ("class" =: tabClass) $ do
rec let tabFunc = mapM (mkTab currentTab disabledTabs)
foo <- widgetHoldHelper tabFunc initialTabs tabs
let bar :: Event t tab = switch $ fmap leftmost $ current foo
currentTab <- holdDyn initialSelected $ leftmost [bar, curTab]
return currentTab
mkTab
:: (MonadWidget t m, Tab m tab)
=> Dynamic t tab
-> Dynamic t (S.Set tab)
-> tab
-> m (Event t tab)
mkTab currentTab disabledTabs t = do
isSelected <- mapDyn (==t) currentTab
isDisabled <- mapDyn (S.member t) disabledTabs
e <- activeHelper "li" (el "a" $ tabIndicator t) isSelected isDisabled
return $ gate (not <$> current isDisabled) (t <$ e)
tabPane :: (MonadWidget t m, Eq tab) => Dynamic t tab -> tab -> m a -> m a
tabPane currentTab t child = do
isShown <- mapDyn (\c ->
if c == t then klass
else klass <> "style" =: "display: none") currentTab
elDynAttr "div" isShown child
where
klass = "class" =: "dyn-tab-pane"
activeHelper
:: MonadWidget t m
=> String
-> m ()
-> Dynamic t Bool
-> Dynamic t Bool
-> m (Event t ())
activeHelper elName children isSelected isDisabled = do
let mkAttrs selected disabled =
if disabled
then "class" =: "disabled"
else if selected
then "class" =: "active"
else M.empty
attrs <- combineDyn mkAttrs isSelected isDisabled
(li, _) <- elDynAttr' elName attrs children
return $ domEvent Click li