module Text.XHtml.Strict.Formlets ( input, textarea, password, file, checkbox
, hidden, inputInteger, radio, enumRadio
, label
, selectXHtml, selectRaw, select, enumSelect
, XHtmlForm, XHtmlFormlet
, module Text.Formlets
) where
import Text.Formlets hiding (massInput)
import qualified Text.Formlets as F
import qualified Text.XHtml.Strict as X
import Text.XHtml.Strict ((!), (+++), (<<))
import Control.Applicative
import Control.Applicative.Error
import Data.List (elemIndex)
type XHtmlForm m a = Form X.Html m a
type XHtmlFormlet m a = Formlet X.Html m a
input :: Monad m => XHtmlFormlet m String
input = input' (\n v -> X.textfield n ! [X.value v])
textarea :: Monad m => Maybe Int -> Maybe Int -> XHtmlFormlet m String
textarea r c = input' (\n v -> X.textarea (X.toHtml v) ! (attrs n))
where rows = maybe [] (\x -> [X.rows $ show x]) r
cols = maybe [] (\x -> [X.cols $ show x]) c
attrs n = [X.name n] ++ rows ++ cols
password :: Monad m => XHtmlFormlet m String
password = input' (\n v -> X.password n ! [X.value v])
hidden :: Monad m => XHtmlFormlet m String
hidden = input' X.hidden
inputInteger :: Monad m => XHtmlFormlet m Integer
inputInteger x = input (fmap show x) `check` asInteger
file :: Monad m => XHtmlForm m File
file = inputFile X.afile
checkbox :: Monad m => XHtmlFormlet m Bool
checkbox d = (optionalInput (xml d)) `check` asBool
where asBool (Just _) = Success True
asBool Nothing = Success False
xml (Just True) n = X.widget "checkbox" n [X.value "on", X.checked]
xml _ n = X.checkbox n "on"
radio :: Monad m => [(String, String)] -> XHtmlFormlet m String
radio choices = input' mkRadios
where radio n v i = X.input ! [X.thetype "radio", X.name n, X.identifier i, X.theclass "radio", X.value v]
mkRadios name selected = X.concatHtml $ map (mkRadio name selected) (zip choices [1..])
mkRadio name selected ((value, label), idx) = (radio name value ident) ! attrs
+++ X.label (X.toHtml label) ! [X.thefor ident, X.theclass "radio"]
where attrs | selected == value = [X.checked]
| otherwise = []
ident = name ++ "_" ++ show idx
enumRadio :: (Monad m, Enum a) => [(a, String)] -> XHtmlFormlet m a
enumRadio values defaultValue = radio (map toS values) (fmap (show . fromEnum) defaultValue)
`check` convert `check` tryToEnum
where toS = fmapFst (show . fromEnum)
convert v = maybeRead' v "Conversion error"
label :: (Monad m, X.HTML h) => h -> Form X.Html m ()
label = xml . X.label . X.toHtml
selectXHtml :: (X.HTML h)
=> [X.HtmlAttr]
-> [(String, h)]
-> String
-> String
-> X.Html
selectXHtml attr choices name selected = X.select ! (X.name name:attr) $ X.concatHtml $ map (mkChoice selected) choices
where mkChoice selected (value, label) = X.option ! (attrs ++ [X.value value]) << label
where attrs | selected == value = [X.selected]
| otherwise = []
selectRaw :: (Monad m, X.HTML h)
=> [X.HtmlAttr]
-> [(String, h)]
-> XHtmlFormlet m String
selectRaw attrs choices = input' $ selectXHtml attrs choices
select :: (Eq a, Monad m, X.HTML h) => [X.HtmlAttr] -> [(a, h)] -> XHtmlFormlet m a
select attrs ls v = selectRaw attrs (map f $ zip [0..] 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")
enumSelect :: (Enum a, Bounded a, Show a, Eq a, Monad m)
=> [X.HtmlAttr]
-> XHtmlFormlet m a
enumSelect attrs = select attrs (zip items (map show items)) where items = [minBound..maxBound]