email-validate 1.0.0 → 2.0.0

raw patch · 3 files changed

+55/−23 lines, 3 filesdep ~base

Dependency ranges changed: base

Files

• email-validate.cabal +20/−14
• src/Text/Email/Parser.hs +23/−7
• tests/Main.hs +12/−2

@@ -1,8 +1,8 @@ name:           email-validate
-version:        1.0.0
+version:        2.0.0
 license:        BSD3
 license-file:   LICENSE
-author:         George Pollard
+author:         George Pollard <porges@porg.es>
 maintainer:     George Pollard <porges@porg.es>
 homepage:       http://porg.es/blog/email-address-validation-simpler-faster-more-correct
 category:       Text
@@ -16,12 +16,19 @@     type: git
     location: git://github.com/Porges/email-validate-hs.git
 
+source-repository this
+    type: git
+    location: git://github.com/Porges/email-validate-hs.git
+    tag: v2.0.0
+
 library
-    build-depends: base >= 4 && < 5, attoparsec >= 0.10.0, bytestring >= 0.9
+    build-depends: base >= 4 && < 5
+                 , attoparsec >= 0.10.0
+                 , bytestring >= 0.9
     ghc-options: -O2
     hs-source-dirs: src
-    exposed-modules:
-            Text.Email.Validate, Text.Email.Parser
+    exposed-modules: Text.Email.Validate
+                   , Text.Email.Parser
 
 Test-Suite Main
     type: exitcode-stdio-1.0
@@ -29,12 +36,11 @@     hs-source-dirs: tests
     test-module Test.Text.Email.Validate
     x-uses-tf: true
-    build-depends:
-        base >= 4 && < 5,
-        HUnit >= 1.2 && < 2,
-        email-validate,
-        QuickCheck >= 2.4,
-        test-framework >= 0.4.1,
-        test-framework-quickcheck2,
-        test-framework-hunit,
-        bytestring >= 0.9+    build-depends: base >= 4 && < 5
+                 , HUnit >= 1.2 && < 2
+                 , email-validate
+                 , QuickCheck >= 2.4
+                 , test-framework >= 0.4.1
+                 , test-framework-quickcheck2
+                 , test-framework-hunit
+                 , bytestring >= 0.9

@@ -1,3 +1,6 @@+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+
 module Text.Email.Parser
 	(addrSpec
 	,localPart
@@ -15,16 +18,29 @@ import Data.Attoparsec.ByteString.Char8
 import Data.Attoparsec.Combinator
 
+import Data.Data (Data, Typeable)
+import GHC.Generics (Generic)
+import qualified Text.Read as Read
+
 -- | Represents an email address.
-data EmailAddress = EmailAddress ByteString ByteString deriving (Eq,Ord)
+data EmailAddress = EmailAddress ByteString ByteString
+	deriving (Eq, Ord, Data, Typeable, Generic)
 
 instance Show EmailAddress where
-	show = BS.unpack . toByteString
+	show = show . toByteString
 
+instance Read EmailAddress where
+	readListPrec = Read.readListPrecDefault
+	readPrec = Read.parens (do
+		bs <- Read.readPrec
+		case parseOnly addrSpec bs of
+			Left  _ -> Read.pfail
+			Right a -> return a)
+
 -- | Converts an email address back to a ByteString
 toByteString (EmailAddress l d) = BS.concat [l, BS.singleton '@', d]
 
--- | Extracts the local part of an email address. 
+-- | Extracts the local part of an email address.
 localPart :: EmailAddress -> ByteString
 localPart (EmailAddress local _) = local
 
@@ -41,13 +57,13 @@ 	return (EmailAddress localPart domainPart)
 
 local = dottedAtoms
-domain = dottedAtoms <|> domainLiteral 
+domain = dottedAtoms <|> domainLiteral
 
-dottedAtoms = BS.intercalate (BS.singleton '.') <$> 
+dottedAtoms = BS.intercalate (BS.singleton '.') <$>
 	(optional cfws *> (atom <|> quotedString) <* optional cfws)	`sepBy1` (char '.')
 atom = takeWhile1 isAtomText
 
-isAtomText x = isAlphaNum x || inClass "!#$%&'*+/=?^_`{|}~-" x 
+isAtomText x = isAlphaNum x || inClass "!#$%&'*+/=?^_`{|}~-" x
 
 domainLiteral = (BS.cons '[' . flip BS.snoc ']' . BS.concat) <$> (between (optional cfws *> char '[') (char ']' <* optional cfws) $
 	many (optional fws >> takeWhile1 isDomainText) <* optional fws)
@@ -61,7 +77,7 @@ 
 quotedPair = (BS.cons '\\' . BS.singleton) <$> (char '\\' *> (vchar <|> wsp <|> lf <|> cr <|> obsNoWsCtl <|> nullChar))
 
-cfws = ignore $ many (comment <|> fws) 
+cfws = ignore $ many (comment <|> fws)
 
 fws :: Parser ()
 fws = ignore $

@@ -18,12 +18,16 @@ 
 tests :: [TF.Test]
 tests = [
+        testGroup "EmailAddress Show/Read instances" [
+                testProperty "showLikeByteString" prop_showLikeByteString,
+                testProperty "showAndReadBack" prop_showAndReadBack
+                ],
         testGroup "QuickCheck Text.Email.Validate" [
                 testProperty "doubleCanonicalize" prop_doubleCanonicalize
                 ],
-        testGroup "Unit tests Text.Email.Validate" $ flip concatMap units 
+        testGroup "Unit tests Text.Email.Validate" $ flip concatMap units
             (\(em, valid, why) -> let email = BS.pack em
-                in 
+                in
                     [
                     testCase ("doubleCanonicalize '" ++ em ++ "'") (True @=? case emailAddress email of { Nothing -> True; Just ok -> prop_doubleCanonicalize ok }),
                     testCase ("validity test '" ++ em ++ "'") (valid @=? isValid email)
@@ -46,6 +50,12 @@ makeEmailLike l d = BS.concat [l, BS.singleton '@', d]
 
 prop_doubleCanonicalize email =  Just email == emailAddress (toByteString email)
+
+prop_showLikeByteString :: EmailAddress -> Bool
+prop_showLikeByteString email = show (toByteString email) == show email
+
+prop_showAndReadBack :: EmailAddress -> Bool
+prop_showAndReadBack email = read (show email) == email
 
 --unitTest (x, y, z) = if not (isValid (BS.pack x) == y) then "" else (x ++" became "++ (case emailAddress (BS.pack x) of {Nothing -> "fail"; Just em -> show em}) ++": Should be "++show y ++", got "++show (not y)++"\n\t"++z++"\n")