git.iko.soy/typeable/email-validate-extra
on master help sign in
Added a booking processing test (#5821)
a01766fiko
email-validate-extra.cabal+2−1
compare with master
unifiedsplit
@@ -10,10 +10,11 @@ library
10 hs-source-dirs: src
10 hs-source-dirs: src
11 default-language: Haskell2010
11 default-language: Haskell2010
12 default-extensions: QuasiQuotes
12 default-extensions: QuasiQuotes
13+ , OverloadedStrings
13 build-depends: base >=4.10 && <4.13
14 build-depends: base >=4.10 && <4.13
14 , bytestring
15 , bytestring
15 , email-validate
16 , email-validate
16 , pcre-heavy
17 , pcre-heavy
17 , text
18 , text
19+ , QuickCheck
18 exposed-modules: Text.Email.Extra
20 exposed-modules: Text.Email.Extra
19−
src/Text/Email/Extra.hs+38−10
@@ -1,19 +1,23 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2+{-# OPTIONS_GHC -Wno-orphans #-}
2module Text.Email.Extra
3module Text.Email.Extra
3 ( validateEmail
4 ( validateEmail
4 , emailToText
5 , emailToText
5 ) where
6 ) where
6
7
7−import Control.Monad ((<=<))
8+import Control.Monad ((<=<))
8−import Data.ByteString (ByteString)
9+import Data.ByteString (ByteString)
10+import qualified Data.ByteString.Char8 as BSC
9−import Data.Text (Text)
11+import Data.Text (Text)
10−import Data.Text as T (unpack)
12+import Data.Text as T (unpack)
11−import Data.Text.Encoding as T (decodeUtf8)
13+import Data.Text.Encoding as T (decodeUtf8)
14+import Test.QuickCheck
12−import Text.Email.Validate (EmailAddress)
15+import Text.Email.Validate (EmailAddress)
13−import Text.Email.Validate as Email (validate, domainPart, toByteString)
16+import Text.Email.Validate as Email
17+ (domainPart, toByteString, unsafeEmailAddress, validate)
14
18
15#ifndef ghcjs_HOST_OS
19#ifndef ghcjs_HOST_OS
16−import Text.Regex.PCRE.Heavy (re, (=~))
20+import Text.Regex.PCRE.Heavy (re, (=~))
17
21
18validateEmailDomain :: EmailAddress -> Either String EmailAddress
22validateEmailDomain :: EmailAddress -> Either String EmailAddress
19validateEmailDomain email =
23validateEmailDomain email =
@@ -21,8 +25,8 @@ validateEmailDomain email =
21 then Right email
25 then Right email
22 else Left $ errorMessage <> (T.unpack $ T.decodeUtf8 emailDomain)
26 else Left $ errorMessage <> (T.unpack $ T.decodeUtf8 emailDomain)
23 where
27 where
24− emailDomain = Email.domainPart email
28+ emailDomain = Email.domainPart email
25− domainRegex = [re|^[^.]+(?:\.[^.]+)*\.[^.]{2,}$|]
29+ domainRegex = [re|^[^.]+(?:\.[^.]+)*\.[^.]{2,}$|]
26 errorMessage = "email domain is not valid: " :: String
30 errorMessage = "email domain is not valid: " :: String
27#endif
31#endif
28
32
@@ -39,3 +43,27 @@ emailToText = T.decodeUtf8 . toByteString
39#else
43#else
40emailToText = error "emailToText: unimplemented in GHCJS"
44emailToText = error "emailToText: unimplemented in GHCJS"
41#endif
45#endif
46+
47+instance Arbitrary EmailAddress where
48+ arbitrary = do
49+ s <- listOf1 (elements $ ['a'..'z'] <> ['A'..'Z'] <> ['0'..'9'])
50+ return $ unsafeEmailAddress (BSC.pack s) "example.com"
51+ -- FIXME: write the correct instance
52+ -- arbitrary = do
53+ -- m <- elements [1..32]
54+ -- n <- elements [1..32]
55+ -- let
56+ -- localGen = do
57+ -- let
58+ -- alphabets = T.pack $ ['a'..'Z']
59+ -- digits = T.pack $ ['0'..'9']
60+ -- alphaNum = alphabets <> digits
61+ -- symbols = "-!#$%&'*+-/=?^_`{|}~."
62+ -- localSym = alphaNum <> symbols
63+ -- encodeUtf8 <$> (replicateM m (elements localSym)
64+ -- `suchThat` (isRight . parseOnly localPart))
65+ -- local <- localGen
66+ -- -- no subdomains
67+ -- domain <- replicateM n (elements ['a'..'Z'])
68+ -- domainLiteral <- elements ["com", "travel", "net", "ru", "io"]
69+ -- unsafeEmailAddress <$> local <*> domain <> "." domainLiteral