module Yesod.Form.Fields
(
stringField
, textareaField
, hiddenField
, intField
, doubleField
, dayField
, timeField
, htmlField
, selectField
, boolField
, emailField
, urlField
, maybeStringField
, maybeTextareaField
, maybeHiddenField
, maybeIntField
, maybeDoubleField
, maybeDayField
, maybeTimeField
, maybeHtmlField
, maybeSelectField
, maybeEmailField
, maybeUrlField
, stringInput
, intInput
, boolInput
, dayInput
, emailInput
, urlInput
, maybeStringInput
, maybeDayInput
) where
import Yesod.Form.Core
import Yesod.Form.Profiles
import Yesod.Widget
import Data.Time (Day, TimeOfDay)
import Text.Hamlet
import Data.Monoid
import Control.Monad (join)
import Data.Maybe (fromMaybe)
stringField :: FormFieldSettings -> FormletField sub y String
stringField = requiredFieldHelper stringFieldProfile
maybeStringField :: FormFieldSettings -> FormletField sub y (Maybe String)
maybeStringField = optionalFieldHelper stringFieldProfile
intInput :: Integral i => String -> FormInput sub master i
intInput n =
mapFormXml fieldsToInput $
requiredFieldHelper intFieldProfile (nameSettings n) Nothing
intField :: Integral i => FormFieldSettings -> FormletField sub y i
intField = requiredFieldHelper intFieldProfile
maybeIntField :: Integral i => FormFieldSettings -> FormletField sub y (Maybe i)
maybeIntField = optionalFieldHelper intFieldProfile
doubleField :: FormFieldSettings -> FormletField sub y Double
doubleField = requiredFieldHelper doubleFieldProfile
maybeDoubleField :: FormFieldSettings -> FormletField sub y (Maybe Double)
maybeDoubleField = optionalFieldHelper doubleFieldProfile
dayField :: FormFieldSettings -> FormletField sub y Day
dayField = requiredFieldHelper dayFieldProfile
maybeDayField :: FormFieldSettings -> FormletField sub y (Maybe Day)
maybeDayField = optionalFieldHelper dayFieldProfile
timeField :: FormFieldSettings -> FormletField sub y TimeOfDay
timeField = requiredFieldHelper timeFieldProfile
maybeTimeField :: FormFieldSettings -> FormletField sub y (Maybe TimeOfDay)
maybeTimeField = optionalFieldHelper timeFieldProfile
boolField :: FormFieldSettings -> Maybe Bool -> FormField sub y Bool
boolField ffs orig = GForm $ do
env <- askParams
let label = ffsLabel ffs
tooltip = ffsTooltip ffs
name <- maybe newFormIdent return $ ffsName ffs
theId <- maybe newFormIdent return $ ffsId ffs
let (res, val) =
if null env
then (FormMissing, fromMaybe False orig)
else case lookup name env of
Nothing -> (FormSuccess False, False)
Just "" -> (FormSuccess False, False)
Just "false" -> (FormSuccess False, False)
Just _ -> (FormSuccess True, True)
let fi = FieldInfo
{ fiLabel = label
, fiTooltip = tooltip
, fiIdent = theId
, fiName = name
, fiInput = addBody [$hamlet|
%input#$theId$!type=checkbox!name=$name$!:val:checked
|]
, fiErrors = case res of
FormFailure [x] -> Just $ string x
_ -> Nothing
}
return (res, [fi], UrlEncoded)
htmlField :: FormFieldSettings -> FormletField sub y Html
htmlField = requiredFieldHelper htmlFieldProfile
maybeHtmlField :: FormFieldSettings -> FormletField sub y (Maybe Html)
maybeHtmlField = optionalFieldHelper htmlFieldProfile
selectField :: Eq x => [(x, String)]
-> FormFieldSettings
-> Maybe x -> FormField sub master x
selectField pairs ffs initial = GForm $ do
env <- askParams
let label = ffsLabel ffs
tooltip = ffsTooltip ffs
theId <- maybe newFormIdent return $ ffsId ffs
name <- maybe newFormIdent return $ ffsName ffs
let pairs' = zip [1 :: Int ..] pairs
let res = case lookup name env of
Nothing -> FormMissing
Just "none" -> FormFailure ["Field is required"]
Just x ->
case reads x of
(x', _):_ ->
case lookup x' pairs' of
Nothing -> FormFailure ["Invalid entry"]
Just (y, _) -> FormSuccess y
[] -> FormFailure ["Invalid entry"]
let isSelected x =
case res of
FormSuccess y -> x == y
_ -> Just x == initial
let input = [$hamlet|
%select#$theId$!name=$name$
%option!value=none
$forall pairs' pair
%option!value=$show.fst.pair$!:isSelected.fst.snd.pair:selected $snd.snd.pair$
|]
let fi = FieldInfo
{ fiLabel = label
, fiTooltip = tooltip
, fiIdent = theId
, fiName = name
, fiInput = addBody input
, fiErrors = case res of
FormFailure [x] -> Just $ string x
_ -> Nothing
}
return (res, [fi], UrlEncoded)
maybeSelectField :: Eq x => [(x, String)]
-> FormFieldSettings
-> FormletField sub master (Maybe x)
maybeSelectField pairs ffs initial' = GForm $ do
env <- askParams
let initial = join initial'
label = ffsLabel ffs
tooltip = ffsTooltip ffs
theId <- maybe newFormIdent return $ ffsId ffs
name <- maybe newFormIdent return $ ffsName ffs
let pairs' = zip [1 :: Int ..] pairs
let res = case lookup name env of
Nothing -> FormMissing
Just "none" -> FormSuccess Nothing
Just x ->
case reads x of
(x', _):_ ->
case lookup x' pairs' of
Nothing -> FormFailure ["Invalid entry"]
Just (y, _) -> FormSuccess $ Just y
[] -> FormFailure ["Invalid entry"]
let isSelected x =
case res of
FormSuccess y -> Just x == y
_ -> Just x == initial
let input = [$hamlet|
%select#$theId$!name=$name$
%option!value=none
$forall pairs' pair
%option!value=$show.fst.pair$!:isSelected.fst.snd.pair:selected $snd.snd.pair$
|]
let fi = FieldInfo
{ fiLabel = label
, fiTooltip = tooltip
, fiIdent = theId
, fiName = name
, fiInput = addBody input
, fiErrors = case res of
FormFailure [x] -> Just $ string x
_ -> Nothing
}
return (res, [fi], UrlEncoded)
stringInput :: String -> FormInput sub master String
stringInput n =
mapFormXml fieldsToInput $
requiredFieldHelper stringFieldProfile (nameSettings n) Nothing
maybeStringInput :: String -> FormInput sub master (Maybe String)
maybeStringInput n =
mapFormXml fieldsToInput $
optionalFieldHelper stringFieldProfile (nameSettings n) Nothing
boolInput :: String -> FormInput sub master Bool
boolInput n = GForm $ do
env <- askParams
let res = case lookup n env of
Nothing -> FormSuccess False
Just "" -> FormSuccess False
Just "false" -> FormSuccess False
Just _ -> FormSuccess True
let xml = addBody [$hamlet|
%input#$n$!type=checkbox!name=$n$
|]
return (res, [xml], UrlEncoded)
dayInput :: String -> FormInput sub master Day
dayInput n =
mapFormXml fieldsToInput $
requiredFieldHelper dayFieldProfile (nameSettings n) Nothing
maybeDayInput :: String -> FormInput sub master (Maybe Day)
maybeDayInput n =
mapFormXml fieldsToInput $
optionalFieldHelper dayFieldProfile (nameSettings n) Nothing
nameSettings :: String -> FormFieldSettings
nameSettings n = FormFieldSettings mempty mempty (Just n) (Just n)
urlField :: FormFieldSettings -> FormletField sub y String
urlField = requiredFieldHelper urlFieldProfile
maybeUrlField :: FormFieldSettings -> FormletField sub y (Maybe String)
maybeUrlField = optionalFieldHelper urlFieldProfile
urlInput :: String -> FormInput sub master String
urlInput n =
mapFormXml fieldsToInput $
requiredFieldHelper urlFieldProfile (nameSettings n) Nothing
emailField :: FormFieldSettings -> FormletField sub y String
emailField = requiredFieldHelper emailFieldProfile
maybeEmailField :: FormFieldSettings -> FormletField sub y (Maybe String)
maybeEmailField = optionalFieldHelper emailFieldProfile
emailInput :: String -> FormInput sub master String
emailInput n =
mapFormXml fieldsToInput $
requiredFieldHelper emailFieldProfile (nameSettings n) Nothing
textareaField :: FormFieldSettings -> FormletField sub y Textarea
textareaField = requiredFieldHelper textareaFieldProfile
maybeTextareaField :: FormFieldSettings -> FormletField sub y (Maybe Textarea)
maybeTextareaField = optionalFieldHelper textareaFieldProfile
hiddenField :: FormFieldSettings -> FormletField sub y String
hiddenField = requiredFieldHelper hiddenFieldProfile
maybeHiddenField :: FormFieldSettings -> FormletField sub y (Maybe String)
maybeHiddenField = optionalFieldHelper hiddenFieldProfile