module Text.Blaze.Html5.Formlets
( input
, textarea
, password
, hidden
, inputInteger
, file
, checkbox
, radio
, enumRadio
, label
, selectHtml
, selectRaw
, select
, Html5Form
, Html5Formlet
, module Text.Formlets
) where
import Data.List (elemIndex)
import Text.Formlets hiding (massInput)
import Text.Blaze.Html5 ((!))
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import Data.Monoid (mconcat)
import Control.Applicative
import Control.Applicative.Error
type Html5Form m a = Form H.Html m a
type Html5Formlet m a = Formlet H.Html m a
input :: Monad m => Html5Formlet m String
input = input' $ \n v -> H.input ! A.type_ "text"
! A.name (H.stringValue n)
! A.id (H.stringValue n)
! A.value (H.stringValue v)
textarea :: Monad m => Maybe Int -> Maybe Int -> Html5Formlet m String
textarea r c = input' $ \n v -> (applyAttrs n H.textarea) (H.string v)
where
applyAttrs n = (! A.name (H.stringValue n)) . rows r . cols c
rows = maybe id $ \x -> (! A.rows (H.stringValue $ show x))
cols = maybe id $ \x -> (! A.cols (H.stringValue $ show x))
password :: Monad m => Html5Formlet m String
password = input' $ \n v -> H.input ! A.type_ "password"
! A.name (H.stringValue n)
! A.id (H.stringValue n)
! A.value (H.stringValue v)
hidden :: Monad m => Html5Formlet m String
hidden = input' $ \n v -> H.input ! A.type_ "hidden"
! A.name (H.stringValue n)
! A.id (H.stringValue n)
! A.value (H.stringValue v)
inputInteger :: Monad m => Html5Formlet m Integer
inputInteger x = input (fmap show x) `check` asInteger
file :: Monad m => Html5Form m File
file = inputFile $ \n -> H.input ! A.type_ "file"
! A.name (H.stringValue n)
! A.id (H.stringValue n)
checkbox :: Monad m => Html5Formlet m Bool
checkbox d = (optionalInput (html d)) `check` asBool
where
asBool (Just _) = Success True
asBool Nothing = Success False
html (Just True) n = H.input ! A.type_ "checkbox"
! A.name (H.stringValue n)
! A.id (H.stringValue n)
! A.value "on"
! A.checked "checked"
html _ n = H.input ! A.type_ "checkbox"
! A.name (H.stringValue n)
! A.id (H.stringValue n)
! A.value "on"
radio :: Monad m => [(String, String)] -> Html5Formlet m String
radio choices = input' $ \n v ->
mconcat $ map (makeRadio n v) $ zip choices [1 :: Integer ..]
where
makeRadio name selected ((value, label'), idx) = do
applyAttrs (radio' name value id')
H.label ! A.for (H.stringValue id')
! A.class_ "radio"
$ H.string label'
where
applyAttrs | selected == value = (! A.checked "checked")
| otherwise = id
id' = name ++ "_" ++ show idx
radio' n v i = H.input ! A.type_ "radio"
! A.name (H.stringValue n)
! A.id (H.stringValue i)
! A.class_ "radio"
! A.value (H.stringValue v)
enumRadio :: (Monad m, Enum a) => [(a, String)] -> Html5Formlet m a
enumRadio values defaultValue =
radio (map toS values) (show . fromEnum <$> defaultValue)
`check` convert `check` tryToEnum
where
toS = fmapFst (show . fromEnum)
convert v = maybeRead' v "Conversion error"
label :: Monad m => String -> Form H.Html m ()
label = xml . H.label . H.string
selectHtml :: [(String, H.Html)]
-> String
-> String
-> H.Html
selectHtml choices name selected =
H.select ! A.name (H.stringValue name)
$ mconcat $ map makeChoice choices
where
makeChoice (value, label') = applyAttrs $
H.option ! A.value (H.stringValue value) $ label'
where
applyAttrs | selected == value = (! A.selected "selected")
| otherwise = id
selectRaw :: (Monad m)
=> [(String, H.Html)]
-> Html5Formlet m String
selectRaw = input' . selectHtml
select :: (Eq a, Monad m)
=> [(a, H.Html)]
-> Html5Formlet m a
select ls v = selectRaw (map f $ zip [0 :: Integer ..] ls) selected
`check` asInt `check` convert
where
selected = show <$> (v >>= flip elemIndex (map fst ls))
f (idx, (_,l)) = (show idx, l)
convert i | i >= length ls || i < 0 = Failure ["Out of bounds"]
| otherwise = Success $ fst $ ls !! i
asInt s = maybeRead' s (s ++ " is not a valid int")