{-# LANGUAGE OverloadedStrings #-}
module Text.Digestive.Bootstrap
    ( FormMeta (..), FormElement (..), FormElementCfg (..)
    , StdMethod (..)
    , renderForm
    )
where

import Data.Maybe
import Data.Monoid
import Network.HTTP.Types.Method
import Text.Blaze.Bootstrap
import Text.Blaze.Html5
import Text.Blaze.Html5.Attributes
import Text.Digestive
import Text.Digestive.Blaze.Html5
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A

type NumberUnit = T.Text

data FormElementCfg
   = InputText
   | InputNumber (Maybe NumberUnit)
   | InputPassword
   | InputTextArea (Maybe Int) (Maybe Int)
   | InputHidden
   | InputSelect
   | InputRadio Bool
   | InputCheckbox
   | InputFile
   | InputDate

data FormElement
   = FormElement
   { fe_name :: T.Text
   , fe_label :: Maybe T.Text
   , fe_cfg :: FormElementCfg
   }

data FormMeta
   = FormMeta
   { fm_method :: StdMethod
   , fm_target :: T.Text
   , fm_elements :: [FormElement]
   , fm_submitText :: T.Text
   }

renderForm :: FormMeta -> View Html -> Html
renderForm formMeta formView =
    H.form ! role "form" ! method formMethod ! action formAction $
     do mapM_ (renderElement formView) (fm_elements formMeta)
        formSubmit (toHtml $ fm_submitText formMeta)
    where
      formMethod = toValue (T.decodeUtf8 $ renderStdMethod (fm_method formMeta))
      formAction = toValue $ fm_target formMeta

renderElement :: View Html -> FormElement -> Html
renderElement formView formElement =
    formGroup $
    do case errors (fe_name formElement) formView of
         [] -> mempty
         errorMsgs ->
             alertBox BootAlertDanger $ H.ul $ mapM_ (H.li . toHtml) errorMsgs
       case fe_label formElement of
         Just lbl ->
             H.label ! for (toValue $ fe_name formElement) $ toHtml lbl
         Nothing ->
             mempty
       let ct = buildFun (fe_name formElement) formView ! class_ "form-control" ! placeholder (toValue $ fromMaybe "" $ fe_label formElement)
       if hasAddon
       then H.div ! class_ "input-group" $ (ct >>= \_ -> groupAddonAfter)
       else ct
    where
      (hasAddon, groupAddonAfter) =
          case fe_cfg formElement of
            InputNumber (Just numberUnit) ->
                (True, H.span ! class_ "input-group-addon" $ toHtml numberUnit)
            _ ->
                (False, mempty)
      buildFun =
          case fe_cfg formElement of
            InputText -> inputText
            InputPassword -> inputPassword
            InputTextArea taRows taCols -> inputTextArea taRows taCols
            InputHidden -> inputHidden
            InputSelect -> inputSelect
            InputRadio rBr -> inputRadio rBr
            InputCheckbox -> inputCheckbox
            InputFile -> inputFile
            InputNumber _ -> inputX "number"
            InputDate -> inputX "date"

inputX :: T.Text -> T.Text -> View v -> Html
inputX x ref view =
    input
    ! type_ (toValue x)
    ! A.id    (H.toValue ref')
    ! name  (H.toValue ref')
    ! value (H.toValue $ fieldInputText ref view)
    !? (x == "number", A.step "any")
  where
    ref' = absoluteRef ref view