From 010ecffa1b2d67233df85ca3a2e0ab0c8349bcaf Mon Sep 17 00:00:00 2001
From: Toby Goodwin <toby@paccrat.org>
Date: Fri, 7 Mar 2014 18:28:35 +0000
Subject: [PATCH] implement multiEmailField

---
 yesod-form/Yesod/Form/Fields.hs | 24 ++++++++++++++++++++++--
 1 file changed, 22 insertions(+), 2 deletions(-)

diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs
index 97d00346..77d4ab00 100644
--- a/yesod-form/Yesod/Form/Fields.hs
+++ b/yesod-form/Yesod/Form/Fields.hs
@@ -18,6 +18,7 @@ module Yesod.Form.Fields
     , timeField
     , htmlField
     , emailField
+    , multiEmailField
     , searchField
     , AutoFocus
     , urlField
@@ -68,7 +69,7 @@ import Database.Persist.Sql (PersistField, PersistFieldSql (..))
 import Database.Persist (Entity (..), SqlType (SqlString))
 import Text.HTML.SanitizeXSS (sanitizeBalance)
 import Control.Monad (when, unless)
-import Data.Maybe (listToMaybe, fromMaybe)
+import Data.Maybe (listToMaybe, fromJust, fromMaybe, isNothing)
 
 import qualified Blaze.ByteString.Builder.Html.Utf8 as B
 import Blaze.ByteString.Builder (writeByteString, toLazyByteString)
@@ -78,7 +79,7 @@ import Database.Persist (PersistMonadBackend, PersistEntityBackend)
 import Text.Blaze.Html.Renderer.String (renderHtml)
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
-import Data.Text (Text, unpack, pack)
+import Data.Text (Text, intercalate, unpack, pack, splitOn)
 import qualified Data.Text.Read
 
 import qualified Data.Map as Map
@@ -302,6 +303,25 @@ $newline never
     , fieldEnctype = UrlEncoded
     }
 
+multiEmailField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m [Text]
+multiEmailField = Field
+    { fieldParse = parseHelper $
+        \s ->
+            let canons = map (Email.canonicalizeEmail . encodeUtf8) $
+				splitOn "," s
+	    in if any isNothing canons
+		  then Left $ MsgInvalidEmail s
+		  else Right $
+		      map (decodeUtf8With lenientDecode . fromJust) canons
+    , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
+$newline never
+<input id="#{theId}" name="#{name}" *{attrs} type="email" multiple :isReq:required="" value="#{either id cat val}">
+|]
+    , fieldEnctype = UrlEncoded
+    }
+    where
+	cat = intercalate ", "
+
 type AutoFocus = Bool
 searchField :: Monad m => RenderMessage (HandlerSite m) FormMessage => AutoFocus -> Field m Text
 searchField autoFocus = Field