]> gitweb.michael.orlitzky.com - hath.git/blob - src/Octet.hs
Set version to 0.1.0 instead of 0.0.6 due to "-i" flag removal.
[hath.git] / src / Octet.hs
1 module Octet (
2 Octet(..),
3 octet_properties,
4 octet_tests,
5 )
6 where
7
8 import Test.HUnit (assertEqual)
9 import Test.Framework (Test, testGroup)
10 import Test.Framework.Providers.HUnit (testCase)
11 import Test.Framework.Providers.QuickCheck2 (testProperty)
12 import Test.QuickCheck (Arbitrary(..), Gen, Property, (==>))
13
14 import Bit as B (Bit(..))
15 import Maskable (Maskable(..))
16 import Maskbits (Maskbits(..))
17
18 -- | An Octet consists of eight bits. For our purposes, the most
19 -- significant bit will come "first." That is, b1 is in the 2^7
20 -- place while b8 is in the 2^0 place.
21 data Octet =
22 Octet { b1 :: Bit,
23 b2 :: Bit,
24 b3 :: Bit,
25 b4 :: Bit,
26 b5 :: Bit,
27 b6 :: Bit,
28 b7 :: Bit,
29 b8 :: Bit }
30 deriving (Eq)
31
32
33 instance Show Octet where
34 show oct = show (fromEnum oct)
35
36
37 instance Arbitrary Octet where
38 arbitrary = do
39 a1 <- arbitrary :: Gen Bit
40 a2 <- arbitrary :: Gen Bit
41 a3 <- arbitrary :: Gen Bit
42 a4 <- arbitrary :: Gen Bit
43 a5 <- arbitrary :: Gen Bit
44 a6 <- arbitrary :: Gen Bit
45 a7 <- arbitrary :: Gen Bit
46 a8 <- arbitrary :: Gen Bit
47 return (Octet a1 a2 a3 a4 a5 a6 a7 a8)
48
49
50 instance Maskable Octet where
51 apply_mask oct Eight _ = oct
52
53 apply_mask oct Seven bit =
54 oct { b8 = bit }
55
56 apply_mask oct Six bit =
57 oct { b8 = bit, b7 = bit }
58
59 apply_mask oct Five bit =
60 oct { b8 = bit, b7 = bit, b6 = bit }
61
62 apply_mask oct Four bit =
63 oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit }
64
65 apply_mask oct Three bit =
66 oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit, b4 = bit }
67
68 apply_mask oct Two bit =
69 oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit, b4 = bit, b3 = bit }
70
71 apply_mask oct Maskbits.One bit =
72 oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit,
73 b4 = bit, b3 = bit, b2 = bit }
74
75 apply_mask oct Maskbits.Zero bit =
76 oct { b8 = bit, b7 = bit, b6 = bit, b5 = bit,
77 b4 = bit, b3 = bit, b2 = bit, b1 = bit }
78
79 -- The Maskbits must be in [Eight..ThirtyTwo].
80 apply_mask oct _ _ = oct
81
82
83 instance Ord Octet where
84 (Octet x1 x2 x3 x4 x5 x6 x7 x8) <= (Octet y1 y2 y3 y4 y5 y6 y7 y8)
85 | x1 > y1 = False
86 | x2 > y2 = False
87 | x3 > y3 = False
88 | x4 > y4 = False
89 | x5 > y5 = False
90 | x6 > y6 = False
91 | x7 > y7 = False
92 | x8 > y8 = False
93 | otherwise = True
94
95
96 instance Bounded Octet where
97 -- | The octet with the least possible value.
98 minBound =
99 Octet B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero
100
101 -- | The octet with the greatest possible value.
102 maxBound =
103 Octet B.One B.One B.One B.One B.One B.One B.One B.One
104
105
106 instance Enum Octet where
107
108 -- | Create an 'Octet' from an 'Int'. The docs for Enum say we
109 -- should throw a runtime error on out-of-bounds, so we do.
110 toEnum x
111 | x < minBound || x > maxBound = error "octet out of bounds"
112 | otherwise = Octet a1 a2 a3 a4 a5 a6 a7 a8
113 where
114 a1 = if (x >= 128) then B.One else B.Zero
115 a2 = if ((x `mod` 128) >= 64) then B.One else B.Zero
116 a3 = if ((x `mod` 64) >= 32) then B.One else B.Zero
117 a4 = if ((x `mod` 32) >= 16) then B.One else B.Zero
118 a5 = if ((x `mod` 16) >= 8) then B.One else B.Zero
119 a6 = if ((x `mod` 8) >= 4) then B.One else B.Zero
120 a7 = if ((x `mod` 4) >= 2) then B.One else B.Zero
121 a8 = if ((x `mod` 2) == 1) then B.One else B.Zero
122
123 -- | Convert each bit to its integer value, and multiply by the
124 -- appropriate power of two. Sum them up, and we should get an integer
125 -- between 0 and 255.
126 fromEnum x =
127 128 * (fromEnum (b1 x)) +
128 64 * (fromEnum (b2 x)) +
129 32 * (fromEnum (b3 x)) +
130 16 * (fromEnum (b4 x)) +
131 8 * (fromEnum (b5 x)) +
132 4 * (fromEnum (b6 x)) +
133 2 * (fromEnum (b7 x)) +
134 1 * (fromEnum (b8 x))
135
136
137
138 instance Read Octet where
139 readsPrec _ s =
140 case (reads s :: [(Int, String)]) of
141 [] -> []
142 (x,leftover):_ -> go x leftover
143 where
144 go :: Int -> String -> [(Octet, String)]
145 go x' leftover'
146 | x' < minBound || x' > maxBound = []
147 | otherwise = [(toEnum x', leftover')]
148
149
150 -- Test lists.
151 octet_tests :: Test
152 octet_tests =
153 testGroup "Octet Tests" [
154 test_octet_from_int1,
155 test_octet_mask1,
156 test_octet_mask2 ]
157
158 octet_properties :: Test
159 octet_properties =
160 testGroup
161 "Octet Properties "
162 [ testProperty
163 "fromEnum/toEnum are inverses"
164 prop_from_enum_to_enum_inverses,
165 testProperty
166 "read/show are inverses"
167 prop_read_show_inverses ]
168
169 -- QuickCheck properties
170 prop_from_enum_to_enum_inverses :: Int -> Property
171 prop_from_enum_to_enum_inverses x =
172 (0 <= x) && (x <= 255) ==>
173 fromEnum (toEnum x :: Octet) == x
174
175 prop_read_show_inverses :: Int -> Property
176 prop_read_show_inverses x =
177 (0 <= x) && (x <= 255) ==> x' == x
178 where
179 oct :: Octet
180 oct = read $ show x
181
182 x' :: Int
183 x' = read $ show oct
184
185 -- HUnit Tests
186 test_octet_from_int1 :: Test
187 test_octet_from_int1 =
188 testCase desc $ assertEqual desc oct1 oct2
189 where
190 desc = "octet_from_int 128 should parse as 10000000"
191 oct1 = Octet B.One B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero
192 oct2 = toEnum 128
193
194 test_octet_mask1 :: Test
195 test_octet_mask1 =
196 testCase desc $
197 assertEqual desc oct2 (apply_mask oct1 Four B.Zero)
198 where
199 desc = "The network bits of 255/4 should equal 240"
200 oct1 = toEnum 255
201 oct2 = toEnum 240 :: Octet
202
203
204 test_octet_mask2 :: Test
205 test_octet_mask2 =
206 testCase desc $
207 assertEqual desc oct2 (apply_mask oct1 Maskbits.One B.Zero)
208 where
209 desc = "The network bits of 255/1 should equal 128"
210 oct1 = toEnum 255
211 oct2 = toEnum 128 :: Octet