-- | Simple XHTML5 form renderer
module SimpleForm.Render.XHTML5 (render) where
import Data.Monoid
import Data.Foldable (forM_)
import Data.Text (Text)
import qualified Data.Text as T
import Text.Blaze.XHtml5 (Html, toHtml)
import qualified Text.Blaze.XHtml5 as HTML
import SimpleForm
import SimpleForm.Render
render :: Renderer
render opt@(RenderOptions {
name = n,
widgetHtml = Input whtml,
errors = errors,
options = InputOptions {
label = lbl,
disabled = d,
required = r,
wrapper_html = wattr,
label_html = lattr
}
}) =
applyAttrs (
maybeCons (not $ null errors) (T.pack "class", T.pack "error") $
maybeCons d (T.pack "class", T.pack "disabled") $
maybeCons r (T.pack "class", T.pack "required")
[]
) wattr $ HTML.label $ do
forM_ lbl $ applyAttrs [] lattr . label_value (humanize n)
whtml
hintAndError opt
render opt@(RenderOptions {
widgetHtml = SelfLabelInput whtml,
errors = errors,
options = InputOptions {
hint = hint,
disabled = d,
required = r,
wrapper_html = wattr
}
}) =
applyAttrs (
maybeCons (not $ null errors) (T.pack "class", T.pack "error") $
maybeCons d (T.pack "class", T.pack "disabled") $
maybeCons r (T.pack "class", T.pack "required")
[]
) wattr $ (if errorsOrHint then HTML.div else id) $ do
whtml
hintAndError opt
where
errorsOrHint = not (null errors && hint == mempty)
render opt@(RenderOptions {
name = n,
widgetHtml = MultiInput whtml,
errors = errors,
options = InputOptions {
label = lbl,
disabled = d,
required = r,
wrapper_html = wattr,
label_html = lattr
}
}) =
applyAttrs (
maybeCons (not $ null errors) (T.pack "class", T.pack "error") $
maybeCons d (T.pack "disabled", T.pack "disabled") $
maybeCons d (T.pack "class", T.pack "disabled") $
maybeCons r (T.pack "class", T.pack "required")
[]
) wattr $ HTML.fieldset $ do
forM_ lbl $ applyAttrs [] lattr . legend_value (humanize n)
HTML.ul $ mconcat $ map HTML.li whtml
hintAndError opt
hintAndError :: RenderOptions -> Html
hintAndError (RenderOptions {
errors = errors,
options = InputOptions {
hint = hint,
hint_html = hattr,
error_html = eattr
}
}) = do
forM_ errors $ applyAttrs [(T.pack "class", T.pack "error")] eattr . HTML.span
forM_ hint $ applyAttrs [(T.pack "class", T.pack "hint")] hattr . HTML.span . toHtml
label_value :: Text -> Label -> Html
label_value _ (Label s) = HTML.span (toHtml s) `mappend` toHtml " "
label_value _ (InlineLabel s) = toHtml s `mappend` toHtml " "
label_value d (DefaultLabel) = label_value d (Label d)
legend_value :: Text -> Label -> Html
legend_value _ (Label s) = HTML.legend $ toHtml s
legend_value d (InlineLabel s) = legend_value d (Label s)
legend_value d (DefaultLabel) = legend_value d (Label d)