# LANGUAGE LambdaCase #
{-# LANGUAGE OverloadedStrings #-}
module Bead.View.Content.Bootstrap where


 Collection of bootstrap related pagelets . 

Collection of bootstrap related pagelets.
-}

import           Control.Monad (when)

import           Data.Data
import           Data.Maybe (fromMaybe)
import           Data.Monoid
import           Data.String

import           Text.Blaze.Html5 hiding (map)
import qualified Text.Blaze.Html5 as H hiding (map)
import           Text.Blaze.Html5.Attributes
import qualified Text.Blaze.Html5.Attributes as A

import           Bead.View.Fay.JSON.ServerSide

-- | Represents the possible sizes of columns
newtype ColumnSize = ColumnSize Int
  deriving Eq

columnSize f (ColumnSize s) = f s

colSize1  = ColumnSize 1
colSize2  = ColumnSize 2
colSize3  = ColumnSize 3
colSize4  = ColumnSize 4
colSize5  = ColumnSize 5
colSize6  = ColumnSize 6
colSize7  = ColumnSize 7
colSize8  = ColumnSize 8
colSize9  = ColumnSize 9
colSize10 = ColumnSize 10
colSize11 = ColumnSize 11
colSize12 = ColumnSize 12

-- Returns the HTML class attribute value for the given column size
columnSizeClass = columnSize $ \size -> "col-md-" ++ show size

-- | Represents the possible offsets of columns
newtype ColumnOffset = ColumnOffset Int
  deriving Eq

columnOffset f (ColumnOffset s) = f s

colOffset1  = ColumnOffset 1
colOffset2  = ColumnOffset 2
colOffset3  = ColumnOffset 3
colOffset4  = ColumnOffset 4
colOffset5  = ColumnOffset 5
colOffset6  = ColumnOffset 6
colOffset7  = ColumnOffset 7
colOffset8  = ColumnOffset 8
colOffset9  = ColumnOffset 9
colOffset10 = ColumnOffset 10
colOffset11 = ColumnOffset 11
colOffset12 = ColumnOffset 12

-- Returns the HTML class attribute value for the given column offset
columnOffsetClass = columnOffset $ \offset -> "col-md-offset-" ++ show offset

container = H.div ! class_ "container"

footer = H.div ! A.id "bead-footer" ! class_ "navbar navbar-default navbar-fixed-bottom"

-- | Fades out the footer after the given seconds
fadeOutFooter secs = do
  H.script $ fromString $ concat ["$('#bead-footer').delay(", show (secs * 1000), ").fadeOut('slow')"]

fadeOutFooterButton custom ttl text = do
  a ! class_ (fromString ("btn " <> custom))
    ! role "button"
    ! A.title (fromString ttl)
    ! href "#"
    ! disabled ""
    $ (fromString text)

-- | Creates a warning style button, if the user clicks on the button the footer fades away.
fadeOutFooterWarningButton = fadeOutFooterButton "btn-warning"

-- | Creates a danger style button, if the user clicks on the button the footer fades away
fadeOutFooterDangerButton = fadeOutFooterButton "btn-danger"

formGroup = H.div ! class_ "form-group"

inputGroup = H.div ! class_ "input-group"

-- | Creates a list group div, which can contain a various list group items
listGroup = H.div ! class_ "list-group"

-- | Creates and unordered list as a list group
unorderedListGroup = H.ul ! class_ "list-group"

-- | Creates a linked list group item with a route to point at, and a text to
-- display
listGroupLinkItem route text = H.a ! href (fromString route) ! class_ "list-group-item" $ text

-- | Creates a linked list group item with a route to point at, and a text to
-- display, renderd with the given color.
listGroupAlertLinkItem alert route text = H.a ! href (fromString route) ! class_ (fromString itemColor) $ text
  where
    itemColor = "list-group-item list-group-item-" ++ (alertAlgebra "success" "info" "warning" "danger" alert)

-- | Creates a texted list group item
listGroupTextItem text = H.a ! href "#" ! class_ "list-group-item" $ fromString text

-- | Creates a badge that can be displayed in the list group
badge text = H.span ! class_ "badge" $ fromString text

-- | Creates a badge with alert coloring
badgeAlert alert text = H.span ! class_ (fromString $ "badge alert-" ++ a) $ fromString text where
  a = alertAlgebra "success" "info" "warning" "danger" alert


-- | Creates a caret sign
caret = H.span ! class_ "caret" $ mempty

-- | Creates a justified button group
buttonGroupJustified = H.div ! class_ "btn-group btn-group-justified"

-- | Creates a button group
buttonGroup = H.div ! class_ "btn-group"

-- | Creates a button link with custom button attribute, a route to point
-- a title and a text to show
customButtonLink custom ref ttl text =
  a ! class_ (fromString ("btn " <> (unwords custom)))
    ! customAttribute "role" "button"
    ! A.title (fromString ttl)
    ! href (fromString ref)
    $ (fromString text)

-- | Creates a button styled link
buttonLink ref text = customButtonLink ["btn-default"] ref "" text

-- | Creates a block button styled link
blockButtonLink ref text = customButtonLink ["btn-default", "btn-block"] ref "" text

-- | Warning button with a given text
warningButtonLink ref text = customButtonLink ["btn-warning"] ref "" text

-- | Danger button with a given text
dangerButtonLink ref text = customButtonLink ["btn-danger"] ref "" text

  | Creates a date time picker using a third party library and turns on if the on switch
-- is set to True
datetimePicker paramName date on =
  H.div ! class_ "input-group date"
        ! A.id (fromString paramName) $ do
    input ! formControl
          ! name (fromString paramName)
          ! type_ "text"
          ! readonly ""
          ! required ""
          ! value (fromString date)
    H.span ! class_ "input-group-addon" $ H.span ! class_ "glyphicon glyphicon-calendar" $ mempty
    when on $ dateTimePickerScript paramName

dateTimePickerScript pickerId = script . fromString $ concat
  [ "$(function () {"
  ,   "$('#", pickerId, "').datetimepicker({"
  ,     "format: 'YYYY-MM-DD HH:mm:ss',"
  ,     "pick12HourFormat: false,"
  ,     "pickSeconds: true"
  ,   "});"
  , "});"
  ]

-- | Creates a dropdown button
dropdownButton text =
  button ! type_ "button"
         ! class_ "btn btn-default dropdown-toggle"
         ! dataAttribute "toggle" "dropdown"
         $ do (fromString text); caret

-- | Creates a list of dropdown menu items
dropdownMenu items = H.ul ! class_ "dropdown-menu" ! customAttribute "role" "menu" $ mapM_ li items

-- | Creates a dropdown from the items with the given text on the button
dropdown text items = buttonGroup $ do
  dropdownButton text
  dropdownMenu items

-- | Creates a paragrapth that represents a help block from a given text
helpBlock text = p ! class_ "help-block" $ fromString text

-- | Creates a form control selection with the given parameter name, a selector
-- function which determines the selected value, and possible values
selection paramName selector values =
  formGroup $ selectionPart
    paramName
    [class_ "combobox form-control", A.style "display:none", A.required ""]
    selector
    values

-- | Creates a form control selection with the given parameter name, a label, a selector
-- function which determines the selected value, and possible values
selectionWithLabel paramName labelText selector values = formGroup $ do
  labelFor paramName labelText
  selectionPart
    paramName
    [class_ "combobox form-control", A.style "display:none", A.required ""]
    selector
    values

-- | Creates a form control optional selection with the given parameter name, a label, a selector
-- function which determines the selected value, and possible values
selectionOptionalWithLabel paramName labelText selector values = formGroup $ do
  labelFor paramName labelText
  selectionOptionalPart
    paramName
    [class_ "combobox form-control", A.style "display:none"]
    selector
    values


-- | Creates a submit block button with a given name and the given text
submitButton nameValue text =
  button ! type_ "submit"
         ! (name $ fromString nameValue)
         ! class_ "btn btn-block btn-default"
         $ fromString text

  | Creates a submit button with a given attrbute and a given text
submitButtonWithAttr attr text =
  button ! type_ "submit"
         ! class_ "btn btn-block btn-default"
         ! attr
         $ fromString text

-- | Creates a submit small button with a given name and the given text
smallSubmitButton nameValue text =
  button ! type_ "submit"
         ! (name $ fromString nameValue)
         ! class_ "btn btn-default"
         $ fromString text

-- | Turns the selection into combobox like selections
turnSelectionsOn
  = script ! type_ "text/javascript" $ "$(document).ready(function(){$('.combobox').combobox()});"

-- | Creates a password input with the given name as id, a given label within a form-group control
passwordInput paramName labelText =
  formGroup $ do
    labelFor paramName labelText
    H.input ! formControl
            ! type_ "password"
            ! required ""
            ! name (fromString paramName)
            ! A.id (fromString paramName)

inputForFormControl = H.input ! formControl

-- | Creates a text input field only with a default value
textInputFieldWithDefault paramName value =
    optionalTextInputFieldWithDefault paramName value ! A.required ""

-- | Creates an optional text input field onyl with default value
optionalTextInputFieldWithDefault paramName value =
    H.input ! formControl
            ! type_ "text"
            ! A.name (fromString paramName)
            ! A.id (fromString paramName)
            ! A.value (fromString value)

-- | Creates a text input with the given name as id, a given label and a placeholder text
textInput paramName labelText placeholderText =
  formGroup $ do
    labelFor paramName labelText
    H.input ! formControl
            ! type_ "text"
            ! A.required ""
            ! A.name (fromString paramName)
            ! A.id (fromString paramName)
            ! A.placeholder (fromString placeholderText)

-- | Creates an optional text input with the given name as id, a given label and a placeholder text
optionalTextInput paramName labelText placeholderText =
  formGroup $ do
    labelFor paramName labelText
    H.input ! formControl
            ! type_ "text"
            ! A.name (fromString paramName)
            ! A.id (fromString paramName)
            ! A.placeholder (fromString placeholderText)

-- | Creates an optional text input with the given name as id, a given label and a default value
optionalTextInputWithDefault paramName labelText value =
    formGroup $ do
      labelFor paramName labelText
      optionalTextInputFieldWithDefault paramName value


-- | Creates a text input with the given name as id, a given label and a default value
textInputWithDefault paramName labelText value =
  formGroup $ do
    labelFor paramName labelText
    textInputFieldWithDefault paramName value

readOnlyTextInputWithDefault paramName labelText value =
  formGroup $ do
    labelFor paramName labelText
    (textInputFieldWithDefault paramName value) ! A.readonly ""

-- | Creates a label for the given id and given text
labelFor name text =
  H.label ! for (fromString name) $ (fromString text)

-- | Creates a labeled text as a form group element
labeledText name value =
  formGroup $ do
    H.label $ fromString $ name
    H.span ! formControl $ value



grayLabel :: String -> Html
grayLabel text  = H.span ! class_ "label label-default" $ fromString text

greenLabel :: String -> Html
greenLabel text = H.span ! class_ "label label-success" $ fromString text

redLabel :: String -> Html
redLabel text = H.span ! class_ "label label-danger"  $ fromString text

blueLabel :: String -> Html
blueLabel text = H.span ! class_ "label label-primary" $ fromString text

-- | Creates a text area input field with the given name as id, a given id
textAreaField paramName =
    H.textarea ! formControl
               ! A.required ""
               ! A.rows "20"
               ! A.id (fromString paramName)
               ! A.name (fromString paramName)

-- | Creates an optional text area input field with the given name as id, a given id
textAreaOptionalField paramName =
    H.textarea ! formControl
               ! A.rows "20"
               ! A.id (fromString paramName)
               ! A.name (fromString paramName)

-- | Creates a text area input with the given name as id, a given label
textArea paramName labelText html =
  formGroup $ do
    labelFor paramName labelText
    textAreaField paramName html

-- | Creates an optional text area input with the given name as id, a given label
optionalTextArea paramName labelText html =
  formGroup $ do
    labelFor paramName labelText
    textAreaOptionalField paramName html

-- | Creates a text area input with the given name as id, a given label
utf8TextArea paramName labelText html =
  formGroup $ do
    labelFor paramName labelText
    textAreaField paramName ! A.acceptCharset "utf-8" $ html

-- | Creates a radio button group, with a given values and labels, the parameter name
  as numbered ids . The first value is the primary active
radioButtonGroup paramName valuesAndLabel =
  H.div ! class_ "btn-group" $
    mapM_ button ([1..] `zip` valuesAndLabel)
  where
    button (n,(c,v,l)) =
      H.label ! class_ "btn btn-default" $ do
        checked c $
          H.input ! type_ "radio"
                  ! name (fromString paramName)
                  ! A.id (fromString (paramName ++ show n))
                  ! A.value (fromString v)
        fromString l
    checked c tag = if c then (tag ! A.checked "") else tag

-- | Creates a bootstrap row
row = H.div ! class_ "row"

-- | Creates a bootstrap column with the given offset
colMd size offset =
  H.div ! class_ (fromString $ concat [columnSizeClass size, " ", columnOffsetClass offset])

  | Creates a bootstrap 12 column
colMd12 = H.div ! class_ "col-md-12"

  | Creates a bootstrap 4 width column
colMd4 = H.div ! class_ "col-md-4"

  | Creates a bootstrap 6 width column
colMd6 = H.div ! class_ "col-md-6"

  | Creates a bootstrap raw with only one colMd12 column
rowColMd12 = row . colMd12

  | Creates a boostrap row with a 4 sized column in the middle of the page
rowCol4Offset4 = row . colMd colSize4 colOffset4

-- | Creates a bootstrap page header
pageHeader = H.div ! class_ "page-header"

-- | Creates a bootstrap table
table = H.table ! class_ "table table-bordered table-condensed table-hover table-striped"

  Creates a table line first element is a bold text and the second is a HTML snippet
infixl 7 .|.
(.|.) :: String -> Html -> Html
name .|. value = H.tr $ do
  H.td $ b $ fromString $ name
  H.td $ value

-- Alerts

data Alert = Success | Info | Warning | Danger
  deriving (Eq, Show)

alertAlgebra
  success
  info
  warning
  danger
  = \case
    Success -> success
    Info    -> info
    Warning -> warning
    Danger  -> danger

-- HTML helpers

optionTag :: String -> String -> Bool -> Html
optionTag value text False = H.option ! A.value (fromString value)                 $ fromString text
optionTag value text True  = H.option ! A.value (fromString value) ! A.selected "" $ fromString text

selectTag :: String -> Html -> Html
selectTag name =
    H.select ! A.id (fromString name)
             ! A.name (fromString name)
             ! A.required ""

selectOptionalTag :: String -> Html -> Html
selectOptionalTag name =
    H.select ! A.id (fromString name)
             ! A.name (fromString name)

  Encodes the value to Fay JSON representation or throw an error for the given name
encode :: (Data a, Show a, IsString s) => String -> a -> s
encode name value = fromString $ fromMaybe (name ++ ": error encoding value") (encodeToFay value)

selectionPart :: (Show a, Data a) =>
  String -> [Attribute] -> (a -> Bool) -> [(a, String)] -> Html
selectionPart name attrs def = foldl (!) (selectTag name) attrs . mapM_ option
  where
    option (v,t) = optionTag (encode "selection" v) t (def v)

selectionOptionalPart :: (Show a, Data a) =>
  String -> [Attribute] -> (a -> Bool) -> [(a, String)] -> Html
selectionOptionalPart name attrs def = foldl (!) (selectOptionalTag name) attrs . mapM_ option
  where
    option (v,t) = optionTag (encode "selection" v) t (def v)

-- Collapsible

-- | Creates a panel group
panelGroup =
  H.div ! A.class_ "panel-group" ! role "tablist"

-- Attributes

ariaExpanded = customAttribute "aria-expanded"

ariaControls = customAttribute "aria-controls"

ariaLabelledBy = customAttribute "aria-labelledby"

textCenter = A.class_ "text-center"

dataToggle = customAttribute "data-toggle"

dataPlacement = customAttribute "data-placement"

dataParend = customAttribute "data-parent"

formControl = class_ "form-control"

role = customAttribute "role"

areaMultiselectable = customAttribute "aria-multiselectable"

-- | Adds a tooltip to a given HTML tag
tooltip = dataToggle "tooltip"

-- | Place the tooltip on the top
tooltipAtTop = dataPlacement "top"

-- | Constants

closed    = False
collapsed = True

# LANGUAGE OverloadedStrings #
 | Represents the possible sizes of columns
 Returns the HTML class attribute value for the given column size
 | Represents the possible offsets of columns
 Returns the HTML class attribute value for the given column offset
 | Fades out the footer after the given seconds
 | Creates a warning style button, if the user clicks on the button the footer fades away.
 | Creates a danger style button, if the user clicks on the button the footer fades away
 | Creates a list group div, which can contain a various list group items
 | Creates and unordered list as a list group
 | Creates a linked list group item with a route to point at, and a text to
 display
 | Creates a linked list group item with a route to point at, and a text to
 display, renderd with the given color.
 | Creates a texted list group item
 | Creates a badge that can be displayed in the list group
 | Creates a badge with alert coloring
 | Creates a caret sign
 | Creates a justified button group
 | Creates a button group
 | Creates a button link with custom button attribute, a route to point
 a title and a text to show
 | Creates a button styled link
 | Creates a block button styled link
 | Warning button with a given text
 | Danger button with a given text
 is set to True
 | Creates a dropdown button
 | Creates a list of dropdown menu items
 | Creates a dropdown from the items with the given text on the button
 | Creates a paragrapth that represents a help block from a given text
 | Creates a form control selection with the given parameter name, a selector
 function which determines the selected value, and possible values
 | Creates a form control selection with the given parameter name, a label, a selector
 function which determines the selected value, and possible values
 | Creates a form control optional selection with the given parameter name, a label, a selector
 function which determines the selected value, and possible values
 | Creates a submit block button with a given name and the given text
 | Creates a submit small button with a given name and the given text
 | Turns the selection into combobox like selections
 | Creates a password input with the given name as id, a given label within a form-group control
 | Creates a text input field only with a default value
 | Creates an optional text input field onyl with default value
 | Creates a text input with the given name as id, a given label and a placeholder text
 | Creates an optional text input with the given name as id, a given label and a placeholder text
 | Creates an optional text input with the given name as id, a given label and a default value
 | Creates a text input with the given name as id, a given label and a default value
 | Creates a label for the given id and given text
 | Creates a labeled text as a form group element
 | Creates a text area input field with the given name as id, a given id
 | Creates an optional text area input field with the given name as id, a given id
 | Creates a text area input with the given name as id, a given label
 | Creates an optional text area input with the given name as id, a given label
 | Creates a text area input with the given name as id, a given label
 | Creates a radio button group, with a given values and labels, the parameter name
 | Creates a bootstrap row
 | Creates a bootstrap column with the given offset
 | Creates a bootstrap page header
 | Creates a bootstrap table
 Alerts
 HTML helpers
 Collapsible
 | Creates a panel group
 Attributes
 | Adds a tooltip to a given HTML tag
 | Place the tooltip on the top
 | Constants
# LANGUAGE LambdaCase #
module Bead.View.Content.Bootstrap where


 Collection of bootstrap related pagelets . 

Collection of bootstrap related pagelets.
-}

import           Control.Monad (when)

import           Data.Data
import           Data.Maybe (fromMaybe)
import           Data.Monoid
import           Data.String

import           Text.Blaze.Html5 hiding (map)
import qualified Text.Blaze.Html5 as H hiding (map)
import           Text.Blaze.Html5.Attributes
import qualified Text.Blaze.Html5.Attributes as A

import           Bead.View.Fay.JSON.ServerSide

newtype ColumnSize = ColumnSize Int
  deriving Eq

columnSize f (ColumnSize s) = f s

colSize1  = ColumnSize 1
colSize2  = ColumnSize 2
colSize3  = ColumnSize 3
colSize4  = ColumnSize 4
colSize5  = ColumnSize 5
colSize6  = ColumnSize 6
colSize7  = ColumnSize 7
colSize8  = ColumnSize 8
colSize9  = ColumnSize 9
colSize10 = ColumnSize 10
colSize11 = ColumnSize 11
colSize12 = ColumnSize 12

columnSizeClass = columnSize $ \size -> "col-md-" ++ show size

newtype ColumnOffset = ColumnOffset Int
  deriving Eq

columnOffset f (ColumnOffset s) = f s

colOffset1  = ColumnOffset 1
colOffset2  = ColumnOffset 2
colOffset3  = ColumnOffset 3
colOffset4  = ColumnOffset 4
colOffset5  = ColumnOffset 5
colOffset6  = ColumnOffset 6
colOffset7  = ColumnOffset 7
colOffset8  = ColumnOffset 8
colOffset9  = ColumnOffset 9
colOffset10 = ColumnOffset 10
colOffset11 = ColumnOffset 11
colOffset12 = ColumnOffset 12

columnOffsetClass = columnOffset $ \offset -> "col-md-offset-" ++ show offset

container = H.div ! class_ "container"

footer = H.div ! A.id "bead-footer" ! class_ "navbar navbar-default navbar-fixed-bottom"

fadeOutFooter secs = do
  H.script $ fromString $ concat ["$('#bead-footer').delay(", show (secs * 1000), ").fadeOut('slow')"]

fadeOutFooterButton custom ttl text = do
  a ! class_ (fromString ("btn " <> custom))
    ! role "button"
    ! A.title (fromString ttl)
    ! href "#"
    ! disabled ""
    $ (fromString text)

fadeOutFooterWarningButton = fadeOutFooterButton "btn-warning"

fadeOutFooterDangerButton = fadeOutFooterButton "btn-danger"

formGroup = H.div ! class_ "form-group"

inputGroup = H.div ! class_ "input-group"

listGroup = H.div ! class_ "list-group"

unorderedListGroup = H.ul ! class_ "list-group"

listGroupLinkItem route text = H.a ! href (fromString route) ! class_ "list-group-item" $ text

listGroupAlertLinkItem alert route text = H.a ! href (fromString route) ! class_ (fromString itemColor) $ text
  where
    itemColor = "list-group-item list-group-item-" ++ (alertAlgebra "success" "info" "warning" "danger" alert)

listGroupTextItem text = H.a ! href "#" ! class_ "list-group-item" $ fromString text

badge text = H.span ! class_ "badge" $ fromString text

badgeAlert alert text = H.span ! class_ (fromString $ "badge alert-" ++ a) $ fromString text where
  a = alertAlgebra "success" "info" "warning" "danger" alert


caret = H.span ! class_ "caret" $ mempty

buttonGroupJustified = H.div ! class_ "btn-group btn-group-justified"

buttonGroup = H.div ! class_ "btn-group"

customButtonLink custom ref ttl text =
  a ! class_ (fromString ("btn " <> (unwords custom)))
    ! customAttribute "role" "button"
    ! A.title (fromString ttl)
    ! href (fromString ref)
    $ (fromString text)

buttonLink ref text = customButtonLink ["btn-default"] ref "" text

blockButtonLink ref text = customButtonLink ["btn-default", "btn-block"] ref "" text

warningButtonLink ref text = customButtonLink ["btn-warning"] ref "" text

dangerButtonLink ref text = customButtonLink ["btn-danger"] ref "" text

  | Creates a date time picker using a third party library and turns on if the on switch
datetimePicker paramName date on =
  H.div ! class_ "input-group date"
        ! A.id (fromString paramName) $ do
    input ! formControl
          ! name (fromString paramName)
          ! type_ "text"
          ! readonly ""
          ! required ""
          ! value (fromString date)
    H.span ! class_ "input-group-addon" $ H.span ! class_ "glyphicon glyphicon-calendar" $ mempty
    when on $ dateTimePickerScript paramName

dateTimePickerScript pickerId = script . fromString $ concat
  [ "$(function () {"
  ,   "$('#", pickerId, "').datetimepicker({"
  ,     "format: 'YYYY-MM-DD HH:mm:ss',"
  ,     "pick12HourFormat: false,"
  ,     "pickSeconds: true"
  ,   "});"
  , "});"
  ]

dropdownButton text =
  button ! type_ "button"
         ! class_ "btn btn-default dropdown-toggle"
         ! dataAttribute "toggle" "dropdown"
         $ do (fromString text); caret

dropdownMenu items = H.ul ! class_ "dropdown-menu" ! customAttribute "role" "menu" $ mapM_ li items

dropdown text items = buttonGroup $ do
  dropdownButton text
  dropdownMenu items

helpBlock text = p ! class_ "help-block" $ fromString text

selection paramName selector values =
  formGroup $ selectionPart
    paramName
    [class_ "combobox form-control", A.style "display:none", A.required ""]
    selector
    values

selectionWithLabel paramName labelText selector values = formGroup $ do
  labelFor paramName labelText
  selectionPart
    paramName
    [class_ "combobox form-control", A.style "display:none", A.required ""]
    selector
    values

selectionOptionalWithLabel paramName labelText selector values = formGroup $ do
  labelFor paramName labelText
  selectionOptionalPart
    paramName
    [class_ "combobox form-control", A.style "display:none"]
    selector
    values


submitButton nameValue text =
  button ! type_ "submit"
         ! (name $ fromString nameValue)
         ! class_ "btn btn-block btn-default"
         $ fromString text

  | Creates a submit button with a given attrbute and a given text
submitButtonWithAttr attr text =
  button ! type_ "submit"
         ! class_ "btn btn-block btn-default"
         ! attr
         $ fromString text

smallSubmitButton nameValue text =
  button ! type_ "submit"
         ! (name $ fromString nameValue)
         ! class_ "btn btn-default"
         $ fromString text

turnSelectionsOn
  = script ! type_ "text/javascript" $ "$(document).ready(function(){$('.combobox').combobox()});"

passwordInput paramName labelText =
  formGroup $ do
    labelFor paramName labelText
    H.input ! formControl
            ! type_ "password"
            ! required ""
            ! name (fromString paramName)
            ! A.id (fromString paramName)

inputForFormControl = H.input ! formControl

textInputFieldWithDefault paramName value =
    optionalTextInputFieldWithDefault paramName value ! A.required ""

optionalTextInputFieldWithDefault paramName value =
    H.input ! formControl
            ! type_ "text"
            ! A.name (fromString paramName)
            ! A.id (fromString paramName)
            ! A.value (fromString value)

textInput paramName labelText placeholderText =
  formGroup $ do
    labelFor paramName labelText
    H.input ! formControl
            ! type_ "text"
            ! A.required ""
            ! A.name (fromString paramName)
            ! A.id (fromString paramName)
            ! A.placeholder (fromString placeholderText)

optionalTextInput paramName labelText placeholderText =
  formGroup $ do
    labelFor paramName labelText
    H.input ! formControl
            ! type_ "text"
            ! A.name (fromString paramName)
            ! A.id (fromString paramName)
            ! A.placeholder (fromString placeholderText)

optionalTextInputWithDefault paramName labelText value =
    formGroup $ do
      labelFor paramName labelText
      optionalTextInputFieldWithDefault paramName value


textInputWithDefault paramName labelText value =
  formGroup $ do
    labelFor paramName labelText
    textInputFieldWithDefault paramName value

readOnlyTextInputWithDefault paramName labelText value =
  formGroup $ do
    labelFor paramName labelText
    (textInputFieldWithDefault paramName value) ! A.readonly ""

labelFor name text =
  H.label ! for (fromString name) $ (fromString text)

labeledText name value =
  formGroup $ do
    H.label $ fromString $ name
    H.span ! formControl $ value



grayLabel :: String -> Html
grayLabel text  = H.span ! class_ "label label-default" $ fromString text

greenLabel :: String -> Html
greenLabel text = H.span ! class_ "label label-success" $ fromString text

redLabel :: String -> Html
redLabel text = H.span ! class_ "label label-danger"  $ fromString text

blueLabel :: String -> Html
blueLabel text = H.span ! class_ "label label-primary" $ fromString text

textAreaField paramName =
    H.textarea ! formControl
               ! A.required ""
               ! A.rows "20"
               ! A.id (fromString paramName)
               ! A.name (fromString paramName)

textAreaOptionalField paramName =
    H.textarea ! formControl
               ! A.rows "20"
               ! A.id (fromString paramName)
               ! A.name (fromString paramName)

textArea paramName labelText html =
  formGroup $ do
    labelFor paramName labelText
    textAreaField paramName html

optionalTextArea paramName labelText html =
  formGroup $ do
    labelFor paramName labelText
    textAreaOptionalField paramName html

utf8TextArea paramName labelText html =
  formGroup $ do
    labelFor paramName labelText
    textAreaField paramName ! A.acceptCharset "utf-8" $ html

  as numbered ids . The first value is the primary active
radioButtonGroup paramName valuesAndLabel =
  H.div ! class_ "btn-group" $
    mapM_ button ([1..] `zip` valuesAndLabel)
  where
    button (n,(c,v,l)) =
      H.label ! class_ "btn btn-default" $ do
        checked c $
          H.input ! type_ "radio"
                  ! name (fromString paramName)
                  ! A.id (fromString (paramName ++ show n))
                  ! A.value (fromString v)
        fromString l
    checked c tag = if c then (tag ! A.checked "") else tag

row = H.div ! class_ "row"

colMd size offset =
  H.div ! class_ (fromString $ concat [columnSizeClass size, " ", columnOffsetClass offset])

  | Creates a bootstrap 12 column
colMd12 = H.div ! class_ "col-md-12"

  | Creates a bootstrap 4 width column
colMd4 = H.div ! class_ "col-md-4"

  | Creates a bootstrap 6 width column
colMd6 = H.div ! class_ "col-md-6"

  | Creates a bootstrap raw with only one colMd12 column
rowColMd12 = row . colMd12

  | Creates a boostrap row with a 4 sized column in the middle of the page
rowCol4Offset4 = row . colMd colSize4 colOffset4

pageHeader = H.div ! class_ "page-header"

table = H.table ! class_ "table table-bordered table-condensed table-hover table-striped"

  Creates a table line first element is a bold text and the second is a HTML snippet
infixl 7 .|.
(.|.) :: String -> Html -> Html
name .|. value = H.tr $ do
  H.td $ b $ fromString $ name
  H.td $ value


data Alert = Success | Info | Warning | Danger
  deriving (Eq, Show)

alertAlgebra
  success
  info
  warning
  danger
  = \case
    Success -> success
    Info    -> info
    Warning -> warning
    Danger  -> danger


optionTag :: String -> String -> Bool -> Html
optionTag value text False = H.option ! A.value (fromString value)                 $ fromString text
optionTag value text True  = H.option ! A.value (fromString value) ! A.selected "" $ fromString text

selectTag :: String -> Html -> Html
selectTag name =
    H.select ! A.id (fromString name)
             ! A.name (fromString name)
             ! A.required ""

selectOptionalTag :: String -> Html -> Html
selectOptionalTag name =
    H.select ! A.id (fromString name)
             ! A.name (fromString name)

  Encodes the value to Fay JSON representation or throw an error for the given name
encode :: (Data a, Show a, IsString s) => String -> a -> s
encode name value = fromString $ fromMaybe (name ++ ": error encoding value") (encodeToFay value)

selectionPart :: (Show a, Data a) =>
  String -> [Attribute] -> (a -> Bool) -> [(a, String)] -> Html
selectionPart name attrs def = foldl (!) (selectTag name) attrs . mapM_ option
  where
    option (v,t) = optionTag (encode "selection" v) t (def v)

selectionOptionalPart :: (Show a, Data a) =>
  String -> [Attribute] -> (a -> Bool) -> [(a, String)] -> Html
selectionOptionalPart name attrs def = foldl (!) (selectOptionalTag name) attrs . mapM_ option
  where
    option (v,t) = optionTag (encode "selection" v) t (def v)


panelGroup =
  H.div ! A.class_ "panel-group" ! role "tablist"


ariaExpanded = customAttribute "aria-expanded"

ariaControls = customAttribute "aria-controls"

ariaLabelledBy = customAttribute "aria-labelledby"

textCenter = A.class_ "text-center"

dataToggle = customAttribute "data-toggle"

dataPlacement = customAttribute "data-placement"

dataParend = customAttribute "data-parent"

formControl = class_ "form-control"

role = customAttribute "role"

areaMultiselectable = customAttribute "aria-multiselectable"

tooltip = dataToggle "tooltip"

tooltipAtTop = dataPlacement "top"


closed    = False
collapsed = True
