diff --git a/Yesod/Form.hs b/Yesod/Form.hs index 9c38e2de..fc6b2b9c 100644 --- a/Yesod/Form.hs +++ b/Yesod/Form.hs @@ -98,6 +98,7 @@ import Data.Int (Int64) import qualified Data.ByteString.Lazy.UTF8 as U import Yesod.Widget import Control.Arrow ((&&&)) +import qualified Text.Email.Validate as Email data FormResult a = FormMissing | FormFailure [String] @@ -820,7 +821,9 @@ jqueryAutocompleteFieldProfile src = FieldProfile emailFieldProfile :: FieldProfile s y String emailFieldProfile = FieldProfile - { fpParse = Right -- FIXME validation + { fpParse = \s -> if Email.isValid s + then Right s + else Left "Invalid e-mail address" , fpRender = id , fpHamlet = \name val isReq -> [$hamlet| %input#$name$!name=$name$!type=email!:isReq:required!value=$val$ diff --git a/hellowidget.hs b/hellowidget.hs index d5d1d28a..844a66c5 100644 --- a/hellowidget.hs +++ b/hellowidget.hs @@ -35,7 +35,7 @@ getRootR = applyLayoutW $ flip wrapWidget wrapper $ do addHead [$hamlet|%meta!keywords=haskell|] handleFormR = do - (res, form, enctype) <- runFormPost $ (,,,,,,,) + (res, form, enctype) <- runFormPost $ (,,,,,,,,) <$> stringField (string "My Field") (string "Some tooltip info") Nothing <*> stringField (string "Another field") (string "") (Just "some default text") <*> intField (string "A number field") (string "some nums") (Just 5) @@ -46,8 +46,9 @@ handleFormR = do (string "Autocomplete") (string "Try it!") Nothing <*> nicHtmlField (string "HTML") (string "") (Just $ string "You can put rich text here") + <*> maybeEmailField (string "An e-mail addres") mempty Nothing let mhtml = case res of - FormSuccess (_, _, _, _, _, _, _, x) -> Just x + FormSuccess (_, _, _, _, _, _, _, x, _) -> Just x _ -> Nothing applyLayoutW $ do addStyle [$hamlet|\.tooltip{color:#666;font-style:italic}|] diff --git a/yesod.cabal b/yesod.cabal index ad7cae56..89a37385 100644 --- a/yesod.cabal +++ b/yesod.cabal @@ -43,7 +43,8 @@ library persistent >= 0.1.0 && < 0.2, neither >= 0.0.0 && < 0.1, MonadCatchIO-transformers >= 0.2.2.0 && < 0.3, - data-object >= 0.3.1 && < 0.4 + data-object >= 0.3.1 && < 0.4, + email-validate >= 0.2.5 && < 0.3 exposed-modules: Yesod Yesod.Content Yesod.Dispatch