haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

improve error handling to report particular errs

Browse Source
This commit is contained in:
Toby Goodwin 2014-03-07 18:57:29 +00:00
parent 010ecffa1b
commit 1acd48079c
1 changed files with 7 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
yesod-form/Yesod/Form/Fields.hs
View File

@ -69,6 +69,7 @@ import Database.Persist.Sql (PersistField, PersistFieldSql (..))
import Database.Persist (Entity (..), SqlType (SqlString)) import Database.Persist (Entity (..), SqlType (SqlString))
import Text.HTML.SanitizeXSS (sanitizeBalance) import Text.HTML.SanitizeXSS (sanitizeBalance)
import Control.Monad (when, unless) import Control.Monad (when, unless)
import Data.List (findIndices)
import Data.Maybe (listToMaybe, fromJust, fromMaybe, isNothing) import Data.Maybe (listToMaybe, fromJust, fromMaybe, isNothing)
import qualified Blaze.ByteString.Builder.Html.Utf8 as B import qualified Blaze.ByteString.Builder.Html.Utf8 as B
@ -307,12 +308,12 @@ multiEmailField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field
multiEmailField = Field multiEmailField = Field
{ fieldParse = parseHelper $ { fieldParse = parseHelper $
\s -> \s ->
let canons = map (Email.canonicalizeEmail . encodeUtf8) $ let addrs = splitOn "," s
splitOn "," s canons = map (Email.canonicalizeEmail . encodeUtf8) addrs
in if any isNothing canons in case findIndices isNothing canons of
then Left $ MsgInvalidEmail s [] -> Right $
else Right $ map (decodeUtf8With lenientDecode . fromJust) canons
map (decodeUtf8With lenientDecode . fromJust) canons errs -> Left $ MsgInvalidEmail $ cat $ map (addrs !!) errs
, fieldView = \theId name attrs val isReq -> toWidget [hamlet| , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
$newline never $newline never
<input id="#{theId}" name="#{name}" *{attrs} type="email" multiple :isReq:required="" value="#{either id cat val}"> <input id="#{theId}" name="#{name}" *{attrs} type="email" multiple :isReq:required="" value="#{either id cat val}">