diff --git a/Yesod/Form.hs b/Yesod/Form.hs index 5a60d614..9c38e2de 100644 --- a/Yesod/Form.hs +++ b/Yesod/Form.hs @@ -44,6 +44,7 @@ module Yesod.Form , jqueryDayFieldProfile , timeFieldProfile , htmlFieldProfile + , emailFieldProfile -- * Pre-built fields , stringField , maybeStringField @@ -66,12 +67,15 @@ module Yesod.Form , boolField , jqueryAutocompleteField , maybeJqueryAutocompleteField + , emailField + , maybeEmailField -- * Pre-built inputs , stringInput , maybeStringInput , boolInput , dayInput , maybeDayInput + , emailInput -- * Template Haskell , share2 , mkToForm @@ -495,7 +499,7 @@ htmlField label tooltip = requiredFieldHelper htmlFieldProfile , fpTooltip = tooltip } -maybeHtmlField :: Html () -> Html () -> FormletField sub y (Maybe (Html ())) -- FIXME make label and tooltip Strings instead +maybeHtmlField :: Html () -> Html () -> FormletField sub y (Maybe (Html ())) maybeHtmlField label tooltip = optionalFieldHelper htmlFieldProfile { fpLabel = label , fpTooltip = tooltip @@ -658,7 +662,9 @@ maybeStringInput n = boolInput :: String -> FormInput sub master Bool boolInput n = GForm $ \env _ -> return - (FormSuccess $ isJust $ lookup n env, mempty, UrlEncoded) -- FIXME + (FormSuccess $ isJust $ lookup n env, return $ addBody [$hamlet| +%input#$n$!type=checkbox!name=$n$ +|], UrlEncoded) dayInput :: String -> FormInput sub master Day dayInput n = @@ -811,3 +817,35 @@ jqueryAutocompleteFieldProfile src = FieldProfile , fpLabel = mempty , fpTooltip = mempty } + +emailFieldProfile :: FieldProfile s y String +emailFieldProfile = FieldProfile + { fpParse = Right -- FIXME validation + , fpRender = id + , fpHamlet = \name val isReq -> [$hamlet| +%input#$name$!name=$name$!type=email!:isReq:required!value=$val$ +|] + , fpWidget = const $ return () + , fpName = Nothing + , fpLabel = mempty + , fpTooltip = mempty + } + +emailField :: Html () -> Html () -> FormletField sub y String +emailField label tooltip = requiredFieldHelper emailFieldProfile + { fpLabel = label + , fpTooltip = tooltip + } + +maybeEmailField :: Html () -> Html () -> FormletField sub y (Maybe String) +maybeEmailField label tooltip = optionalFieldHelper emailFieldProfile + { fpLabel = label + , fpTooltip = tooltip + } + +emailInput :: String -> FormInput sub master String +emailInput n = + mapFormXml fieldsToInput $ + requiredFieldHelper emailFieldProfile + { fpName = Just n + } Nothing diff --git a/Yesod/Helpers/Auth.hs b/Yesod/Helpers/Auth.hs index 80b2b84a..9a01c7b9 100644 --- a/Yesod/Helpers/Auth.hs +++ b/Yesod/Helpers/Auth.hs @@ -302,7 +302,7 @@ getEmailRegisterR = do postEmailRegisterR :: YesodAuth master => GHandler Auth master RepHtml postEmailRegisterR = do ae <- getAuthEmailSettings - email <- runFormPost' $ stringInput "email" -- FIXME checkEmail + email <- runFormPost' $ emailInput "email" y <- getYesod mecreds <- liftIO $ getEmailCreds ae email (lid, verKey) <- @@ -367,7 +367,7 @@ postEmailLoginR :: YesodAuth master => GHandler Auth master () postEmailLoginR = do ae <- getAuthEmailSettings (email, pass) <- runFormPost' $ (,) - <$> stringInput "email" -- FIXME valid e-mail? + <$> emailInput "email" <*> stringInput "password" y <- getYesod mecreds <- liftIO $ getEmailCreds ae email diff --git a/Yesod/Widget.hs b/Yesod/Widget.hs index ea8dfe58..bfbc6581 100644 --- a/Yesod/Widget.hs +++ b/Yesod/Widget.hs @@ -26,7 +26,6 @@ module Yesod.Widget , extractBody ) where --- FIXME add support for script contents import Data.List (nub) import Data.Monoid import Control.Monad.Trans.Writer