X-Git-Url: http://gitweb.michael.orlitzky.com/?p=email-validator.git;a=blobdiff_plain;f=src%2FEmailAddress.hs;h=8dca54b945695c238ff157ca95331668d2e8b992;hp=436d3f5c0e83dbd513fc0aa53f5186ab96e4e9f9;hb=34f7ff7e07e3f3a0e53225b1efeeb6275c67c674;hpb=407e2910b4ceb5f4824ffde093085eaa1fa93e7e

diff --git a/src/EmailAddress.hs b/src/EmailAddress.hs
index 436d3f5..8dca54b 100644
--- a/src/EmailAddress.hs
+++ b/src/EmailAddress.hs
@@ -1,4 +1,9 @@
-module EmailAddress
+module EmailAddress (
+  Address,
+  parts,
+  validate_syntax,
+  -- * Test exports
+  email_address_tests )
 where
 
 import qualified Data.ByteString.Char8 as BS (
@@ -7,19 +12,18 @@ import qualified Data.ByteString.Char8 as BS (
   empty,
   length,
   pack,
-  tail)
-import Text.Email.Validate (isValid)
-import Test.HUnit (assertEqual)
-import Test.Framework (Test, testGroup)
-import Test.Framework.Providers.HUnit (testCase)
+  tail )
+import Text.Email.Validate ( isValid )
+import Test.HUnit ( assertEqual )
+import Test.Tasty ( TestTree, testGroup )
+import Test.Tasty.HUnit ( (@?=), testCase )
 import Text.Regex.PCRE.Light (
   anchored,
   caseless,
   compile,
   dollar_endonly,
   match,
-  utf8
-  )
+  utf8 )
 
 type Address = BS.ByteString
 type LocalPart = BS.ByteString
@@ -28,6 +32,13 @@ type DomainPart = BS.ByteString
 
 
 -- | Split an address into local/domain parts.
+--
+--   Examples:
+--
+--   >>> let addr = BS.pack "user@example.com"
+--   >>> parts addr
+--   ("user","example.com")
+--
 parts :: Address -> (LocalPart, DomainPart)
 parts address =
   (before, after)
@@ -41,14 +52,36 @@ parts address =
 
 
 -- | Check that the lengths of the local/domain parts are within spec.
+--
+--   Examples:
+--
+--   >>> let jr = (replicate 64 'a') ++ "@" ++ (replicate 255 'x')
+--   >>> let just_right = BS.pack jr
+--   >>> validate_length just_right
+--   True
+--   >>> let too_long = BS.pack (jr ++ "x")
+--   >>> validate_length too_long
+--   False
+--
 validate_length :: Address -> Bool
 validate_length address =
   (BS.length localpart <= 64) && (BS.length domain <= 255)
   where
     (localpart, domain) = parts address
 
+
 -- | Validate an email address against a simple regex. This should
 --   catch common addresses but disallows a lot of (legal) weird stuff.
+--
+--   Examples:
+--
+--   >>> let addr = BS.pack "user@example.com"
+--   >>> validate_regex addr
+--   True
+--   >>> let bad_addr = BS.pack "user@[]example.com"
+--   >>> validate_regex bad_addr
+--   False
+--
 validate_regex :: Address -> Bool
 validate_regex address =
   case matches of
@@ -64,6 +97,7 @@ validate_regex address =
 -- | Validate the syntax of an email address by checking its length
 --   and validating it against either a simple regex or RFC5322,
 --   depending on the --rfc5322 flag.
+--
 validate_syntax :: Bool -> Address -> Bool
 validate_syntax rfc5322 address =
   (validate_length address) &&
@@ -72,7 +106,7 @@ validate_syntax rfc5322 address =
     else validate_regex address
 
 
--- HUnit tests
+-- * Tasty Tests
 good_addresses :: [Address]
 good_addresses =
   map BS.pack [
@@ -120,34 +154,31 @@ unsupported_addresses =
     "bad%char@domain.com",
     "bad^char@domain.com" ]
 
-test_good_addresses :: Test
+test_good_addresses :: TestTree
 test_good_addresses =
-  testCase desc $
-    assertEqual desc expected actual
+  testCase desc $ actual @?= expected
   where
     desc = "Good addresses are accepted."
     expected = True
     actual = all (validate_syntax False) good_addresses
 
-test_good_addresses_rfc :: Test
+test_good_addresses_rfc :: TestTree
 test_good_addresses_rfc =
-  testCase desc $
-    assertEqual desc expected actual
+  testCase desc $ actual @?= expected
   where
     desc = "Good addresses are accepted with --rfc5322."
     expected = True
     actual = all (validate_syntax True) good_addresses
 
-test_bad_addresses :: Test
+test_bad_addresses :: TestTree
 test_bad_addresses =
-  testCase desc $
-    assertEqual desc expected actual
+  testCase desc $ actual @?= expected
   where
     desc = "Bad addresses are not accepted."
     expected = True
     actual = all (not . (validate_syntax False)) bad_addresses
 
-test_bad_addresses_rfc :: Test
+test_bad_addresses_rfc :: TestTree
 test_bad_addresses_rfc =
   testCase desc $
     assertEqual desc expected actual
@@ -156,25 +187,23 @@ test_bad_addresses_rfc =
     expected = True
     actual = all (not . (validate_syntax True)) bad_addresses
 
-test_unsupported_addresses :: Test
+test_unsupported_addresses :: TestTree
 test_unsupported_addresses =
-  testCase desc $
-    assertEqual desc expected actual
+  testCase desc $ actual @?= expected
   where
     desc = "Unsupported addresses are not accepted."
     expected = True
     actual = all (not . (validate_syntax False)) unsupported_addresses
 
-test_unsupported_addresses_rfc :: Test
+test_unsupported_addresses_rfc :: TestTree
 test_unsupported_addresses_rfc =
-  testCase desc $
-    assertEqual desc expected actual
+  testCase desc $ actual @?= expected
   where
     desc = "Unsupported addresses are accepted with --rfc5322."
     expected = True
     actual = all (validate_syntax True) unsupported_addresses
 
-email_address_tests :: Test
+email_address_tests :: TestTree
 email_address_tests =
   testGroup "EmailAddress Tests" [
     test_good_addresses,