]> Git — Sourcephile - majurity.git/blob - hjugement/test/HUnit/Section.hs
protocol: add FromNatural/ToNatural
[majurity.git] / hjugement / test / HUnit / Section.hs
1 {-# LANGUAGE OverloadedLists #-}
2 {-# OPTIONS_GHC -fno-warn-orphans #-}
3 module HUnit.Section where
4 import Data.Either (Either(..))
5 import Data.Eq (Eq(..))
6 import Data.Function (($), (.))
7 import Data.Hashable (Hashable)
8 import Data.Int (Int)
9 import Data.Maybe (Maybe(..))
10 import Data.Ord (Ord(..))
11 import Data.Ratio ((%))
12 import Data.String (String)
13 import Data.Tree (Tree(..))
14 import GHC.Exts (IsList(..))
15 import Prelude (Num(..))
16 import Test.Tasty
17 import Test.Tasty.HUnit
18 import Text.Show (Show(..))
19
20 import Majority.Judgment
21 import HUnit.Utils
22 import Types
23
24 hunit :: TestTree
25 hunit = testGroup "Section"
26 [ testSection "0 judge"
27 ([]::Choices C2)
28 ([]::Judges Int SchoolGrade)
29 (node0 [])
30 (Right $ node0 [])
31 , testSection "1 judge, default grade"
32 [This]
33 [(1::Int,ToReject)]
34 (node0 [])
35 (Right $ node0 [(This, [(1,[(ToReject,1%1)])])])
36 , testSection "1 judge, default grade, 2 choices"
37 [This, That]
38 [(1::Int,ToReject)]
39 (node0 [])
40 (Right $ node0 [ (This, [(1,[(ToReject,1%1)])])
41 , (That, [(1,[(ToReject,1%1)])])
42 ])
43 , testSection "1 judge, default grade"
44 [This]
45 [(1::Int,ToReject)]
46 (node0 [(This,[(1,Section Nothing Nothing)])])
47 (Right $ node0 [(This,[(1,[(ToReject,1%1)])])])
48 , testSection "2 judges, default grade"
49 [This]
50 [(1::Int,ToReject), (2::Int,ToReject)]
51 (node0
52 [ (This, [(1,Section Nothing Nothing)])
53 ])
54 (Right $ node0
55 [ (This, [ (1,[(ToReject,1%1)])
56 , (2,[(ToReject,1%1)])
57 ])
58 ])
59 , testSection "ErrorSection_unknown_choices"
60 []
61 [(1::Int,ToReject)]
62 (node0 [(This,[])])
63 (Left $ ErrorSection_unknown_choices [This])
64 , testSection "ErrorSection_unknown_choices"
65 []
66 [(1::Int,ToReject)]
67 (node0 [(This,[(2,Section Nothing Nothing)])])
68 (Left $ ErrorSection_unknown_choices [This])
69 , testSection "ErrorSection_unknown_choices"
70 [This]
71 [(1::Int,ToReject)]
72 (node0 [ (This,[(1,Section Nothing Nothing)])
73 , (That,[(2,Section Nothing Nothing)])
74 ])
75 (Left $ ErrorSection_unknown_choices [That])
76 , testSection "ErrorSection_unknown_judges"
77 [This]
78 [(1::Int,ToReject)]
79 (node0 [(This,[(2,Section Nothing Nothing)])])
80 (Left $ ErrorSection_unknown_judges [(This,[2])])
81 , testSection "1 judge, 1 grade"
82 [This]
83 [(1::Int,ToReject)]
84 (node0 [(This,[(1,Section Nothing (Just Acceptable))])])
85 (Right $ node0 [(This,[(1,[(Acceptable,1%1)])])])
86 , testSection "1 judge, 1 grade, 2 sections"
87 [This]
88 [(1::Int,ToReject)]
89 (Node
90 [ (This, [(1,Section Nothing (Just Acceptable))]) ]
91 [ node0 [(This, [(1,Section (Just $ 1%2) Nothing)])]
92 , node0 [(This, [(1,Section (Just $ 1%2) Nothing)])]
93 ])
94 (Right $ Node
95 [ (This, [(1,[(Acceptable,1%1)])]) ]
96 [ node0 [(This, [(1,[(Acceptable,1%1)])])]
97 , node0 [(This, [(1,[(Acceptable,1%1)])])]
98 ])
99 , testSection "sectionNodeShare with judge"
100 [This]
101 [(1::Int,ToReject), (2,Insufficient)]
102 (Node
103 [(This, [(1,Section Nothing (Just Acceptable))])]
104 [ node0 $ SectionNode (Just $ 1%3) [(This, [ (1,Section (Just $ 1%2) Nothing)
105 , (2,Section Nothing Nothing)
106 ])]
107 , node0 [(This, [ (1,Section (Just $ 1%2) Nothing)
108 , (2,Section Nothing (Just Good))
109 ])]
110 ])
111 (Right $ Node
112 [ (This, [ (1,[(Acceptable,1%2 + 1%2)])
113 , (2,[(Insufficient,1%3), (Good,2%3)])
114 ]) ]
115 [ node0 [(This, [ (1,[(Acceptable,1%1)])
116 , (2,[(Insufficient,1%1)])
117 ])]
118 , node0 [(This, [ (1,[(Acceptable,1%1)])
119 , (2,[(Good,1%1)])
120 ])]
121 ])
122 , testSection "sectionNodeShare without judge"
123 [This]
124 [(1::Int,ToReject), (2,Insufficient)]
125 (Node
126 [(This, [(1,Section Nothing (Just Acceptable))])]
127 [ node0 $ SectionNode (Just $ 1%3) [(This, [ (1,Section (Just $ 1%2) Nothing) ])]
128 , node0 [(This, [ (1,Section (Just $ 1%2) Nothing)
129 , (2,Section Nothing (Just Good))
130 ])]
131 ])
132 (Right $ Node
133 [ (This, [ (1,[(Acceptable,1%2 + 1%2)])
134 , (2,[(Insufficient,1%3), (Good,2%3)])
135 ]) ]
136 [ node0 [(This, [ (1,[(Acceptable,1%1)])
137 , (2,[(Insufficient,1%1)])
138 ])]
139 , node0 [(This, [ (1,[(Acceptable,1%1)])
140 , (2,[(Good,1%1)])
141 ])]
142 ])
143 , testSection "1 judge, 2 grades, 2 sections"
144 [This]
145 [(1::Int,ToReject)]
146 (Node
147 [ (This, [(1,Section Nothing (Just Acceptable))]) ]
148 [ node0 [(This, [(1,Section (Just $ 1%2) Nothing)])]
149 , node0 [(This, [(1,Section (Just $ 1%2) (Just Good))])]
150 ])
151 (Right $ Node
152 [(This, [(1,[(Acceptable,1%2), (Good,1%2)])])]
153 [ node0 [(This, [(1,[(Acceptable,1%1)])])]
154 , node0 [(This, [(1,[(Good,1%1)])])]
155 ])
156 , testSection "1 judge, 2 grades, 2 sections (1 default)"
157 [This]
158 [(1::Int,ToReject)]
159 (Node
160 [ (This, [(1,Section Nothing (Just Acceptable))]) ]
161 [ node0 [(This, [(1,Section Nothing Nothing)])]
162 , node0 [(This, [(1,Section (Just $ 1%2) (Just Good))])]
163 ])
164 (Right $ Node
165 [(This, [(1,[(Acceptable,1%2), (Good,1%2)])])]
166 [ node0 [(This, [(1,[(Acceptable,1%1)])])]
167 , node0 [(This, [(1,[(Good,1%1)])])]
168 ])
169 , testSection "1 judge, 3 grades, 3 sections (2 default)"
170 [This]
171 [(1::Int,ToReject)]
172 (Node
173 [ (This, [(1,Section Nothing (Just Acceptable))]) ]
174 [ node0 [(This, [(1,Section Nothing Nothing)])]
175 , node0 [(This, [(1,Section (Just $ 1%2) (Just Good))])]
176 , node0 [(This, [(1,Section Nothing (Just VeryGood))])]
177 ])
178 (Right $ Node
179 [(This, [(1,[(Acceptable,1%4), (Good,1%2), (VeryGood,1%4)])])]
180 [ node0 [(This, [(1,[(Acceptable,1%1)])])]
181 , node0 [(This, [(1,[(Good,1%1)])])]
182 , node0 [(This, [(1,[(VeryGood,1%1)])])]
183 ])
184 , testSection "ErrorSection_invalid_shares sum not 1"
185 [This]
186 [(1::Int,ToReject)]
187 (Node
188 [ (This, [(1,Section Nothing (Just Acceptable))]) ]
189 [ node0 [(This, [(1,Section (Just $ 1%2) Nothing)])]
190 , node0 [(This, [(1,Section (Just $ 1%3) (Just Good))])]
191 ])
192 (Left $ ErrorSection_invalid_shares [(This, [(1,[1%2,1%3])])])
193 , testSection "ErrorSection_invalid_shares negative share"
194 [This]
195 [(1::Int,ToReject)]
196 (Node
197 [ (This, [(1,Section Nothing (Just Acceptable))]) ]
198 [ node0 [(This, [(1,Section (Just $ 1%2) Nothing)])]
199 , node0 [(This, [(1,Section (Just $ -1%2) (Just Good))])]
200 ])
201 (Left $ ErrorSection_invalid_shares [(This, [(1,[1%2,-1%2])])])
202 , testSection "2 judges, 3 grade, 3 sections (1 default)"
203 [This]
204 [(1::Int,ToReject), (2::Int,ToReject)]
205 (Node
206 [ (This, [(1,Section Nothing (Just Acceptable))])
207 ]
208 [ node0
209 [ (This, [(1,Section Nothing Nothing)])
210 ]
211 , node0
212 [ (This, [(1,Section (Just $ 1%2) (Just Good))])
213 ]
214 ])
215 (Right $ Node
216 [ (This, [ (1,[(Acceptable,1%2), (Good,1%2)])
217 , (2,[(ToReject,1%1)])
218 ])
219 ]
220 [ node0
221 [ (This, [ (1,[(Acceptable,1%1)])
222 , (2,[(ToReject,1%1)])
223 ])
224 ]
225 , node0
226 [ (This, [ (1,[(Good,1%1)])
227 , (2,[(ToReject,1%1)])
228 ])
229 ]
230 ])
231 , testSection "2 judges, 4 grades, 5 sections (2 defaults)"
232 [This]
233 [(1::Int,ToReject), (2::Int,ToReject)]
234 (Node
235 [ (This, [(1,Section Nothing (Just Acceptable))])
236 ]
237 [ node0
238 [ (This, [(1,Section Nothing Nothing)])
239 ]
240 , node0
241 [ (This, [(1,Section (Just $ 1%2) (Just Good))])
242 ]
243 , Node
244 [ (This, [(1,Section Nothing (Just Good))])
245 ]
246 [ node0
247 [ (This, [ (1,Section Nothing (Just VeryGood))
248 , (2,Section Nothing (Just Insufficient))
249 ])
250 ]
251 ]
252 ])
253 (Right $ Node
254 [ (This, [ (1,[(Acceptable,1%4), (Good,1%2), (VeryGood,1%4)])
255 , (2,[(ToReject,2%3), (Insufficient,1%3)])
256 ])
257 ]
258 [ node0
259 [ (This, [ (1,[(Acceptable,1%1)])
260 , (2,[(ToReject,1%1)])
261 ])
262 ]
263 , node0
264 [ (This, [ (1,[(Good,1%1)])
265 , (2,[(ToReject,1%1)])
266 ])
267 ]
268 , Node
269 [ (This, [ (1,[(VeryGood,1%1)])
270 , (2,[(Insufficient,1%1)])
271 ])
272 ]
273 [ node0
274 [ (This, [ (1,[(VeryGood,1%1)])
275 , (2,[(Insufficient,1%1)])
276 ])
277 ]
278 ]
279 ])
280 , testSection "1 judge, default grade, 2 choices"
281 [This, That]
282 [(1::Int,ToReject)]
283 (node0 [])
284 (Right $ node0 [ (This,[(1,[(ToReject,1%1)])])
285 , (That,[(1,[(ToReject,1%1)])])
286 ])
287 , testSection "2 judges, 2 choices"
288 [This, That]
289 [(1::Int,ToReject), (2::Int,ToReject)]
290 (Node
291 [ ]
292 [ node0
293 [ (This, [(1,Section Nothing (Just Good))])
294 , (That, [(2,Section Nothing (Just Insufficient))])
295 ]
296 , node0
297 [ (This, [(1,Section Nothing (Just Acceptable))])
298 , (That, [(2,Section Nothing (Just VeryGood))])
299 ]
300 ])
301 (Right $ Node
302 [ (This, [ (1,[(Good,1%2), (Acceptable,1%2)])
303 , (2,[(ToReject,1%1)])
304 ])
305 , (That, [ (1,[(ToReject,1%1)])
306 , (2,[(Insufficient,1%2), (VeryGood,1%2)])
307 ])
308 ]
309 [ node0 [ (This, [ (1,[(Good,1%1)])
310 , (2,[(ToReject,1%1)])
311 ])
312 , (That, [ (1,[(ToReject,1%1)])
313 , (2,[(Insufficient,1%1)])
314 ])
315 ]
316 , node0 [ (This, [ (1,[(Acceptable,1%1)])
317 , (2,[(ToReject,1%1)])
318 ])
319 , (That, [ (1,[(ToReject,1%1)])
320 , (2,[(VeryGood,1%1)])
321 ])
322 ]
323 ])
324 , testSection "1 judge, 1 choice"
325 [This]
326 [(1::Int,ToReject)]
327 (Node []
328 [ node0 [ (This, [(1,Section (Just $ 1%8) (Just Acceptable))])
329 ]
330 , node0 [ (This, [(1,Section Nothing Nothing)])
331 ]
332 ])
333 (Right $ Node
334 [ (This, [(1,[(Acceptable,1%8), (ToReject,7%8)])])
335 ]
336 [ node0 [ (This, [(1,[(Acceptable, 1%1)])])
337 ]
338 , node0 [ (This, [(1,[(ToReject, 1%1)])])
339 ]
340 ])
341 , testSection "1 judge, 1 choice (missing judge)"
342 [This]
343 [(1::Int,ToReject)]
344 (Node []
345 [ node0 [ (This, [(1,Section (Just $ 1%8) (Just Acceptable))])
346 ]
347 , node0 [ (This, [])
348 ]
349 ])
350 (Right $ Node
351 [ (This, [(1,[(Acceptable,1%8), (ToReject,7%8)])])
352 ]
353 [ node0 [ (This, [(1,[(Acceptable, 1%1)])])
354 ]
355 , node0 [ (This, [(1,[(ToReject, 1%1)])])
356 ]
357 ])
358 , testSection "1 judge, 1 choice (missing judge)"
359 [This]
360 [(1::Int,ToReject)]
361 (Node []
362 [ node0 [ (This, [])
363 ]
364 , node0 [ (This, [(1,Section (Just $ 1%8) (Just Acceptable))])
365 ]
366 ])
367 (Right $ Node
368 [ (This, [(1,[(Acceptable,1%8), (ToReject,7%8)])])
369 ]
370 [ node0 [ (This, [(1,[(ToReject, 1%1)])])
371 ]
372 , node0 [ (This, [(1,[(Acceptable, 1%1)])])
373 ]
374 ])
375 , testSection "1 judge, 1 choice (missing choice)"
376 [This]
377 [(1::Int,ToReject)]
378 (Node []
379 [ node0 [ (This, [(1,Section (Just $ 1%8) (Just Acceptable))])
380 ]
381 , node0 [
382 ]
383 ])
384 (Right $ Node
385 [ (This, [(1,[(Acceptable,1%8), (ToReject,7%8)])])
386 ]
387 [ node0 [ (This, [(1,[(Acceptable, 1%1)])])
388 ]
389 , node0 [ (This, [(1,[(ToReject, 1%1)])])
390 ]
391 ])
392 , testSection "1 judge, 1 choice (missing choice)"
393 [This]
394 [(1::Int,ToReject)]
395 (Node []
396 [ node0 [
397 ]
398 , node0 [ (This, [(1,Section (Just $ 1%8) (Just Acceptable))])
399 ]
400 ])
401 (Right $ Node
402 [ (This, [(1,[(Acceptable,1%8), (ToReject,7%8)])])
403 ]
404 [ node0 [ (This, [(1,[(ToReject, 1%1)])])
405 ]
406 , node0 [ (This, [(1,[(Acceptable, 1%1)])])
407 ]
408 ])
409 , testSection "2 judges, 2 choices"
410 [This, That]
411 [(1::Int,ToReject), (2::Int,ToReject)]
412 (node0
413 [ (This, [(1,Section Nothing (Just Acceptable))])
414 , (That, [(2,Section (Just $ 1%8) (Just VeryGood))])
415 ])
416 (Right $ node0
417 [ (This, [ (1,[(Acceptable,1%1)])
418 , (2,[(ToReject,1%1)])
419 ])
420 , (That, [ (1,[(ToReject,1%1)])
421 , (2,[(VeryGood,1%1)])
422 ])
423 ])
424 , testSection "2 judges, 2 choices"
425 [This, That]
426 [(1::Int,ToReject), (2::Int,ToReject)]
427 (Node
428 [ ]
429 [ node0
430 [ (This, [(1,Section Nothing (Just Good))])
431 , (That, [(2,Section Nothing (Just Insufficient))])
432 ]
433 , node0
434 [ (This, [(1,Section Nothing (Just Acceptable))])
435 , (That, [(2,Section (Just $ 1%8) (Just VeryGood))])
436 ]
437 ])
438 (Right $ Node
439 [ (This, [ (1,[(Good,1%2), (Acceptable,1%2)])
440 , (2,[(ToReject,1%1)])
441 ])
442 , (That, [ (1,[(ToReject,1%1)])
443 , (2,[(Insufficient,7%8), (VeryGood,1%8)])
444 ])
445 ]
446 [ node0 [ (This, [ (1,[(Good,1%1)])
447 , (2,[(ToReject,1%1)])
448 ])
449 , (That, [ (1,[(ToReject,1%1)])
450 , (2,[(Insufficient,1%1)])
451 ])
452 ]
453 , node0 [ (This, [ (1,[(Acceptable,1%1)])
454 , (2,[(ToReject,1%1)])
455 ])
456 , (That, [ (1,[(ToReject,1%1)])
457 , (2,[(VeryGood,1%1)])
458 ])
459 ]
460 ])
461 , testSection "2 judges, 2 choices"
462 [This, That]
463 [(1::Int,ToReject), (2::Int,ToReject)]
464 (Node [ (This, [(1,Section Nothing (Just Acceptable))])
465 ]
466 [ node0 [ (This, [(1,Section Nothing Nothing)])
467 ]
468 , node0 [ (This, [ (1,Section (Just $ 1%2) (Just Good)) ])
469 , (That, [ (1,Section (Just $ 1%3) Nothing)
470 , (2,Section (Just $ 1%5) (Just Insufficient))
471 ])
472 ]
473 , Node [ (This, [(1,Section Nothing (Just Good))])
474 , (That, [(2,Section Nothing (Just VeryGood))])
475 ]
476 [ node0 [ (This, [ (1,Section Nothing (Just VeryGood))
477 , (2,Section Nothing (Just Insufficient))
478 ])
479 , (That, [ (1,Section Nothing (Just Acceptable)) ])
480 ]
481 , node0 [ (This, [ (1,Section Nothing (Just Acceptable))
482 ])
483 , (That, [ (1,Section Nothing (Just VeryGood))
484 , (2,Section Nothing (Just Good))
485 ])
486 ]
487 ]
488 ])
489 (Right $
490 Node [ (This, [ (1,[(Acceptable,1%4 + 1%8), (Good,1%2), (VeryGood,1%8)])
491 , (2,[(ToReject,1%3 + 1%3 + 1%6), (Insufficient,1%6)])
492 ])
493 , (That, [ (1,[(ToReject,1%3 + 1%3), (Acceptable,1%6), (VeryGood,1%6)])
494 , (2,[(ToReject,4%10), (Insufficient,1%5), (VeryGood,4%20), (Good,4%20)])
495 ])
496 ]
497 [ node0 [ (This, [ (1,[(Acceptable,1%1)]) -- 1%4
498 , (2,[(ToReject,1%1)]) -- 1%3
499 ])
500 , (That, [ (1,[(ToReject,1%1)]) -- 1%3
501 , (2,[(ToReject,1%1)]) -- 4%10
502 ])
503 ]
504 , node0 [ (This, [ (1,[(Good,1%1)]) -- 1%2
505 , (2,[(ToReject,1%1)]) -- 1%3
506 ])
507 , (That, [ (1,[(ToReject,1%1)]) -- 1%3
508 , (2,[(Insufficient,1%1)]) -- 1%5
509 ])
510 ]
511 , Node [ (This, [ (1,[(VeryGood,1%2), (Acceptable,1%2)]) -- 1%4
512 , (2,[(Insufficient,1%2), (ToReject,1%2)]) -- 1%3
513 ])
514 , (That, [ (1,[(Acceptable,1%2), (VeryGood,1%2)]) -- 1%3
515 , (2,[(VeryGood,1%2), (Good,1%2)]) -- 4%10
516 ])
517 ]
518 [ node0 [ (This, [ (1,[(VeryGood,1%1)])
519 , (2,[(Insufficient,1%1)])
520 ])
521 , (That, [ (1,[(Acceptable,1%1)])
522 , (2,[(VeryGood,1%1)])
523 ])
524 ]
525 , node0 [ (This, [ (1,[(Acceptable,1%1)])
526 , (2,[(ToReject,1%1)])
527 ])
528 , (That, [ (1,[(VeryGood,1%1)])
529 , (2,[(Good,1%1)])
530 ])
531 ]
532 ]
533 ]
534 )
535 ]
536
537 testSection ::
538 Eq choice =>
539 Hashable choice =>
540 Eq judge =>
541 Hashable judge =>
542 Ord grade =>
543 Show choice =>
544 Show judge =>
545 Show grade =>
546 String ->
547 Choices choice ->
548 Judges judge grade ->
549 Tree (SectionNode choice judge grade) ->
550 Either (ErrorSection choice judge grade)
551 (Tree (OpinionsByChoice choice judge grade)) ->
552 TestTree
553 testSection msg cs js ss expect =
554 testCase (elide msg) $
555 opinionsBySection cs js ss @?= expect
556
557 node0 :: a -> Tree a
558 node0 = (`Node`[])
559
560 instance
561 (Eq choice, Hashable choice) =>
562 IsList (SectionNode choice judge grade) where
563 type Item (SectionNode choice judge grade) = (choice, SectionByJudge judge grade)
564 fromList = SectionNode Nothing . fromList
565 toList = GHC.Exts.toList . sectionByJudgeByChoice