E-mail validation via email-validate

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$

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}|]

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