@@ -0,0 +1,41 @@
1+{-# LANGUAGE CPP #-}
2+module Text.Email.Extra
3+ ( validateEmail
4+ , emailToText
5+ ) where
6+
7+import Control.Monad ((<=<))
8+import Data.ByteString (ByteString)
9+import Data.Text (Text)
10+import Data.Text as T (unpack)
11+import Data.Text.Encoding as T (decodeUtf8)
12+import Text.Email.Validate (EmailAddress)
13+import Text.Email.Validate as Email (validate, domainPart, toByteString)
14+
15+#ifndef ghcjs_HOST_OS
16+import Text.Regex.PCRE.Heavy (re, (=~))
17+
18+validateEmailDomain :: EmailAddress -> Either String EmailAddress
19+validateEmailDomain email =
20+ if emailDomain =~ domainRegex
21+ then Right email
22+ else Left $ errorMessage <> (T.unpack $ T.decodeUtf8 emailDomain)
23+ where
24+ emailDomain = Email.domainPart email
25+ domainRegex = [re|^[^.]+(?:\.[^.]+)*\.[^.]{2,}$|]
26+ errorMessage = "email domain is not valid: " :: String
27+#endif
28+
29+validateEmail :: ByteString -> Either String EmailAddress
30+#ifndef ghcjs_HOST_OS
31+validateEmail = validateEmailDomain <=< Email.validate
32+#else
33+validateEmail = error "validateEmail: unimplemented in GHCJS"
34+#endif
35+
36+emailToText :: EmailAddress -> Text
37+#ifndef ghcjs_HOST_OS
38+emailToText = T.decodeUtf8 . toByteString
39+#else
40+emailToText = error "emailToText: unimplemented in GHCJS"
41+#endif