{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Reflex.Bulmex.Tag where
import Control.Applicative
import Data.Bool
import qualified Data.Map.Strict as Map
import qualified Data.Text as Text
import Reflex
import Reflex.Bulmex.Attr
import Reflex.Bulmex.Space
import qualified Reflex.Dom.Builder.Class as Dom
import qualified Reflex.Dom.Widget as Dom
import qualified Reflex.Tags as T
container :: Dom.DomBuilder t m => m a -> m a
container = containerClass mempty
containerClass :: Dom.DomBuilder t m => Text.Text -> m a -> m a
containerClass = partialDiv "container"
partialDiv :: Dom.DomBuilder t m => Text.Text -> Text.Text -> m a -> m a
partialDiv = txtEl T.divClass
txtEl :: (Text.Text -> m a -> m a) -> Text.Text -> Text.Text -> m a -> m a
txtEl = defaultEl spaceJoin
defaultEl :: (arg -> arg -> arg) -> (arg -> m a -> m a) -> arg -> arg -> m a -> m a
defaultEl monoidF elF a b = elF $ monoidF a b
buttons :: Dom.DomBuilder t m => m a -> m a
buttons = T.divClass "buttons"
image :: Dom.DomBuilder t m => Text.Text -> m()
image url = T.imgAttr (Map.singleton "src" url) Dom.blank
imageClass :: Dom.DomBuilder t m => Text.Text -> Text.Text -> m()
imageClass clazz url = T.imgAttr (Map.fromList [("src",url), ("class", clazz)]) Dom.blank
hero :: Dom.DomBuilder t m => Text.Text -> m a -> m a
hero styles =
txtEl T.sectionClass "hero" styles . T.divClass "hero-body" . container
content :: Dom.DomBuilder t m => m a -> m a
content = T.divClass "content"
sect :: (Dom.DomBuilder t m) => m a -> m a
sect = T.divClass "section"
section :: (PostBuild t m, Dom.DomBuilder t m) => m a -> m a
section = sectionDyn $ constDyn mempty
sectionDyn ::
(PostBuild t m, Dom.DomBuilder t m) => Dynamic t AttrMap -> m a -> m a
sectionDyn =
dynAttrEl (\a b -> T.divDynAttr a $ container b) $ classAttr "section"
columns :: Dom.DomBuilder t m => m a -> m a
columns = columnsClass mempty
column :: Dom.DomBuilder t m => m a -> m a
column = columnClass mempty
columnsClass :: Dom.DomBuilder t m => Text.Text -> m a -> m a
columnsClass = partialDiv "columns"
columnClass :: Dom.DomBuilder t m => Text.Text -> m a -> m a
columnClass = partialDiv "column"
control :: Dom.DomBuilder t m => m a -> m a
control = controlClass mempty
controlClass :: Dom.DomBuilder t m => Text.Text -> m a -> m a
controlClass = partialDiv "control"
controlDyn ::
(PostBuild t m, Dom.DomBuilder t m) => Dynamic t AttrMap -> m a -> m a
controlDyn = dynAttrEl T.divDynAttr $ classAttr "control"
tile :: Dom.DomBuilder t m => Text.Text -> m a -> m a
tile = partialDiv "tile"
tileChild :: Dom.DomBuilder t m => m a -> m a
tileChild = tileChildClass mempty
tileChildClass :: Dom.DomBuilder t m => Text.Text -> m a -> m a
tileChildClass = txtEl tile "is-child"
tileParentClass :: Dom.DomBuilder t m => Text.Text -> m a -> m a
tileParentClass = txtEl tile "is-parent"
tileParent :: Dom.DomBuilder t m => m a -> m a
tileParent = tileParentClass mempty
tileAncestor :: Dom.DomBuilder t m => m a -> m a
tileAncestor = tile "is-ancestor"
dynAttrEl ::
Reflex t
=> (Dynamic t AttrMap -> m a -> m a)
-> AttrMap
-> Dynamic t AttrMap
-> m a
-> m a
dynAttrEl f = defaultEl ((<*>) . (<$>) attrUnion) f . constDyn
field :: Dom.DomBuilder t m => m a -> m a
field = fieldClass mempty
fieldClass :: Dom.DomBuilder t m => Text.Text -> m a -> m a
fieldClass = partialDiv "field"
fieldGrouped :: Dom.DomBuilder t m => m a -> m a
fieldGrouped = fieldClass "is-grouped"
title :: Dom.DomBuilder t m => m a -> m a
title = titleClazz "is-1"
titleClazz :: Dom.DomBuilder t m => Text.Text -> m a -> m a
titleClazz = txtEl T.h1Class "title"
subtitle :: Dom.DomBuilder t m => m a -> m a
subtitle = subtitleClass "is-3"
subtitleClass :: Dom.DomBuilder t m => Text.Text -> m a -> m a
subtitleClass = txtEl T.h2Class "subtitle"
box :: Dom.DomBuilder t m => m a -> m a
box = T.divClass "box"
evtText :: (Dom.DomBuilder t m, PostBuild t m, MonadHold t m) => Event t Text.Text -> m ()
evtText evt = Dom.dynText =<< holdDyn "" evt
labeled' :: Dom.DomBuilder t m => m () -> m a -> m a
labeled' labelM inputM = do
labelEl labelM
control inputM
labelEl :: Dom.DomBuilder t m => m a -> m a
labelEl = labelClass mempty
labelClass :: Dom.DomBuilder t m => Text.Text -> m a -> m a
labelClass = txtEl T.labelClass "label"
data ToolDirection
= Top
| Lft
| Rght
| Down
tooltipText ::
(PostBuild t m, Dom.DomBuilder t m) => Dynamic t Text.Text -> m a -> m a
tooltipText = tooltipText' Rght
tooltipText' ::
(PostBuild t m, Dom.DomBuilder t m)
=> ToolDirection
-> Dynamic t Text.Text
-> m a
-> m a
tooltipText' dir tipDyn monad = T.spanDynAttr (tipToAttr dir <$> tipDyn) $ monad
tipToAttr :: ToolDirection -> Text.Text -> AttrMap
tipToAttr dir "" = tipToAttr dir "-"
tipToAttr dir tip =
Map.fromList [("data-balloon", tip), ("data-balloon-pos", direction dir)]
direction :: ToolDirection -> Text.Text
direction Top = "top"
direction Lft = "left"
direction Rght = "right"
direction Down = "down"
icon :: (PostBuild t m, Dom.DomBuilder t m) => Text.Text -> m ()
icon = iconClass ""
iconClass ::
(PostBuild t m, Dom.DomBuilder t m) => Text.Text -> Text.Text -> m ()
iconClass wrapClass =
iconDyn (constDyn (classAttr wrapClass)) . constDyn . classAttr
iconDyn ::
(PostBuild t m, Dom.DomBuilder t m)
=> Dynamic t AttrMap
-> Dynamic t AttrMap
-> m ()
iconDyn wrapClass mdiClass = do
textSpace
T.spanDynAttr (attrUnion (classAttr "icon") <$> wrapClass) $
T.iDynAttr (Map.unionWith (<>) (classAttr "mdi mdi-") <$> mdiClass) $
Dom.blank
textSpace
textSpace :: Dom.DomBuilder t m => m ()
textSpace = Dom.text space
flask :: (PostBuild t m, Dom.DomBuilder t m) => m ()
flask = icon "flask"
ahref :: (Dom.DomBuilder t m, PostBuild t m) => Text.Text -> m a -> m a
ahref = ahref' mempty
ahref' :: (Dom.DomBuilder t m, PostBuild t m) => AttrMap -> Text.Text -> m a -> m a
ahref' uno = ahrefDyn (constDyn uno) . constDyn
ahrefDyn :: (Dom.DomBuilder t m, PostBuild t m) => Dynamic t AttrMap -> Dynamic t Text.Text -> m a -> m a
ahrefDyn uno txt = T.aDynAttr $ (attrUnion <$> uno) <*> (Map.singleton "href" <$> txt)
switchDiv ::
(PostBuild t m, Dom.DomBuilder t m)
=> Dynamic t Bool
-> m ()
-> m a
-> m a
switchDiv attrDyn true false = do
hideDiv_ (not <$> attrDyn) true
hideDiv_ attrDyn false
hideDiv ::
(PostBuild t m, Dom.DomBuilder t m)
=> Dynamic t AttrMap
-> Dynamic t Bool
-> m a
-> m a
hideDiv attrDyn hide =
T.divDynAttr $ bool <$> attrDyn <*> constDyn isHidden <*> hide
hideDiv_ :: (PostBuild t m, Dom.DomBuilder t m) => Dynamic t Bool -> m a -> m a
hideDiv_ = hideDiv $ constDyn Map.empty
loadSpinner :: (Dom.DomBuilder t m) => m ()
loadSpinner = imageClass "loadSpinner" "spinner.svg"
hideEmptyDiv ::
(Eq (f b), Alternative f, PostBuild t m, Dom.DomBuilder t m)
=> Dynamic t (f b)
-> m a
-> m a
hideEmptyDiv = hideEmptyDyn $ constDyn Map.empty
hideEmptyDyn ::
(Eq (f b), Alternative f, PostBuild t m, Dom.DomBuilder t m)
=> Dynamic t AttrMap
-> Dynamic t (f b)
-> m a
-> m a
hideEmptyDyn dyn = hideDiv dyn . fmap ((==) empty)