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

eschew fromJust, better error reporting

Browse Source
This commit is contained in:
Toby Goodwin 2014-03-09 16:20:39 +00:00
parent 1acd48079c
commit e2a6ef31ed
1 changed files with 13 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -69,8 +69,8 @@ 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.Either (partitionEithers)
import Data.Maybe (listToMaybe, fromJust, fromMaybe, isNothing) import Data.Maybe (listToMaybe, fromMaybe)
import qualified Blaze.ByteString.Builder.Html.Utf8 as B import qualified Blaze.ByteString.Builder.Html.Utf8 as B
import Blaze.ByteString.Builder (writeByteString, toLazyByteString) import Blaze.ByteString.Builder (writeByteString, toLazyByteString)
@ -80,7 +80,7 @@ import Database.Persist (PersistMonadBackend, PersistEntityBackend)
import Text.Blaze.Html.Renderer.String (renderHtml) import Text.Blaze.Html.Renderer.String (renderHtml)
import qualified Data.ByteString as S import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import Data.Text (Text, intercalate, unpack, pack, splitOn) import Data.Text as T (Text, concat, intercalate, unpack, pack, splitOn)
import qualified Data.Text.Read import qualified Data.Text.Read
import qualified Data.Map as Map import qualified Data.Map as Map
@ -308,12 +308,10 @@ multiEmailField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field
multiEmailField = Field multiEmailField = Field
{ fieldParse = parseHelper $ { fieldParse = parseHelper $
\s -> \s ->
let addrs = splitOn "," s let addrs = map validate $ splitOn "," s
canons = map (Email.canonicalizeEmail . encodeUtf8) addrs in case partitionEithers addrs of
in case findIndices isNothing canons of ([], good) -> Right good
[] -> Right $ (bad, _) -> Left $ MsgInvalidEmail $ cat bad
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}">
@ -321,7 +319,12 @@ $newline never
, fieldEnctype = UrlEncoded , fieldEnctype = UrlEncoded
} }
where where
cat = intercalate ", " -- report offending address along with error
validate a = case Email.validate $ encodeUtf8 a of
Left e -> Left $ T.concat [a, " (", pack e, ")"]
Right r -> Right $ emailToText r
cat = intercalate ", "
emailToText = decodeUtf8With lenientDecode . Email.toByteString
type AutoFocus = Bool type AutoFocus = Bool
searchField :: Monad m => RenderMessage (HandlerSite m) FormMessage => AutoFocus -> Field m Text searchField :: Monad m => RenderMessage (HandlerSite m) FormMessage => AutoFocus -> Field m Text