Bump the email-validate dependency.

Replace test-framework with tasty.
Add a doctest suite.
Bump to v0.0.4.

diff --git a/email-validator.cabal b/email-validator.cabal
index 20c4ff58299b8d685c422fed00dd77a48e5a3926..5f5192cd3ec909429bd01e2524d1b84f1a952cdd 100644 (file)
--- a/email-validator.cabal
+++ b/email-validator.cabal
@@ -1,5 +1,5 @@
 name:           email-validator
-version:        0.0.3
+version:        0.0.4
 cabal-version:  >= 1.8
 author:         Michael Orlitzky
 maintainer:    Michael Orlitzky <michael@orlitzky.com>
@@ -53,12 +53,12 @@ executable email-validator
     cmdargs                     == 0.10.*,
     directory                   == 1.2.*,
     dns                         == 1.*,
-    email-validate              == 1.*,
+    email-validate              == 2.*,
     HUnit                       == 1.2.*,
     parallel-io                 == 0.3.*,
     pcre-light                  >= 0.4,
-    test-framework              == 0.8.*,
-    test-framework-hunit        == 0.3.*
+    tasty                       == 0.7.*,
+    tasty-hunit                 == 0.4.*
 
   main-is:
     Main.hs
@@ -104,12 +104,13 @@ test-suite testsuite
     cmdargs                     == 0.10.*,
     directory                   == 1.2.*,
     dns                         == 1.*,
-    email-validate              == 1.*,
+    email-validate              == 2.*,
     HUnit                       == 1.2.*,
     parallel-io                 == 0.3.*,
     pcre-light                  >= 0.4,
-    test-framework              == 0.8.*,
-    test-framework-hunit        == 0.3.*
+    tasty                       == 0.7.*,
+    tasty-hunit                 == 0.4.*
+
 
   -- It's not entirely clear to me why I have to reproduce all of this.
   ghc-options:
@@ -129,6 +130,36 @@ test-suite testsuite
     -optc-march=native
     -O2
 
+
+test-suite doctests
+  type: exitcode-stdio-1.0
+  hs-source-dirs: test
+  main-is: Doctests.hs
+  build-depends:
+    base      == 4.*,
+    -- Additional test dependencies.
+    doctest   == 0.9.*
+
+  -- It's not entirely clear to me why I have to reproduce all of this.
+  ghc-options:
+    -Wall
+    -fwarn-hi-shadowing
+    -fwarn-missing-signatures
+    -fwarn-name-shadowing
+    -fwarn-orphans
+    -fwarn-type-defaults
+    -fwarn-tabs
+    -fwarn-incomplete-record-updates
+    -fwarn-monomorphism-restriction
+    -fwarn-unused-do-bind
+    -rtsopts
+    -threaded
+    -optc-O3
+    -optc-march=native
+    -O2
+
+
+
 source-repository head
   type: git
   location: http://michael.orlitzky.com/git/email-validator.git

diff --git a/src/EmailAddress.hs b/src/EmailAddress.hs
index 436d3f5c0e83dbd513fc0aa53f5186ab96e4e9f9..8dca54b945695c238ff157ca95331668d2e8b992 100644 (file)
--- 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,

diff --git a/test/Doctests.hs b/test/Doctests.hs
new file mode 100644 (file)
index 0000000..b296b90
--- /dev/null
+++ b/test/Doctests.hs
@@ -0,0 +1,8 @@
+module Main where
+
+import Test.DocTest ( doctest )
+
+main :: IO ()
+main = doctest [ "-isrc",
+                 "-idist/build/autogen",
+                 "src/Main.hs" ]

diff --git a/test/TestSuite.hs b/test/TestSuite.hs
index 7dd088001cf81e1459cf41e7965f9bb2b175612e..c93bc62139bb758f694d13b69221e4f5d463a41e 100644 (file)
--- a/test/TestSuite.hs
+++ b/test/TestSuite.hs
@@ -1,17 +1,9 @@
-{-# LANGUAGE NoMonomorphismRestriction #-}
-import Data.Monoid (mempty)
-import Test.Framework (
-  Test,
-  defaultMainWithOpts,
-  )
-import Test.Framework.Runners.Options
+import Test.Tasty ( TestTree, defaultMain, testGroup )
 
-import EmailAddress (email_address_tests)
+import EmailAddress ( email_address_tests )
 
-tests :: [Test.Framework.Test]
-tests = [ email_address_tests ]
+tests :: TestTree
+tests = testGroup "All Tests" [ email_address_tests ]
 
 main :: IO ()
-main = do
-  let empty_runner_opts = mempty :: RunnerOptions
-  defaultMainWithOpts tests empty_runner_opts
+main = defaultMain tests