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 Data.Ratio ((%))
  11 import Data.Tree (Tree(..))
  12 import GHC.Exts (IsList(..))
  13 import Prelude
  14 import qualified Data.HashMap.Strict as HM
  15
  16 import Hjugement
  17 import Types
  18
  19 hunits :: TestTree
  20 hunits =
  21         testGroup "HUnit"
  22          [ testGroup "MajorityValue" $
  23                  [ testCompareValue
  24                          [(3,15), (2,7), (1,3), (0::Int,2)]
  25                          [(3,16), (2,6), (1,2), (0,3)]
  26                  , testGroup "Merit"
  27                          [  let m = mkMerit ['A'..'F'] in
  28                                 testMajorityValueOfMerits
  29                                  [ (The, m [136,307,251,148,84,74])
  30                                  ]
  31                                  [ (The, [('C',251),('B',307),('D',148),('E',84),('A',136),('F',74)])
  32                                  ]
  33                          , let m = mkMerit [ToReject .. TooGood] in
  34                                 testMajorityValueOfMerits
  35                                  [ (This, m [12,10,21,5,5,5,2])
  36                                  , (That, m [12,16,22,3,3,3,1])
  37                                  ]
  38                                  [ (This, [(Acceptable,21),(Insufficient,10),(Good,5),(ToReject,12),(Perfect,5),(VeryGood,5),(TooGood,2)])
  39                                  , (That, [(Acceptable,22),(Insufficient,16),(ToReject,12),(VeryGood,3),(Perfect,3),(Good,3),(TooGood,1)])
  40                                  ]
  41                          ]
  42                  , testGroup "MajorityRanking"
  43                          [ testMajorityValueOfOpinions
  44                                  [ (The, [No,No,No,No,Yes,Yes]) ]
  45                                  [ (The, [(No,4),(Yes,2)]) ]
  46                          , testMajorityValueOfOpinions
  47                                  [ (The, [No,No,No,Yes,Yes,Yes]) ]
  48                                  [ (The, [(No,3),(Yes,3)]) ]
  49                          , testMajorityValueOfOpinions
  50                                  [ (This, [No,No,No,No,Yes,Yes])
  51                                  , (That, [No,Yes,Yes,Yes,Yes,Yes])
  52                                  ]
  53                                  [ (This, [(No,4),(Yes,2)])
  54                                  , (That, [(Yes,5),(No,1)])
  55                                  ]
  56                          , testMajorityValueOfOpinions
  57                                  [ (This, [No,No,No,No,No,No])
  58                                  , (That, [No,No,No,Yes,Yes,Yes])
  59                                  ]
  60                                  [ (This, [(No,6)])
  61                                  , (That, [(No,3),(Yes,3)])
  62                                  ]
  63                          , testMajorityValueOfOpinions
  64                                  [ (This, [Yes,Yes,Yes,Yes,Yes,Yes])
  65                                  , (That, [No,No,No,Yes,Yes,Yes])
  66                                  ]
  67                                  [ (This, [(Yes,6)])
  68                                  , (That, [(No,3),(Yes,3)])
  69                                  ]
  70                          , testMajorityValueOfOpinions
  71                                  [ (This, [No,No,Yes,Yes,Yes,Yes])
  72                                  , (That, [No,No,No,Yes,Yes,Yes])
  73                                  ]
  74                                  [ (This, [(Yes,4),(No,2)])
  75                                  , (That, [(No,3),(Yes,3)])
  76                                  ]
  77                          , testMajorityValueOfOpinions
  78                                  [ (1::Int, [Perfect,Perfect,VeryGood,Perfect,Perfect,Perfect])
  79                                  , (2, [Perfect,VeryGood,VeryGood,VeryGood,Good,VeryGood])
  80                                  , (3, [Acceptable,Perfect,Good,VeryGood,VeryGood,Perfect])
  81                                  , (4, [VeryGood,Good,Acceptable,Good,Good,Good])
  82                                  , (5, [Good,Acceptable,VeryGood,Good,Good,Good])
  83                                  , (6, [VeryGood,Acceptable,Insufficient,Acceptable,Acceptable,Good])
  84                                  ]
  85                                  [ (1, [(Perfect,5),(VeryGood,1)])
  86                                  , (2, [(VeryGood,4),(Good,1),(Perfect,1)])
  87                                  , (3, [(VeryGood,2),(Good,1),(Perfect,2),(Acceptable,1)])
  88                                  , (4, [(Good,4),(Acceptable,1),(VeryGood,1)])
  89                                  , (5, [(Good,4),(Acceptable,1),(VeryGood,1)])
  90                                  , (6, [(Acceptable,3),(Good,1),(Insufficient,1),(VeryGood,1)])
  91                                  ]
  92                          ]
  93                  , testGroup "Section"
  94                          [ testSection "1 judge, default grade"
  95                                  [(1::Int,ToReject)]
  96                                  (node0 [(1,SectionOpinion Nothing Nothing)])
  97                                  (Right $ node0 [(1,[(ToReject,1%1)])])
  98                          {-
  99                          , testSection "2 judges, default grade"
 100                                  [(1::Int,ToReject), (2::Int,ToReject)]
 101                                  (node0
 102                                          [ (1,SectionOpinion Nothing Nothing)
 103                                          ])
 104                                  (Right $ node0
 105                                          [ (1,[(ToReject,1%1)])
 106                                          , (2,[(ToReject,1%1)])
 107                                          ])
 108                          , testSection "ErrorSection_unknown_judges"
 109                                  [(1::Int,ToReject)]
 110                                  (node0 [(2,SectionOpinion Nothing Nothing)])
 111                                  (Left $ ErrorSection_unknown_judges [2])
 112                          , testSection "1 judge, 1 grade"
 113                                  [(1::Int,ToReject)]
 114                                  (node0 [(1,SectionOpinion Nothing (Just Acceptable))])
 115                                  (Right $ Node [(1,[(Acceptable,1%1)])] [])
 116                          , testSection "1 judge, 1 grade, 2 sections"
 117                                  [(1::Int,ToReject)]
 118                                  (Node
 119                                          [ (1,SectionOpinion Nothing (Just Acceptable)) ]
 120                                          [ node0 [(1,SectionOpinion (Just $ 1%2) Nothing)]
 121                                          , node0 [(1,SectionOpinion (Just $ 1%2) Nothing)]
 122                                          ])
 123                                  (Right $ Node
 124                                          [ (1,[(Acceptable,1%1)]) ]
 125                                          [ node0 [(1,[(Acceptable,1%1)])]
 126                                          , node0 [(1,[(Acceptable,1%1)])]
 127                                          ])
 128                          , testSection "1 judge, 2 grades, 2 sections"
 129                                  [(1::Int,ToReject)]
 130                                  (Node
 131                                          [ (1,SectionOpinion Nothing (Just Acceptable)) ]
 132                                          [ node0 [(1,SectionOpinion (Just $ 1%2) Nothing)]
 133                                          , node0 [(1,SectionOpinion (Just $ 1%2) (Just Good))]
 134                                          ])
 135                                  (Right $ Node
 136                                          [(1,[(Acceptable,1%2), (Good,1%2)])]
 137                                          [ node0 [(1,[(Acceptable,1%1)])]
 138                                          , node0 [(1,[(Good,1%1)])]
 139                                          ])
 140                          , testSection "1 judge, 2 grades, 2 sections (1 default)"
 141                                  [(1::Int,ToReject)]
 142                                  (Node
 143                                          [ (1,SectionOpinion Nothing (Just Acceptable)) ]
 144                                          [ node0 [(1,SectionOpinion Nothing Nothing)]
 145                                          , node0 [(1,SectionOpinion (Just $ 1%2) (Just Good))]
 146                                          ])
 147                                  (Right $ Node
 148                                          [(1,[(Acceptable,1%2), (Good,1%2)])]
 149                                          [ node0 [(1,[(Acceptable,1%1)])]
 150                                          , node0 [(1,[(Good,1%1)])]
 151                                          ])
 152                          , testSection "1 judge, 3 grades, 3 sections (2 default)"
 153                                  [(1::Int,ToReject)]
 154                                  (Node
 155                                          [ (1,SectionOpinion Nothing (Just Acceptable)) ]
 156                                          [ node0 [(1,SectionOpinion Nothing Nothing)]
 157                                          , node0 [(1,SectionOpinion (Just $ 1%2) (Just Good))]
 158                                          , node0 [(1,SectionOpinion Nothing (Just VeryGood))]
 159                                          ])
 160                                  (Right $ Node
 161                                          [(1,[(Acceptable,1%4), (Good,1%2), (VeryGood,1%4)])]
 162                                          [ node0 [(1,[(Acceptable,1%1)])]
 163                                          , node0 [(1,[(Good,1%1)])]
 164                                          , node0 [(1,[(VeryGood,1%1)])]
 165                                          ])
 166                          , testSection "ErrorSection_invalid_shares sum not 1"
 167                                  [(1::Int,ToReject)]
 168                                  (Node
 169                                          [ (1,SectionOpinion Nothing (Just Acceptable)) ]
 170                                          [ node0 [(1,SectionOpinion (Just $ 1%2) Nothing)]
 171                                          , node0 [(1,SectionOpinion (Just $ 1%3) (Just Good))]
 172                                          ])
 173                                  (Left $ ErrorSection_invalid_shares [(1,[1%2,1%3])])
 174                          , testSection "ErrorSection_invalid_shares negative share"
 175                                  [(1::Int,ToReject)]
 176                                  (Node
 177                                          [ (1,SectionOpinion Nothing (Just Acceptable)) ]
 178                                          [ node0 [(1,SectionOpinion (Just $ 1%2) Nothing)]
 179                                          , node0 [(1,SectionOpinion (Just $ -1%2) (Just Good))]
 180                                          ])
 181                                  (Left $ ErrorSection_invalid_shares [(1,[1%2,-1%2])])
 182                          -}
 183                          , testSection "2 judges, 3 grade, 3 sections (1 default)"
 184                                  [(1::Int,ToReject), (2::Int,ToReject)]
 185                                  (Node
 186                                          [ (1,SectionOpinion Nothing (Just Acceptable))
 187                                          ]
 188                                          [ node0
 189                                                  [ (1,SectionOpinion Nothing Nothing)
 190                                                  ]
 191                                          , node0
 192                                                  [ (1,SectionOpinion (Just $ 1%2) (Just Good))
 193                                                  ]
 194                                          ])
 195                                  (Right $ Node
 196                                          [ (1,[(Acceptable,1%2), (Good,1%2)])
 197                                          , (2,[(ToReject,1%1)])
 198                                          ]
 199                                          [ node0
 200                                                  [ (1,[(Acceptable,1%1)])
 201                                                  , (2,[(ToReject,1%1)])
 202                                                  ]
 203                                          , node0
 204                                                  [ (1,[(Good,1%1)])
 205                                                  , (2,[(ToReject,1%1)])
 206                                                  ]
 207                                          ])
 208                          , testSection "2 judges, 3 grades, 5 sections (2 defaults)"
 209                                  [(1::Int,ToReject), (2::Int,ToReject)]
 210                                  (Node
 211                                          [ (1,SectionOpinion Nothing (Just Acceptable))
 212                                          ]
 213                                          [ node0
 214                                                  [ (1,SectionOpinion Nothing Nothing)
 215                                                  ]
 216                                          , node0
 217                                                  [ (1,SectionOpinion (Just $ 1%2) (Just Good))
 218                                                  ]
 219                                          , Node
 220                                                  [ (1,SectionOpinion Nothing (Just Good))
 221                                                  ]
 222                                                  [ node0
 223                                                          [ (1,SectionOpinion Nothing (Just VeryGood))
 224                                                          , (2,SectionOpinion Nothing (Just Insufficient))
 225                                                          ]
 226                                                  ]
 227                                          ])
 228                                  (Right $ Node
 229                                          [ (1,[(Acceptable,1%4), (Good,1%2), (VeryGood,1%4)])
 230                                          , (2,[(ToReject,2%3), (Insufficient,1%3)])
 231                                          ]
 232                                          [ node0
 233                                                  [ (1,[(Acceptable,1%1)])
 234                                                  , (2,[(ToReject,1%1)])
 235                                                  ]
 236                                          , node0
 237                                                  [ (1,[(Good,1%1)])
 238                                                  , (2,[(ToReject,1%1)])
 239                                                  ]
 240                                          , Node
 241                                                  [ (1,[(VeryGood,1%1)])
 242                                                  , (2,[(Insufficient,1%1)])
 243                                                  ]
 244                                                  [ node0
 245                                                          [ (1,[(VeryGood,1%1)])
 246                                                          , (2,[(Insufficient,1%1)])
 247                                                          ]
 248                                                  ]
 249                                          ])
 250                          ]
 251                  ]
 252          ]
 253
 254 elide :: String -> String
 255 elide s | length s > 42 = take 42 s ++ ['…']
 256         | otherwise = s
 257
 258 mkMerit :: (Ord grade, Show grade) => [grade] -> [Share] -> Merit grade
 259 mkMerit gs = fromList . (gs`zip`)
 260
 261 mkMeritByChoice ::
 262  (Eq choice, Hashable choice, Ord grade) =>
 263  [(choice,[grade])] ->
 264  MeritByChoice choice grade
 265 mkMeritByChoice os =
 266         meritByChoice $ fromList $
 267         second (fromList . zip [1::Int ..] . (singleGrade <$>)) <$> os
 268
 269 testCompareValue :: (Ord grade, Show grade) =>
 270                     [(grade, Share)] -> [(grade, Share)] -> TestTree
 271 testCompareValue x y =
 272         testGroup (elide $ show (x,y))
 273          [ testCase "x == x" $ MajorityValue x`compare`MajorityValue x @?= EQ
 274          , testCase "y == y" $ MajorityValue y`compare`MajorityValue y @?= EQ
 275          , testCase "x <  y" $ MajorityValue x`compare`MajorityValue y @?= LT
 276          , testCase "y >  x" $ MajorityValue y`compare`MajorityValue x @?= GT
 277          ]
 278
 279 testMajorityRanking ::
 280  (Eq choice, Hashable choice, Ord grade, Show grade, Show choice) =>
 281  [(choice, [grade])] ->
 282  MajorityRanking choice grade -> TestTree
 283 testMajorityRanking os expect =
 284         testCase (elide $ show os) $
 285                 majorityRanking (mkMeritByChoice os) @?= expect
 286
 287 testMajorityValueOfOpinions ::
 288  (Show grade, Show choice, Ord grade, Eq choice, Hashable choice) =>
 289  [(choice, [grade])] ->
 290  [(choice, [(grade,Share)])] -> TestTree
 291 testMajorityValueOfOpinions os expect =
 292         testCase (elide $ show os) $
 293                 majorityValueByChoice (mkMeritByChoice os)
 294                  @?= (MajorityValue<$>HM.fromList expect)
 295
 296 testMajorityValueOfMerits ::
 297  (Show grade, Show choice, Ord grade, Eq choice, Hashable choice) =>
 298  MeritByChoice choice grade ->
 299  [(choice, [(grade,Share)])] -> TestTree
 300 testMajorityValueOfMerits ms expect =
 301         testCase (elide $ show ms) $
 302                 majorityValueByChoice ms
 303                  @?= (MajorityValue<$>HM.fromList expect)
 304
 305
 306 testSection ::
 307  Eq judge =>
 308  Hashable judge =>
 309  Ord grade =>
 310  Show grade =>
 311  Show judge =>
 312  String ->
 313  Judges judge grade ->
 314  Tree (Section judge grade) ->
 315  Either (ErrorSection judge)
 316         (Tree (Opinions judge grade)) ->
 317  TestTree
 318 testSection msg js ss expect =
 319         testCase (elide msg) $
 320                 opinionsBySection js ss @?= expect
 321
 322 node0 :: a -> Tree a
 323 node0 = (`Node`[])