module Text.Digestive.Blaze.Html5
( BlazeFormHtml
, inputText
, inputTextArea
, inputTextRead
, inputPassword
, inputCheckBox
, inputRadio
, inputFile
, submit
, label
, errors
, childErrors
, module Text.Digestive.Forms.Html
) where
import Control.Monad (forM_, unless, when)
import Data.Maybe (fromMaybe)
import Data.Monoid (mempty)
import Text.Blaze.Html5 (Html, (!))
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import Text.Digestive.Types
import Text.Digestive.Forms (FormInput (..))
import qualified Text.Digestive.Forms as Forms
import qualified Text.Digestive.Common as Common
import Text.Digestive.Forms.Html
type BlazeFormHtml = FormHtml Html
applyClasses' :: [FormHtmlConfig -> [String]]
-> FormHtmlConfig
-> Html
-> Html
applyClasses' = applyClasses $ \element value ->
element ! A.class_ (H.stringValue value)
checked :: Bool -> Html -> Html
checked False x = x
checked True x = x ! A.checked "checked"
inputText :: (Monad m, Functor m, FormInput i f)
=> Maybe String
-> Form m i e BlazeFormHtml String
inputText = Forms.inputString $ \id' inp -> createFormHtml $ \cfg ->
applyClasses' [htmlInputClasses] cfg $
H.input ! A.type_ "text"
! A.name (H.stringValue $ show id')
! A.id (H.stringValue $ show id')
! A.value (H.stringValue $ fromMaybe "" inp)
inputTextArea :: (Monad m, Functor m, FormInput i f)
=> Maybe Int
-> Maybe Int
-> Maybe String
-> Form m i e BlazeFormHtml String
inputTextArea r c = Forms.inputString $ \id' inp -> createFormHtml $ \cfg ->
applyClasses' [htmlInputClasses] cfg $ rows r $ cols c $
H.textarea ! A.name (H.stringValue $ show id')
! A.id (H.stringValue $ show id')
$ H.string $ fromMaybe "" inp
where
rows Nothing = id
rows (Just x) = (! A.rows (H.stringValue $ show x))
cols Nothing = id
cols (Just x) = (! A.cols (H.stringValue $ show x))
inputTextRead :: (Monad m, Functor m, FormInput i f, Show a, Read a)
=> e
-> Maybe a
-> Form m i e BlazeFormHtml a
inputTextRead error' = flip Forms.inputRead error' $ \id' inp ->
createFormHtml $ \cfg -> applyClasses' [htmlInputClasses] cfg $
H.input ! A.type_ "text"
! A.name (H.stringValue $ show id')
! A.id (H.stringValue $ show id')
! A.value (H.stringValue $ fromMaybe "" inp)
inputPassword :: (Monad m, Functor m, FormInput i f)
=> Form m i e BlazeFormHtml String
inputPassword = flip Forms.inputString Nothing $ \id' inp ->
createFormHtml $ \cfg -> applyClasses' [htmlInputClasses] cfg $
H.input ! A.type_ "password"
! A.name (H.stringValue $ show id')
! A.id (H.stringValue $ show id')
! A.value (H.stringValue $ fromMaybe "" inp)
inputCheckBox :: (Monad m, Functor m, FormInput i f)
=> Bool
-> Form m i e BlazeFormHtml Bool
inputCheckBox inp = flip Forms.inputBool inp $ \id' inp' ->
createFormHtml $ \cfg -> applyClasses' [htmlInputClasses] cfg $
checked inp' $ H.input ! A.type_ "checkbox"
! A.name (H.stringValue $ show id')
! A.id (H.stringValue $ show id')
inputRadio :: (Monad m, Functor m, FormInput i f, Eq a)
=> Bool
-> a
-> [(a, Html)]
-> Form m i e BlazeFormHtml a
inputRadio br def choices = Forms.inputChoice toView def (map fst choices)
where
toView group id' sel val = createFormHtml $ \cfg -> do
applyClasses' [htmlInputClasses] cfg $ checked sel $
H.input ! A.type_ "radio"
! A.name (H.stringValue $ show group)
! A.value (H.stringValue id')
! A.id (H.stringValue id')
H.label ! A.for (H.stringValue id')
$ fromMaybe mempty $ lookup val choices
when br H.br
inputFile :: (Monad m, Functor m, FormInput i f)
=> Form m i e BlazeFormHtml (Maybe f)
inputFile = Forms.inputFile toView
where
toView id' = createFormHtmlWith MultiPart $ \cfg -> do
applyClasses' [htmlInputClasses] cfg $
H.input ! A.type_ "file"
! A.name (H.stringValue $ show id')
! A.id (H.stringValue $ show id')
submit :: Monad m
=> String
-> Form m String e BlazeFormHtml ()
submit text = view $ createFormHtml $ \cfg ->
applyClasses' [htmlInputClasses, htmlSubmitClasses] cfg $
H.input ! A.type_ "submit"
! A.value (H.stringValue text)
label :: Monad m
=> String
-> Form m i e BlazeFormHtml ()
label string = Common.label $ \id' -> createFormHtml $ \cfg ->
applyClasses' [htmlLabelClasses] cfg $
H.label ! A.for (H.stringValue $ show id')
$ H.string string
errorList :: [Html] -> BlazeFormHtml
errorList errors' = createFormHtml $ \cfg -> unless (null errors') $
applyClasses' [htmlErrorListClasses] cfg $
H.ul $ forM_ errors' $ applyClasses' [htmlErrorClasses] cfg . H.li
errors :: Monad m
=> Form m i Html BlazeFormHtml ()
errors = Common.errors errorList
childErrors :: Monad m
=> Form m i Html BlazeFormHtml ()
childErrors = Common.childErrors errorList