hath.cabal: drop a word and a period from the synopsis

[hath.git] / src / Octet.hs

diff --git a/src/Octet.hs b/src/Octet.hs
index 4664d1964c21eefcc9aaf0fb32452ab42fd9fd0e..affce396f79a403941c9e0dda7ff9dfa19151d99 100644 (file)
--- a/src/Octet.hs
+++ b/src/Octet.hs
@@ -7,15 +7,16 @@ where
 import Test.Tasty ( TestTree, testGroup )
 import Test.Tasty.HUnit ( (@?=), testCase )
 import Test.Tasty.QuickCheck (
-  Arbitrary(..),
+  Arbitrary( arbitrary ),
   Gen,
   Property,
   (==>),
   testProperty )
 
-import Bit as B (Bit(..))
-import Maskable (Maskable(..))
-import Maskbits (Maskbits(..))
+import Bit as B( Bit( Zero, One) )
+import Maskable( Maskable( apply_mask) )
+import Maskbits(
+  Maskbits( Zero, One, Two, Three, Four, Five, Six, Seven, Eight ) )
 
 -- | An Octet consists of eight bits. For our purposes, the most
 --   significant bit will come "first." That is, b1 is in the 2^7
@@ -29,7 +30,7 @@ data Octet =
           b6 :: Bit,
           b7 :: Bit,
           b8 :: Bit }
-    deriving (Eq)
+    deriving (Eq, Ord)
 
 
 instance Show Octet where
@@ -82,19 +83,6 @@ instance Maskable Octet where
   apply_mask oct _ _ = oct
 
 
-instance Ord Octet where
-  (Octet x1 x2 x3 x4 x5 x6 x7 x8) <= (Octet y1 y2 y3 y4 y5 y6 y7 y8)
-    | x1 > y1 = False
-    | x2 > y2 = False
-    | x3 > y3 = False
-    | x4 > y4 = False
-    | x5 > y5 = False
-    | x6 > y6 = False
-    | x7 > y7 = False
-    | x8 > y8 = False
-    | otherwise = True
-
-
 instance Bounded Octet where
   -- | The octet with the least possible value.
   minBound =
@@ -153,7 +141,7 @@ instance Read Octet where
 octet_tests :: TestTree
 octet_tests =
   testGroup "Octet Tests" [
-    test_octet_from_int1,
+    test_octet_to_enum1,
     test_octet_mask1,
     test_octet_mask2 ]
 
@@ -162,7 +150,8 @@ octet_properties =
   testGroup
     "Octet Properties "
     [ prop_from_enum_to_enum_inverses,
-      prop_read_show_inverses ]
+      prop_read_show_inverses,
+      prop_ord_instances_agree ]
 
 -- QuickCheck properties
 prop_from_enum_to_enum_inverses :: TestTree
@@ -187,15 +176,29 @@ prop_read_show_inverses =
         x' :: Int
         x' = read $ show oct
 
+-- | Ensure that the Ord instance for Octets agrees with the Ord
+--   instance for Int (i.e. that numerical comparisons work).
+prop_ord_instances_agree :: TestTree
+prop_ord_instances_agree =
+  testProperty "the Octet and Int Ord instances agree" prop
+  where
+    prop :: Int -> Int -> Property
+    prop x y = (0 <= x) && (x <= 255) && (0 <= y) && (y <= 255) ==> ord == ord'
+      where
+        ord = (x <= y)
+
+        oct1 = toEnum x :: Octet
+        oct2 = toEnum y :: Octet
+        ord' = (oct1 <= oct2)
 
 -- HUnit Tests
-test_octet_from_int1 :: TestTree
-test_octet_from_int1 =
+test_octet_to_enum1 :: TestTree
+test_octet_to_enum1 =
   testCase desc $ actual @?= expected
   where
-    desc = "octet_from_int 128 should parse as 10000000"
+    desc = "toEnum 128 should parse as 10000000"
     expected = Octet B.One B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero
-    actual = toEnum 128
+    actual = toEnum 128 :: Octet
 
 
 test_octet_mask1 :: TestTree
@@ -204,7 +207,7 @@ test_octet_mask1 =
   where
     desc = "The network bits of 255/4 should equal 240"
     expected = toEnum 240 :: Octet
-    actual = apply_mask (toEnum 255) Four B.Zero
+    actual = apply_mask (toEnum 255) Four B.Zero :: Octet
 
 
 test_octet_mask2 :: TestTree
@@ -213,4 +216,4 @@ test_octet_mask2 =
   where
     desc = "The network bits of 255/1 should equal 128"
     expected = toEnum 128 :: Octet
-    actual = apply_mask (toEnum 255) Maskbits.One B.Zero
+    actual = apply_mask (toEnum 255) Maskbits.One B.Zero :: Octet