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 qualified Data.Map.Strict as Map
  10
  11 import Hjugement
  12 import Types
  13
  14 hunits :: TestTree
  15 hunits =
  16         testGroup "HUnit"
  17          [ testGroup "Value" $
  18                  [ testCompareValue
  19                          [(3,15), (2,7), (1,3), (0::Int,2)]
  20                          [(3,16), (2,6), (1,2), (0,3)]
  21                  , testGroup "OfMerits"
  22                          [  let m = mkMerit ['A'..'F'] in
  23                                 testValueOfMerits
  24                                  [ (The, m [136,307,251,148,84,74])
  25                                  ]
  26                                  [ (The, [('C',251),('B',307),('D',148),('E',84),('A',136),('F',74)])
  27                                  ]
  28                          , let m = mkMerit [ToReject .. TooGood] in
  29                                 testValueOfMerits
  30                                  [ (This, m [12,10,21,5,5,5,2])
  31                                  , (That, m [12,16,22,3,3,3,1])
  32                                  ]
  33                                  [ (This, [(Acceptable,21),(Insufficient,10),(Good,5),(ToReject,12),(Perfect,5),(VeryGood,5),(TooGood,2)])
  34                                  , (That, [(Acceptable,22),(Insufficient,16),(ToReject,12),(VeryGood,3),(Perfect,3),(Good,3),(TooGood,1)])
  35                                  ]
  36                          ]
  37                  , testGroup "OfOpinions"
  38                          [ testValueOfOpinions [No,Yes]
  39                                    [The]
  40                                  [ [No ]
  41                                  , [No ]
  42                                  , [No ]
  43                                  , [No ]
  44                                  , [Yes]
  45                                  , [Yes]
  46                                  ]
  47                                  [ (The, [(No,4),(Yes,2)])
  48                                  ]
  49                          , testValueOfOpinions [No,Yes]
  50                                    [The]
  51                                  [ [No ]
  52                                  , [No ]
  53                                  , [No ]
  54                                  , [Yes]
  55                                  , [Yes]
  56                                  , [Yes]
  57                                  ]
  58                                  [ (The, [(No,3),(Yes,3)])
  59                                  ]
  60                          , testValueOfOpinions [No,Yes]
  61                                    [This, That]
  62                                  [ [No  , No ]
  63                                  , [No  , Yes]
  64                                  , [No  , Yes]
  65                                  , [No  , Yes]
  66                                  , [Yes , Yes]
  67                                  , [Yes , Yes]
  68                                  ]
  69                                  [ (This, [(No,4),(Yes,2)])
  70                                  , (That, [(Yes,5),(No,1)])
  71                                  ]
  72                          , testValueOfOpinions [No,Yes]
  73                                    [This, That]
  74                                  [ [No  , No ]
  75                                  , [No  , No ]
  76                                  , [No  , No ]
  77                                  , [No  , Yes]
  78                                  , [No  , Yes]
  79                                  , [No  , Yes]
  80                                  ]
  81                                  [ (This, [(No,6),(Yes,0)])
  82                                  , (That, [(No,3),(Yes,3)])
  83                                  ]
  84                          , testValueOfOpinions [No,Yes]
  85                                    [This, That]
  86                                  [ [Yes , No ]
  87                                  , [Yes , No ]
  88                                  , [Yes , No ]
  89                                  , [Yes , Yes]
  90                                  , [Yes , Yes]
  91                                  , [Yes , Yes]
  92                                  ]
  93                                  [ (This, [(Yes,6),(No,0)])
  94                                  , (That, [(No,3),(Yes,3)])
  95                                  ]
  96                          , testValueOfOpinions [No,Yes]
  97                                    [This, That]
  98                                  [ [No  , No ]
  99                                  , [No  , No ]
 100                                  , [Yes , No ]
 101                                  , [Yes , Yes]
 102                                  , [Yes , Yes]
 103                                  , [Yes , Yes]
 104                                  ]
 105                                  [ (This, [(Yes,4),(No,2)])
 106                                  , (That, [(No,3),(Yes,3)])
 107                                  ]
 108                          , testValueOfOpinions [ToReject,Insufficient,Acceptable,Good,VeryGood,Perfect]
 109                                    [1::Int ..6]
 110                                  [ [Perfect,Perfect,Acceptable,VeryGood,Good,VeryGood]
 111                                  , [Perfect,VeryGood,Perfect,Good,Acceptable,Acceptable]
 112                                  , [VeryGood,VeryGood,Good,Acceptable,VeryGood,Insufficient]
 113                                  , [Perfect,VeryGood,VeryGood,Good,Good,Acceptable]
 114                                  , [Perfect,Good,VeryGood,Good,Good,Acceptable]
 115                                  , [Perfect,VeryGood,Perfect,Good,Good,Good]
 116                                  ]
 117                                  [ (1, [(Perfect,5),(VeryGood,1),(ToReject,0),(Insufficient,0),(Acceptable,0),(Good,0)])
 118                                  , (2, [(VeryGood,4),(Good,1),(Perfect,1),(ToReject,0),(Insufficient,0),(Acceptable,0)])
 119                                  , (3, [(VeryGood,2),(Good,1),(Perfect,2),(Acceptable,1),(ToReject,0),(Insufficient,0)])
 120                                  , (4, [(Good,4),(Acceptable,1),(VeryGood,1),(ToReject,0),(Insufficient,0),(Perfect,0)])
 121                                  , (5, [(Good,4),(Acceptable,1),(VeryGood,1),(ToReject,0),(Insufficient,0),(Perfect,0)])
 122                                  , (6, [(Acceptable,3),(Good,1),(Insufficient,1),(VeryGood,1),(ToReject,0),(Perfect,0)])
 123                                  ]
 124                          ]
 125                  ]
 126          ]
 127
 128
 129 elide :: String -> String
 130 elide s | length s > 42 = take 42 s ++ ['…']
 131         | otherwise = s
 132
 133 mkOpinion :: Ord prop =>
 134              Choices prop -> judge -> [grade] ->
 135              (judge, Opinion prop grade)
 136 mkOpinion props j gs = (j, Map.fromList $ toList props `zip` gs)
 137
 138 mkMerit :: (Ord grade, Show grade) => [grade] -> [Count] -> Merit grade
 139 mkMerit scal = fromList . (scal`zip`)
 140
 141 mkMerits :: (Ord prop, Ord grade) =>
 142             [grade] -> Choices prop -> [[grade]] ->
 143             Merits prop grade
 144 mkMerits scal props opins =
 145         merits (Scale (fromList scal) (head scal)) props $ fromList $
 146         zipWith (mkOpinion props) [1::Int ..] opins
 147
 148
 149 testCompareValue :: (Ord grade, Show grade) =>
 150                     [(grade, Count)] -> [(grade, Count)] -> TestTree
 151 testCompareValue x y =
 152         testGroup (elide $ show (x,y))
 153          [ testCase "x == x" $ Value x`compare`Value x @?= EQ
 154          , testCase "y == y" $ Value y`compare`Value y @?= EQ
 155          , testCase "x <  y" $ Value x`compare`Value y @?= LT
 156          , testCase "y >  x" $ Value y`compare`Value x @?= GT
 157          ]
 158
 159 testRanking :: (Ord prop, Ord grade, Show grade, Show prop) =>
 160                [grade] -> Choices prop -> [[grade]] ->
 161                Ranking prop -> TestTree
 162 testRanking scal props opins expect =
 163         testCase (elide $ show (toList props,opins)) $
 164                 majorityRanking (mkMerits scal props opins) @?= expect
 165
 166 testValueOfOpinions :: (Show grade, Show prop, Ord grade, Ord prop) =>
 167              [grade] -> Choices prop -> [[grade]] ->
 168              [(prop, [(grade,Count)])] -> TestTree
 169 testValueOfOpinions scal props opins expect =
 170         testCase (elide $ show (toList props,opins)) $
 171                 majorityValueByChoice (mkMerits scal props opins)
 172                  @?= ((Value`second`)<$>expect)
 173
 174 testValueOfMerits :: (Show grade, Show prop, Ord grade, Ord prop) =>
 175              Merits prop grade ->
 176              [(prop, [(grade,Count)])] -> TestTree
 177 testValueOfMerits ms expect =
 178         testCase (elide $ show ms) $
 179                 majorityValueByChoice ms
 180                  @?= ((Value`second`)<$>expect)