X-Git-Url: http://gitweb.michael.orlitzky.com/?p=haeredes.git;a=blobdiff_plain;f=src%2FDNS.hs;fp=src%2FDNS.hs;h=497bf31894fa09fc00848f6c5dfa81db7b9622a4;hp=34a8bd18a6f17a06abc4bcaecf55169b77f38263;hb=b2a53e06f43162d4b23f7d16740d6e55275c1c1b;hpb=71c5a7f6c3a8ecb4c17f454e0e27a21538379f58

diff --git a/src/DNS.hs b/src/DNS.hs
index 34a8bd1..497bf31 100644
--- 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 ]