X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FOctet.hs;h=affce396f79a403941c9e0dda7ff9dfa19151d99;hb=2fcbd5144dae4837b26638baa170ae97f3ee1ea2;hp=574edc435a90f4f50a860b118e96ef0f75c9a32f;hpb=18a81546e7c4ad10574918efb08b2e104e911d73;p=hath.git diff --git a/src/Octet.hs b/src/Octet.hs index 574edc4..affce39 100644 --- a/src/Octet.hs +++ b/src/Octet.hs @@ -1,21 +1,22 @@ module Octet ( Octet(..), - octet_from_int, octet_properties, - octet_tests, - ) + octet_tests ) where -import Data.Maybe (fromJust) -import Test.HUnit (assertEqual) -import Test.Framework (Test, testGroup) -import Test.Framework.Providers.HUnit (testCase) -import Test.Framework.Providers.QuickCheck2 (testProperty) -import Test.QuickCheck (Arbitrary(..), Gen, Property, (==>)) +import Test.Tasty ( TestTree, testGroup ) +import Test.Tasty.HUnit ( (@?=), testCase ) +import Test.Tasty.QuickCheck ( + Arbitrary( arbitrary ), + Gen, + Property, + (==>), + testProperty ) -import Bit as B -import Maskable -import 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 = @@ -106,109 +94,126 @@ instance Bounded Octet where instance Enum Octet where - -- We're supposed to throw a runtime error if you call (succ - -- maxBound), so the fromJust here doesn't introduce any additional - -- badness. - toEnum = fromJust . octet_from_int + + -- | Create an 'Octet' from an 'Int'. The docs for Enum say we + -- should throw a runtime error on out-of-bounds, so we do. + toEnum x + | x < minBound || x > maxBound = error "octet out of bounds" + | otherwise = Octet a1 a2 a3 a4 a5 a6 a7 a8 + where + a1 = if (x >= 128) then B.One else B.Zero + a2 = if ((x `mod` 128) >= 64) then B.One else B.Zero + a3 = if ((x `mod` 64) >= 32) then B.One else B.Zero + a4 = if ((x `mod` 32) >= 16) then B.One else B.Zero + a5 = if ((x `mod` 16) >= 8) then B.One else B.Zero + a6 = if ((x `mod` 8) >= 4) then B.One else B.Zero + a7 = if ((x `mod` 4) >= 2) then B.One else B.Zero + a8 = if ((x `mod` 2) == 1) then B.One else B.Zero -- | Convert each bit to its integer value, and multiply by the -- appropriate power of two. Sum them up, and we should get an integer -- between 0 and 255. fromEnum x = - 128 * (bit_to_int (b1 x)) + - 64 * (bit_to_int (b2 x)) + - 32 * (bit_to_int (b3 x)) + - 16 * (bit_to_int (b4 x)) + - 8 * (bit_to_int (b5 x)) + - 4 * (bit_to_int (b6 x)) + - 2 * (bit_to_int (b7 x)) + - 1 * (bit_to_int (b8 x)) + 128 * (fromEnum (b1 x)) + + 64 * (fromEnum (b2 x)) + + 32 * (fromEnum (b3 x)) + + 16 * (fromEnum (b4 x)) + + 8 * (fromEnum (b5 x)) + + 4 * (fromEnum (b6 x)) + + 2 * (fromEnum (b7 x)) + + 1 * (fromEnum (b8 x)) -octet_from_int :: Int -> Maybe Octet -octet_from_int x - | (x < 0) || (x > 255) = Nothing - | otherwise = Just (Octet a1 a2 a3 a4 a5 a6 a7 a8) - where - a1 = if (x >= 128) then B.One else B.Zero - a2 = if ((x `mod` 128) >= 64) then B.One else B.Zero - a3 = if ((x `mod` 64) >= 32) then B.One else B.Zero - a4 = if ((x `mod` 32) >= 16) then B.One else B.Zero - a5 = if ((x `mod` 16) >= 8) then B.One else B.Zero - a6 = if ((x `mod` 8) >= 4) then B.One else B.Zero - a7 = if ((x `mod` 4) >= 2) then B.One else B.Zero - a8 = if ((x `mod` 2) == 1) then B.One else B.Zero - - instance Read Octet where - readsPrec _ = \s -> + readsPrec _ s = case (reads s :: [(Int, String)]) of [] -> [] - (x,leftover):_ -> case (octet_from_int x) of - Nothing -> [] - Just oct -> [(oct, leftover)] + (x,leftover):_ -> go x leftover + where + go :: Int -> String -> [(Octet, String)] + go x' leftover' + | x' < minBound || x' > maxBound = [] + | otherwise = [(toEnum x', leftover')] -- Test lists. -octet_tests :: Test +octet_tests :: TestTree octet_tests = testGroup "Octet Tests" [ - test_octet_from_int1, + test_octet_to_enum1, test_octet_mask1, test_octet_mask2 ] -octet_properties :: Test +octet_properties :: TestTree octet_properties = testGroup "Octet Properties " - [ testProperty - "fromEnum/toEnum are inverses" - prop_from_enum_to_enum_inverses, - testProperty - "read/show are inverses" - prop_read_show_inverses ] + [ prop_from_enum_to_enum_inverses, + prop_read_show_inverses, + prop_ord_instances_agree ] -- QuickCheck properties -prop_from_enum_to_enum_inverses :: Int -> Property -prop_from_enum_to_enum_inverses x = - (0 <= x) && (x <= 255) ==> - fromEnum (toEnum x :: Octet) == x - -prop_read_show_inverses :: Int -> Property -prop_read_show_inverses x = - (0 <= x) && (x <= 255) ==> x' == x +prop_from_enum_to_enum_inverses :: TestTree +prop_from_enum_to_enum_inverses = + testProperty "fromEnum and toEnum are inverses" prop + where + prop :: Int -> Property + prop x = + (0 <= x) && (x <= 255) ==> + fromEnum (toEnum x :: Octet) == x + +prop_read_show_inverses :: TestTree +prop_read_show_inverses = + testProperty "read and show are inverses" prop where - oct :: Octet - oct = read $ show x + prop :: Int -> Property + prop x = (0 <= x) && (x <= 255) ==> x' == x + where + oct :: Octet + oct = read $ show x + + 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) - x' :: Int - x' = read $ show oct + oct1 = toEnum x :: Octet + oct2 = toEnum y :: Octet + ord' = (oct1 <= oct2) -- HUnit Tests -test_octet_from_int1 :: Test -test_octet_from_int1 = - testCase desc $ assertEqual desc oct1 oct2 +test_octet_to_enum1 :: TestTree +test_octet_to_enum1 = + testCase desc $ actual @?= expected where - desc = "octet_from_int 128 should parse as 10000000" - oct1 = Octet B.One B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero - oct2 = fromJust $ octet_from_int 128 + 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 :: Octet + -test_octet_mask1 :: Test +test_octet_mask1 :: TestTree test_octet_mask1 = - testCase desc $ - assertEqual desc oct2 (apply_mask oct1 Four B.Zero) + testCase desc $ actual @?= expected where desc = "The network bits of 255/4 should equal 240" - oct1 = fromJust $ octet_from_int 255 - oct2 = fromJust $ octet_from_int 240 + expected = toEnum 240 :: Octet + actual = apply_mask (toEnum 255) Four B.Zero :: Octet -test_octet_mask2 :: Test +test_octet_mask2 :: TestTree test_octet_mask2 = - testCase desc $ - assertEqual desc oct2 (apply_mask oct1 Maskbits.One B.Zero) + testCase desc $ actual @?= expected where desc = "The network bits of 255/1 should equal 128" - oct1 = fromJust $ octet_from_int 255 - oct2 = fromJust $ octet_from_int 128 + expected = toEnum 128 :: Octet + actual = apply_mask (toEnum 255) Maskbits.One B.Zero :: Octet