Bump the version and switch to tasty (from test-framework).

[haeredes.git] / src / DNS.hs

diff --git a/src/DNS.hs b/src/DNS.hs
index 34a8bd18a6f17a06abc4bcaecf55169b77f38263..497bf31894fa09fc00848f6c5dfa81db7b9622a4 100644 (file)
--- a/src/DNS.hs
+++ b/src/DNS.hs
@@ -29,10 +29,9 @@ import Network.DNS (
   lookupNSAuth,
   makeResolvSeed,
   withResolver )
-import Test.Framework (Test, testGroup)
-import Test.Framework.Providers.HUnit (testCase)
-import Test.Framework.Providers.QuickCheck2 (testProperty)
-import Test.HUnit (assertEqual)
+import Test.Tasty ( TestTree, testGroup )
+import Test.Tasty.HUnit ( (@?=), testCase )
+import Test.Tasty.QuickCheck ( testProperty )
 import Text.Read (readMaybe)
 
 type LookupResult = (Domain, Either DNSError [Domain])
@@ -129,6 +128,7 @@ normalize = normalize_case . normalize_root
 
 -- | Normalize the given name by appending a trailing dot (the DNS
 --   root) if necessary.
+--
 normalize_root :: Domain -> Domain
 normalize_root d
   | BS.null d = BS.pack "."
@@ -139,52 +139,60 @@ normalize_root d
 
 
 -- | Normalize the given name by lowercasing it.
+--
 normalize_case :: Domain -> Domain
 normalize_case = BS.map toLower
 
 
-test_normalize_case :: Test
+
+-- * Tests
+
+test_normalize_case :: TestTree
 test_normalize_case =
-  testCase desc $
-    assertEqual desc expected actual
+  testCase desc $ actual @?= expected
   where
     desc = "normalize_case lowercases DNS names"
     expected = BS.pack "example.com"
     actual = normalize_case $ BS.pack "ExAmPlE.COM"
 
-prop_normalize_case_idempotent :: String -> Bool
-prop_normalize_case_idempotent s =
-  (normalize_case . normalize_case) bs  == normalize_case bs
+prop_normalize_case_idempotent :: TestTree
+prop_normalize_case_idempotent =
+  testProperty desc $ prop
   where
-    bs = BS.pack s
+    desc = "normalize_case is idempotent"
+
+    prop :: String -> Bool
+    prop s = (normalize_case . normalize_case) bs  == normalize_case bs
+      where
+        bs = BS.pack s
 
-test_normalize_root_adds_dot :: Test
+test_normalize_root_adds_dot :: TestTree
 test_normalize_root_adds_dot =
-  testCase desc $
-    assertEqual desc expected actual
+  testCase desc $ actual @?= expected
   where
     desc = "normalize_root adds a trailing dot"
     expected = BS.pack "example.com."
     actual = normalize_root $ BS.pack "example.com"
 
-prop_normalize_root_idempotent :: String -> Bool
-prop_normalize_root_idempotent s =
-  (normalize_root . normalize_root) bs  == normalize_root bs
+prop_normalize_root_idempotent :: TestTree
+prop_normalize_root_idempotent =
+  testProperty desc prop
   where
-    bs = BS.pack s
+    desc = "normalize_root is idempotent"
+
+    prop :: String -> Bool
+    prop s = (normalize_root . normalize_root) bs  == normalize_root bs
+      where
+        bs = BS.pack s
 
-dns_tests :: Test
+dns_tests :: TestTree
 dns_tests =
   testGroup "DNS Tests" [
     test_normalize_case,
     test_normalize_root_adds_dot ]
 
-dns_properties :: Test
+dns_properties :: TestTree
 dns_properties =
   testGroup "DNS Properties" [
-    testProperty
-      "normalize_case is idempotent"
-      prop_normalize_case_idempotent,
-    testProperty
-      "normalize_root is idempotent"
-      prop_normalize_root_idempotent ]
+    prop_normalize_case_idempotent,
+    prop_normalize_root_idempotent ]