module Layout.Bootstrap.Widgets where
import Text.Blaze (ToHtml)
import Text.Blaze.Html5 (Html, (!), toHtml, toValue)
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import qualified Data.Text as T
import Data.Monoid (mempty)
form :: T.Text -> T.Text -> Html -> Html
form class_ action body = H.form ! A.action (toValue action) ! A.class_ (toValue class_) ! A.method "POST" $ body
formH :: T.Text -> Html -> Html
formH = form "form-horizontal"
formV :: T.Text -> Html -> Html
formV = form "form-vertical"
fieldset :: T.Text -> Html -> Html
fieldset legend body = H.fieldset $ do { H.legend $ toHtml legend; body }
formActions :: Html -> Html
formActions body = H.div ! A.class_ "form-actions" $ body
data Input = Input { title :: !T.Text
, placeholder :: !T.Text
, help :: !T.Text
, value :: !T.Text
, errors :: !Bool
} deriving (Show)
instance ToHtml Input where
toHtml i = H.div ! A.class_ groupLabels $ do
H.label ! A.class_ "control-label" ! A.for id $ toHtml (title i)
H.div ! A.class_ "controls" $ do
H.input ! A.type_ "text" ! A.id id ! A.name (toValue name) ! A.placeholder (toValue $ placeholder i) ! A.class_ "input-xlarge" ! (A.value . toValue $ value i)
H.p ! A.class_ "help-block" $ toHtml (help i)
where
name = T.toLower (title i)
id = toValue ("id_" ++ T.unpack name)
groupLabels = toValue . unwords $ "control-group":(if errors i then ["error"] else [])
simpleInput :: T.Text -> Input
simpleInput title = Input title "" "" "" False
input :: T.Text -> T.Text -> T.Text -> Html
input title placeholder help = input' title placeholder help "" False
input' :: T.Text -> T.Text -> T.Text -> T.Text -> Bool -> Html
input' title placeholder help value errors = toHtml $ Input title placeholder help value errors
button :: T.Text -> [T.Text] -> Html -> Html
button type_ classes body = do
H.button ! A.type_ (toValue type_) ! A.class_ mkClasses $ body
" "
where mkClasses = toValue $ T.unwords $ "btn" : classes
buttonGroup :: Html -> Html
buttonGroup body = H.div ! A.class_ "btn-group" $ body
buttonBar :: Html -> Html
buttonBar body = H.div ! A.class_ "btn-toolbar" $ body
buttonDD :: T.Text -> Html -> Html
buttonDD action body = buttonGroup $ do
H.a ! A.class_ "btn dropdown-toggle" ! H.dataAttribute "toggle" "dropdown" ! A.href "#" $ do
toHtml action
H.span ! A.class_ "caret" $ mempty
H.ul ! A.class_ "dropdown-menu" $ body
buttonSDD :: T.Text -> Html -> Html
buttonSDD action body = buttonGroup $ do
H.a ! A.class_ "btn" ! A.href "#" $ toHtml action
H.a ! A.class_ "btn dropdown-toggle" ! H.dataAttribute "toggle" "dropdown" ! A.href "#" $
H.span ! A.class_ "caret" $ mempty
H.ul ! A.class_ "dropdown-menu" $ body
section :: T.Text -> Html -> Html
section id body = H.section ! A.id (toValue id) $ body
row :: Html -> Html
row body = H.div ! A.class_ "row" $ body
rowF :: Html -> Html
rowF body = H.div ! A.class_ "row-fluid" $ body
span :: Int -> Html -> Html
span size body = H.div ! A.class_ (toValue $ "span" ++ show size) $ body
offspan :: Int -> Int -> Html -> Html
offspan off size body = H.div ! A.class_ (toValue $ "span" ++ show size ++ " offset" ++ show off) $ body
blockQuote_ :: T.Text -> T.Text -> Html -> Html
blockQuote_ author cite body = H.blockquote ! A.cite (toValue cite) $ body >> H.small (toHtml author)
icon :: T.Text -> Html
icon glyph = H.i ! A.class_ iconClass $ mempty
where iconClass = toValue $ "icon-" ++ T.unpack glyph
iconW :: T.Text -> Html
iconW glyph = H.i ! A.class_ iconClass $ mempty
where iconClass = toValue $ "icon-" ++ T.unpack glyph ++ "icon-white"
well :: Html -> Html
well body = H.div ! A.class_ "well" $ body
closeIcon :: Html
closeIcon = H.a ! A.class_ "close" $ "×"