module Text.Digestive.Bootstrap
( FormMeta (..), FormElement (..), FormElementCfg (..)
, FormSection (..), FormComponent (..)
, StdMethod (..), NumberUnit
, 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_placeholder :: !(Maybe T.Text)
, fe_cfg :: !FormElementCfg
}
data FormSection
= FormSection
{ fs_title :: !(Maybe T.Text)
, fs_help :: !(Maybe T.Text)
, fs_elements :: ![FormElement]
}
data FormComponent
= FCSection !FormSection
| FCHtmlSection !H.Html
data FormMeta
= FormMeta
{ fm_method :: StdMethod
, fm_target :: T.Text
, fm_components :: [FormComponent]
, fm_submitValue :: Html
}
renderForm :: FormMeta -> View Html -> Html
renderForm formMeta formView =
H.form ! role "form" ! method formMethod ! action formAction $
do mapM_ (renderComponent formView) (fm_components formMeta)
formSubmit (fm_submitValue formMeta)
where
formMethod = toValue (T.decodeUtf8 $ renderStdMethod (fm_method formMeta))
formAction = toValue $ fm_target formMeta
renderComponent :: View Html -> FormComponent -> Html
renderComponent formView comp =
case comp of
FCSection fs -> renderSection formView fs
FCHtmlSection bdy -> bdy
renderSection :: View Html -> FormSection -> Html
renderSection formView formSection =
H.div ! class_ "form-section" $
do case fs_title formSection of
Nothing -> mempty
Just x -> H.h3 ! class_ "form-section-title" $ toHtml x
case fs_help formSection of
Nothing -> mempty
Just x -> H.p ! class_ "form-section-help" $ toHtml x
mapM_ (renderElement formView) (fs_elements formSection)
renderElement :: View Html -> FormElement -> Html
renderElement formView formElement =
wrapper $
do case errors (fe_name formElement) formView of
[] -> mempty
errorMsgs ->
alertBox BootAlertDanger $ H.ul ! class_ "form-errors" $ mapM_ (H.li . toHtml) errorMsgs
case fe_cfg formElement of
InputCheckbox ->
H.label $
do (inputCheckbox (fe_name formElement) formView) <> " "
case fe_label formElement of
Nothing -> mempty
Just lbl -> H.toHtml lbl
_ ->
do 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_placeholder $ formElement)
if hasAddon
then H.div ! class_ "input-group" $ (ct >>= \_ -> groupAddonAfter)
else ct
where
wrapper x =
case fe_cfg formElement of
InputCheckbox -> H.div ! class_ "checkbox" $ x
_ -> formGroup x
(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