{-# LANGUAGE OverloadedStrings #-}

-----------------------------------------------------------------------------
-- |
-- Module: Layout.Bootstrap.Widgets
-- 
-- Wrap your Html in bootstrap-styled containers.
--
-----------------------------------------------------------------------------


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)

-- * Forms

-- | Form wrapper.
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

-- | Bootstrap-horizontal form.
formH :: T.Text -> Html -> Html
formH = form "form-horizontal"

-- | Bootstrap-vertical form.
formV :: T.Text -> Html -> Html
formV = form "form-vertical"

-- | Fieldset label.
fieldset :: T.Text -> Html -> Html
fieldset legend body = H.fieldset $ do { H.legend $ toHtml legend; body }

-- | Form button bar.
formActions :: Html -> Html
formActions body = H.div ! A.class_ "form-actions" $ body

-- ** Text input

-- | Form field for one-line text entry.
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 [])
    {-# INLINE toHtml #-}

-- | Text field with only name provided. Good to start with record overrides. Needs 'toHtml' when inserted into 'Html' tree.
simpleInput :: T.Text -> Input
simpleInput title = Input title "" "" "" False

-- | Html constructor for just needed parameters.
input :: T.Text -> T.Text -> T.Text -> Html
input title placeholder help = input' title placeholder help "" False

-- | Html constructor for all Input parameters.
input' :: T.Text -> T.Text -> T.Text -> T.Text -> Bool -> Html
input' title placeholder help value errors = toHtml $ Input title placeholder help value errors

-- * Buttons

-- | Generic button element. Provide list of css classes to be added. Hook JS actions to class names.
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

-- | Button container. Put 'button's inside.
buttonGroup :: Html -> Html
buttonGroup body = H.div ! A.class_ "btn-group" $ body

-- | Toolbar-like groups of buttons. Put 'buttonGroup's inside.
buttonBar :: Html -> Html
buttonBar body = H.div ! A.class_ "btn-toolbar" $ body

-- ** Dropdown Menu

-- | Button with a dropdown menu.
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

-- | More menu-like button. Has a caret in a split section.
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

-- * Layout

-- | ID-marked navigation section.
section :: T.Text -> Html -> Html
section id body = H.section ! A.id (toValue id) $ body

-- | Fixed-width container.
row :: Html -> Html
row body = H.div ! A.class_ "row" $ body

-- | Percent-width container.
rowF :: Html -> Html
rowF body = H.div ! A.class_ "row-fluid" $ body

-- | Content wrapper to place inside a container.
span :: Int -> Html -> Html
span size body = H.div ! A.class_ (toValue $ "span" ++ show size) $ body

-- | Cell with an offset (fixed row only).
offspan :: Int -> Int -> Html -> Html
offspan off size body = H.div ! A.class_ (toValue $ "span" ++ show size ++ " offset" ++ show off) $ body

-- * Base CSS

-- | Dedicated place for some great quotes.
blockQuote_ :: T.Text -> T.Text -> Html -> Html
blockQuote_ author cite body = H.blockquote ! A.cite (toValue cite) $ body >> H.small (toHtml author)

-- * Icons

-- | Default glyphs.
icon :: T.Text -> Html
icon glyph = H.i ! A.class_ iconClass $ mempty
  where iconClass = toValue $ "icon-" ++ T.unpack glyph

-- | White glyphs.
iconW :: T.Text -> Html
iconW glyph = H.i ! A.class_ iconClass $ mempty
  where iconClass = toValue $ "icon-" ++ T.unpack glyph ++ "icon-white"

-- * Misc

-- | An area with a rounded border.
well :: Html -> Html
well body = H.div ! A.class_ "well" $ body

-- | Tiny cross element for notification blocks.
closeIcon :: Html
closeIcon = H.a ! A.class_ "close" $ "×"