]> gitweb.michael.orlitzky.com - hath.git/blobdiff - src/IPv4Address.hs
Add category: Utils to cabal file.
[hath.git] / src / IPv4Address.hs
index 6153d282a681305bdcd8a83848ebe16ed40de9ba..dac7ddaf0596e9fba46b077d4321e88149d23b88 100644 (file)
@@ -7,8 +7,10 @@ module IPv4Address
 ) where
 
 import Data.Maybe (fromJust)
-import Test.HUnit
-import Test.QuickCheck
+import Test.HUnit (assertEqual)
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.QuickCheck (Arbitrary(..), Gen)
 
 import Maskable
 import Maskbits
@@ -46,93 +48,122 @@ instance Arbitrary IPv4Address where
 
 instance Maskable IPv4Address where
 
-  apply_mask addr mask bit
-      | mask == ThirtyTwo = addr
-      | mask == ThirtyOne = addr { octet4 = (apply_mask oct4 Seven bit) }
-      | mask == Thirty = addr { octet4 = (apply_mask oct4 Six bit) }
-      | mask == TwentyNine = addr { octet4 = (apply_mask oct4 Five bit) }
-      | mask == TwentyEight = addr { octet4 = (apply_mask oct4 Four bit) }
-      | mask == TwentySeven = addr { octet4 = (apply_mask oct4 Three bit) }
-      | mask == TwentySix = addr { octet4 = (apply_mask oct4 Two bit) }
-      | mask == TwentyFive = addr { octet4 = (apply_mask oct4 One bit) }
-      | mask == TwentyFour = addr { octet4 = (apply_mask oct4 Zero bit) }
-      | mask == TwentyThree = addr { octet3 = (apply_mask oct3 Seven bit),
-                                    octet4 = (apply_mask oct4 Zero bit) }
-      | mask == TwentyTwo = addr { octet3 = (apply_mask oct3 Six bit),
-                                  octet4 = (apply_mask oct4 Zero bit) }
-      | mask == TwentyOne = addr { octet3 = (apply_mask oct3 Five bit),
-                                  octet4 = (apply_mask oct4 Zero bit) }
-      | mask == Twenty = addr { octet3 = (apply_mask oct3 Four bit),
-                               octet4 = (apply_mask oct4 Zero bit) }
-      | mask == Nineteen = addr { octet3 = (apply_mask oct3 Three bit),
-                                 octet4 = (apply_mask oct4 Zero bit) }
-      | mask == Eighteen = addr { octet3 = (apply_mask oct3 Two bit),
-                                 octet4 = (apply_mask oct4 Zero bit) }
-      | mask == Seventeen = addr { octet3 = (apply_mask oct3 One bit),
-                                  octet4 = (apply_mask oct4 Zero bit) }
-      | mask == Sixteen = addr { octet3 = (apply_mask oct3 Zero bit),
-                                octet4 = (apply_mask oct4 Zero bit) }
-      | mask == Fifteen = addr { octet2 = (apply_mask oct2 Seven bit),
-                                octet3 = (apply_mask oct3 Zero bit),
-                                octet4 = (apply_mask oct4 Zero bit) }
-      | mask == Fourteen = addr { octet2 = (apply_mask oct2 Six bit),
-                                 octet3 = (apply_mask oct3 Zero bit),
-                                 octet4 = (apply_mask oct4 Zero bit)}
-      | mask == Thirteen = addr { octet2 = (apply_mask oct2 Five bit),
-                                 octet3 = (apply_mask oct3 Zero bit),
-                                 octet4 = (apply_mask oct4 Zero bit)}
-      | mask == Twelve = addr { octet2 = (apply_mask oct2 Four bit),
-                               octet3 = (apply_mask oct3 Zero bit),
-                               octet4 = (apply_mask oct4 Zero bit)}
-      | mask == Eleven = addr { octet2 = (apply_mask oct2 Three bit),
-                               octet3 = (apply_mask oct3 Zero bit),
-                               octet4 = (apply_mask oct4 Zero bit)}
-      | mask == Ten = addr { octet2 = (apply_mask oct2 Two bit),
-                            octet3 = (apply_mask oct3 Zero bit),
-                            octet4 = (apply_mask oct4 Zero bit)}
-      | mask == Nine = addr { octet2 = (apply_mask oct2 One bit),
-                             octet3 = (apply_mask oct3 Zero bit),
-                             octet4 = (apply_mask oct4 Zero bit)}
-      | mask == Eight = addr { octet2 = (apply_mask oct2 Zero bit),
-                              octet3 = (apply_mask oct3 Zero bit),
-                              octet4 = (apply_mask oct4 Zero bit)}
-      | mask == Seven = addr { octet1 = (apply_mask oct1 Seven bit),
-                              octet2 = (apply_mask oct2 Zero bit),
-                              octet3 = (apply_mask oct3 Zero bit),
-                              octet4 = (apply_mask oct4 Zero bit)}
-      | mask == Six = addr { octet1 = (apply_mask oct1 Six bit),
-                            octet2 = (apply_mask oct2 Zero bit),
-                            octet3 = (apply_mask oct3 Zero bit),
-                            octet4 = (apply_mask oct4 Zero bit)}
-      | mask == Five = addr { octet1 = (apply_mask oct1 Five bit),
-                             octet2 = (apply_mask oct2 Zero bit),
-                             octet3 = (apply_mask oct3 Zero bit),
-                             octet4 = (apply_mask oct4 Zero bit)}
-      | mask == Four = addr { octet1 = (apply_mask oct1 Four bit),
-                             octet2 = (apply_mask oct2 Zero bit),
-                             octet3 = (apply_mask oct3 Zero bit),
-                             octet4 = (apply_mask oct4 Zero bit)}
-      | mask == Three = addr { octet1 = (apply_mask oct1 Three bit),
-                              octet2 = (apply_mask oct2 Zero bit),
-                              octet3 = (apply_mask oct3 Zero bit),
-                              octet4 = (apply_mask oct4 Zero bit)}
-      | mask == Two = addr { octet1 = (apply_mask oct1 Two bit),
-                            octet2 = (apply_mask oct2 Zero bit),
-                            octet3 = (apply_mask oct3 Zero bit),
-                            octet4 = (apply_mask oct4 Zero bit)}
-      | mask == One = addr { octet1 = (apply_mask oct1 One bit),
-                            octet2 = (apply_mask oct2 Zero bit),
-                            octet3 = (apply_mask oct3 Zero bit),
-                            octet4 = (apply_mask oct4 Zero bit)}
-      | mask == Zero = addr { octet1 = (apply_mask oct1 Zero bit),
-                             octet2 = (apply_mask oct2 Zero bit),
-                             octet3 = (apply_mask oct3 Zero bit),
-                             octet4 = (apply_mask oct4 Zero bit)}
-      where
-        oct1 = (octet1 addr)
-        oct2 = (octet2 addr)
-        oct3 = (octet3 addr)
-        oct4 = (octet4 addr)
+  apply_mask addr mask bit =
+   apply_mask' mask
+   where
+     oct1 = octet1 addr
+     oct2 = octet2 addr
+     oct3 = octet3 addr
+     oct4 = octet4 addr
+
+     -- A copy of 'addr' with the fourth octet zeroed (or oned).
+     new_addr1 = addr { octet4 = (apply_mask oct4 Zero bit) }
+
+     -- Likewise for new_addr1's third octet.
+     new_addr2 = new_addr1 { octet3 = (apply_mask oct3 Zero bit) }
+
+     -- And new_addr2's second octet.
+     new_addr3 = new_addr2 { octet2 = (apply_mask oct2 Zero bit) }
+
+     -- This helper function allows us to pattern-match cleanly.
+     apply_mask' :: Maskbits -> IPv4Address
+
+     apply_mask' ThirtyTwo = addr
+
+     apply_mask' ThirtyOne = addr { octet4 = (apply_mask oct4 Seven bit) }
+
+     apply_mask' Thirty =
+       addr { octet4 = (apply_mask oct4 Six bit) }
+
+     apply_mask' TwentyNine =
+       addr { octet4 = (apply_mask oct4 Five bit) }
+
+     apply_mask' TwentyEight =
+       addr { octet4 = (apply_mask oct4 Four bit) }
+
+     apply_mask' TwentySeven =
+       addr { octet4 = (apply_mask oct4 Three bit) }
+
+     apply_mask' TwentySix =
+       addr { octet4 = (apply_mask oct4 Two bit) }
+
+     apply_mask' TwentyFive =
+       addr { octet4 = (apply_mask oct4 One bit) }
+
+     apply_mask' TwentyFour = new_addr1
+
+     apply_mask' TwentyThree =
+       new_addr1 { octet3 = (apply_mask oct3 Seven bit) }
+
+     apply_mask' TwentyTwo =
+       new_addr1 { octet3 = (apply_mask oct3 Six bit) }
+
+     apply_mask' TwentyOne =
+       new_addr1 { octet3 = (apply_mask oct3 Five bit) }
+
+     apply_mask' Twenty =
+       new_addr1 { octet3 = (apply_mask oct3 Four bit) }
+
+     apply_mask' Nineteen =
+       new_addr1 { octet3 = (apply_mask oct3 Three bit) }
+
+     apply_mask' Eighteen =
+       new_addr1 { octet3 = (apply_mask oct3 Two bit) }
+
+     apply_mask' Seventeen =
+       new_addr1 { octet3 = (apply_mask oct3 One bit) }
+
+     apply_mask' Sixteen =
+       new_addr2
+
+     apply_mask' Fifteen =
+       new_addr2 { octet2 = (apply_mask oct2 Seven bit) }
+
+     apply_mask' Fourteen =
+       new_addr2 { octet2 = (apply_mask oct2 Six bit) }
+
+     apply_mask' Thirteen =
+       new_addr2 { octet2 = (apply_mask oct2 Five bit) }
+
+     apply_mask' Twelve =
+       new_addr2 { octet2 = (apply_mask oct2 Four bit) }
+
+     apply_mask' Eleven =
+       new_addr2 { octet2 = (apply_mask oct2 Three bit) }
+
+     apply_mask' Ten =
+       new_addr2 { octet2 = (apply_mask oct2 Two bit) }
+
+     apply_mask' Nine =
+       new_addr2 { octet2 = (apply_mask oct2 One bit) }
+
+     apply_mask' Eight =
+       new_addr3 { octet2 = (apply_mask oct2 Zero bit) }
+
+     apply_mask' Seven =
+       new_addr3 { octet1 = (apply_mask oct1 Seven bit) }
+
+     apply_mask' Six =
+       new_addr3 { octet1 = (apply_mask oct1 Six bit) }
+
+     apply_mask' Five =
+       new_addr3 { octet1 = (apply_mask oct1 Five bit) }
+
+     apply_mask' Four =
+       new_addr3 { octet1 = (apply_mask oct1 Four bit) }
+
+     apply_mask' Three =
+       new_addr3 { octet1 = (apply_mask oct1 Three bit) }
+
+     apply_mask' Two =
+       new_addr3 { octet1 = (apply_mask oct1 Two bit) }
+
+     apply_mask' One =
+       new_addr3 { octet1 = (apply_mask oct1 One bit) }
+
+     apply_mask' Zero =
+       new_addr3 { octet1 = (apply_mask oct1 Zero bit) }
+
 
 
 -- | The minimum possible IPv4 address, 0.0.0.0.
@@ -275,10 +306,11 @@ mk_testaddr a b c d =
 
 test_most_sig_bit_different1 :: Test
 test_most_sig_bit_different1 =
-  TestCase $ assertEqual "10.1.1.0 and 10.1.0.0 differ in bit 24"
+  testCase desc $ assertEqual desc
              TwentyFour
              bit
   where
+    desc = "10.1.1.0 and 10.1.0.0 differ in bit 24"
     addr1 = mk_testaddr 10 1 1 0
     addr2 = (mk_testaddr 10 1 0 0)
     bit = most_sig_bit_different addr1 addr2
@@ -287,16 +319,18 @@ test_most_sig_bit_different1 =
 
 test_most_sig_bit_different2 :: Test
 test_most_sig_bit_different2 =
-  TestCase $ assertEqual "10.1.2.0 and 10.1.1.0 differ in bit 23"
+  testCase desc $ assertEqual desc
                TwentyThree
                bit
   where
+    desc = "10.1.2.0 and 10.1.1.0 differ in bit 23"
     addr1 = mk_testaddr 10 1 2 0
     addr2 = mk_testaddr 10 1 1 0
     bit = most_sig_bit_different addr1 addr2
 
 
-ipv4address_tests :: [Test]
+ipv4address_tests :: Test
 ipv4address_tests =
-  [ test_most_sig_bit_different1,
+  testGroup "IPv4 Address Tests" [
+    test_most_sig_bit_different1,
     test_most_sig_bit_different2 ]