module Text.Digestive.Blaze.Html5
( inputText
, inputTextArea
, inputPassword
, inputHidden
, inputSelect
, inputRadio
, inputCheckbox
, inputFile
, inputSubmit
, label
, form
, errorList
, childErrorList
) where
import Control.Monad (forM_, when)
import Data.Maybe (fromMaybe)
import Data.Monoid (mappend, mempty)
import Data.Text (Text)
import Text.Blaze.Html (Html, (!))
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import qualified Text.Blaze.Internal as H
import Text.Digestive.View
(!?) :: H.Attributable h => h -> (Bool, H.Attribute) -> h
(!?) h (False, _) = h
(!?) h (True, a) = h ! a
inputText :: Text -> View v -> Html
inputText ref view = H.input
! A.type_ "text"
! A.id (H.toValue ref')
! A.name (H.toValue ref')
! A.value (H.toValue $ fieldInputText ref view)
where
ref' = absoluteRef ref view
inputTextArea :: Maybe Int
-> Maybe Int
-> Text
-> View Html
-> Html
inputTextArea r c ref view = rows r $ cols c $ H.textarea
! A.id (H.toValue ref')
! A.name (H.toValue ref')
$ H.toHtml (fieldInputText ref view)
where
ref' = absoluteRef ref view
rows (Just x) = (! A.rows (H.toValue x))
rows _ = id
cols (Just x) = (! A.cols (H.toValue x))
cols _ = id
inputPassword :: Text -> View v -> Html
inputPassword ref view = H.input
! A.type_ "password"
! A.id (H.toValue ref')
! A.name (H.toValue ref')
! A.value (H.toValue $ fieldInputText ref view)
where
ref' = absoluteRef ref view
inputHidden :: Text -> View v -> Html
inputHidden ref view = H.input
! A.type_ "hidden"
! A.id (H.toValue ref')
! A.name (H.toValue ref')
! A.value (H.toValue $ fieldInputText ref view)
where
ref' = absoluteRef ref view
inputSelect :: Text -> View Html -> Html
inputSelect ref view = H.select
! A.id (H.toValue ref')
! A.name (H.toValue ref')
$ forM_ choices $ \(i, c, sel) -> H.option
! A.value (value i)
!? (sel, A.selected "selected")
$ c
where
ref' = absoluteRef ref view
value i = H.toValue ref' `mappend` "." `mappend` H.toValue i
choices = fieldInputChoice ref view
inputRadio :: Bool
-> Text
-> View Html
-> Html
inputRadio brs ref view = forM_ choices $ \(i, c, sel) -> do
let val = value i
H.input ! A.type_ "radio" ! A.value val ! A.id val ! A.name (H.toValue ref')
!? (sel, A.checked "checked")
H.label ! A.for val $ c
when brs H.br
where
ref' = absoluteRef ref view
value i = H.toValue ref' `mappend` "." `mappend` H.toValue i
choices = fieldInputChoice ref view
inputCheckbox :: Text -> View Html -> Html
inputCheckbox ref view = H.input
! A.type_ "checkbox"
! A.id (H.toValue ref')
! A.name (H.toValue ref')
!? (selected, A.checked "checked")
where
ref' = absoluteRef ref view
selected = fieldInputBool ref view
inputFile :: Text -> View Html -> Html
inputFile ref view = H.input
! A.type_ "file"
! A.id (H.toValue ref')
! A.name (H.toValue ref')
! A.value (H.toValue value)
where
ref' = absoluteRef ref view
value = fromMaybe "" $ fieldInputFile ref view
inputSubmit :: Text -> Html
inputSubmit value = H.input
! A.type_ "submit"
! A.value (H.toValue value)
label :: Text -> View v -> Html -> Html
label ref view value = H.label
! A.for (H.toValue ref')
$ value
where
ref' = absoluteRef ref view
form :: View Html -> Text -> Html -> Html
form view action = H.form
! A.method "POST"
! A.enctype (H.toValue $ show $ viewEncType view)
! A.action (H.toValue action)
errorList :: Text -> View Html -> Html
errorList ref view = case errors ref view of
[] -> mempty
errs -> H.ul ! A.class_ "digestive-functors-error-list" $ forM_ errs $ \e ->
H.li ! A.class_ "digestive-functors-error" $ e
childErrorList :: Text -> View Html -> Html
childErrorList ref view = case childErrors ref view of
[] -> mempty
errs -> H.ul ! A.class_ "digestive-functors-error-list" $ forM_ errs $ \e ->
H.li ! A.class_ "digestive-functors-error" $ e