test/HUnit.hs

   1 {-# LANGUAGE OverloadedLists #-}
   2 {-# OPTIONS_GHC -fno-warn-orphans #-}
   3 module HUnit where
   4
   5 import Test.Tasty
   6 import Test.Tasty.HUnit
   7
   8 import Control.Arrow (second)
   9 import Data.Hashable (Hashable)
  10 import qualified Data.HashMap.Strict as HM
  11
  12 import Hjugement
  13 import Types
  14
  15 hunits :: TestTree
  16 hunits =
  17         testGroup "HUnit"
  18          [ testGroup "MajorityValue" $
  19                  [ testCompareValue
  20                          [(3,15), (2,7), (1,3), (0::Int,2)]
  21                          [(3,16), (2,6), (1,2), (0,3)]
  22                  , testGroup "OfMerits"
  23                          [  let m = mkMerit ['A'..'F'] in
  24                                 testMajorityValueOfMerits
  25                                  [ (The, m [136,307,251,148,84,74])
  26                                  ]
  27                                  [ (The, [('C',251),('B',307),('D',148),('E',84),('A',136),('F',74)])
  28                                  ]
  29                          , let m = mkMerit [ToReject .. TooGood] in
  30                                 testMajorityValueOfMerits
  31                                  [ (This, m [12,10,21,5,5,5,2])
  32                                  , (That, m [12,16,22,3,3,3,1])
  33                                  ]
  34                                  [ (This, [(Acceptable,21),(Insufficient,10),(Good,5),(ToReject,12),(Perfect,5),(VeryGood,5),(TooGood,2)])
  35                                  , (That, [(Acceptable,22),(Insufficient,16),(ToReject,12),(VeryGood,3),(Perfect,3),(Good,3),(TooGood,1)])
  36                                  ]
  37                          ]
  38                  , testGroup "OfOpinions"
  39                          [ testMajorityValueOfOpinions [No,Yes]
  40                                  [ (The, [No,No,No,No,Yes,Yes]) ]
  41                                  [ (The, [(No,4),(Yes,2)]) ]
  42                          , testMajorityValueOfOpinions [No,Yes]
  43                                  [ (The, [No,No,No,Yes,Yes,Yes]) ]
  44                                  [ (The, [(No,3),(Yes,3)]) ]
  45                          , testMajorityValueOfOpinions [No,Yes]
  46                                  [ (This, [No,No,No,No,Yes,Yes])
  47                                  , (That, [No,Yes,Yes,Yes,Yes,Yes])
  48                                  ]
  49                                  [ (This, [(No,4),(Yes,2)])
  50                                  , (That, [(Yes,5),(No,1)])
  51                                  ]
  52                          , testMajorityValueOfOpinions [No,Yes]
  53                                  [ (This, [No,No,No,No,No,No])
  54                                  , (That, [No,No,No,Yes,Yes,Yes])
  55                                  ]
  56                                  [ (This, [(No,6),(Yes,0)])
  57                                  , (That, [(No,3),(Yes,3)])
  58                                  ]
  59                          , testMajorityValueOfOpinions [No,Yes]
  60                                  [ (This, [Yes,Yes,Yes,Yes,Yes,Yes])
  61                                  , (That, [No,No,No,Yes,Yes,Yes])
  62                                  ]
  63                                  [ (This, [(Yes,6),(No,0)])
  64                                  , (That, [(No,3),(Yes,3)])
  65                                  ]
  66                          , testMajorityValueOfOpinions [No,Yes]
  67                                  [ (This, [No,No,Yes,Yes,Yes,Yes])
  68                                  , (That, [No,No,No,Yes,Yes,Yes])
  69                                  ]
  70                                  [ (This, [(Yes,4),(No,2)])
  71                                  , (That, [(No,3),(Yes,3)])
  72                                  ]
  73                          , testMajorityValueOfOpinions [ToReject,Insufficient,Acceptable,Good,VeryGood,Perfect]
  74                                  [ (1::Int, [Perfect,Perfect,VeryGood,Perfect,Perfect,Perfect])
  75                                  , (2, [Perfect,VeryGood,VeryGood,VeryGood,Good,VeryGood])
  76                                  , (3, [Acceptable,Perfect,Good,VeryGood,VeryGood,Perfect])
  77                                  , (4, [VeryGood,Good,Acceptable,Good,Good,Good])
  78                                  , (5, [Good,Acceptable,VeryGood,Good,Good,Good])
  79                                  , (6, [VeryGood,Acceptable,Insufficient,Acceptable,Acceptable,Good])
  80                                  ]
  81                                  [ (1, [(Perfect,5),(VeryGood,1),(ToReject,0),(Insufficient,0),(Acceptable,0),(Good,0)])
  82                                  , (2, [(VeryGood,4),(Good,1),(Perfect,1),(ToReject,0),(Insufficient,0),(Acceptable,0)])
  83                                  , (3, [(VeryGood,2),(Good,1),(Perfect,2),(Acceptable,1),(ToReject,0),(Insufficient,0)])
  84                                  , (4, [(Good,4),(Acceptable,1),(VeryGood,1),(ToReject,0),(Insufficient,0),(Perfect,0)])
  85                                  , (5, [(Good,4),(Acceptable,1),(VeryGood,1),(ToReject,0),(Insufficient,0),(Perfect,0)])
  86                                  , (6, [(Acceptable,3),(Good,1),(Insufficient,1),(VeryGood,1),(ToReject,0),(Perfect,0)])
  87                                  ]
  88                          ]
  89                  ]
  90          ]
  91
  92
  93 elide :: String -> String
  94 elide s | length s > 42 = take 42 s ++ ['…']
  95         | otherwise = s
  96
  97 mkMerit :: (Ord grade, Show grade) => [grade] -> [Count] -> Merit grade
  98 mkMerit gs = fromList . (gs`zip`)
  99
 100 mkMerits ::
 101  (Eq choice, Hashable choice, Ord grade) =>
 102  [grade] -> [(choice,[grade])] ->
 103  Merits choice grade
 104 mkMerits gs os =
 105         merits (fromList gs) $ fromList $
 106         second (fromList . zip [1::Int ..]) <$> os
 107
 108 testCompareValue :: (Ord grade, Show grade) =>
 109                     [(grade, Count)] -> [(grade, Count)] -> TestTree
 110 testCompareValue x y =
 111         testGroup (elide $ show (x,y))
 112          [ testCase "x == x" $ MajorityValue x`compare`MajorityValue x @?= EQ
 113          , testCase "y == y" $ MajorityValue y`compare`MajorityValue y @?= EQ
 114          , testCase "x <  y" $ MajorityValue x`compare`MajorityValue y @?= LT
 115          , testCase "y >  x" $ MajorityValue y`compare`MajorityValue x @?= GT
 116          ]
 117
 118 testMajorityRanking ::
 119  (Eq choice, Hashable choice, Ord grade, Show grade, Show choice) =>
 120  [grade] -> [(choice, [grade])] ->
 121  MajorityRanking choice grade -> TestTree
 122 testMajorityRanking gs os expect =
 123         testCase (elide $ show os) $
 124                 majorityRanking (mkMerits gs os) @?= expect
 125
 126 testMajorityValueOfOpinions ::
 127  (Show grade, Show choice, Ord grade, Eq choice, Hashable choice) =>
 128  [grade] -> [(choice, [grade])] ->
 129  [(choice, [(grade,Count)])] -> TestTree
 130 testMajorityValueOfOpinions gs os expect =
 131         testCase (elide $ show os) $
 132                 majorityValueByChoice (mkMerits gs os)
 133                  @?= (MajorityValue<$>HM.fromList expect)
 134
 135 testMajorityValueOfMerits ::
 136  (Show grade, Show choice, Ord grade, Eq choice, Hashable choice) =>
 137  Merits choice grade ->
 138  [(choice, [(grade,Count)])] -> TestTree
 139 testMajorityValueOfMerits ms expect =
 140         testCase (elide $ show ms) $
 141                 majorityValueByChoice ms
 142                  @?= (MajorityValue<$>HM.fromList expect)