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