hjugement/test/HUnit/Merit.hs

   1 {-# LANGUAGE OverloadedLists #-}
   2 module HUnit.Merit where
   3
   4 import Control.Arrow (second)
   5 import Data.Eq (Eq(..))
   6 import Data.Function (($), (.))
   7 import Data.Functor ((<$>))
   8 import Data.Hashable (Hashable)
   9 import Data.Int (Int)
  10 import Data.List (zip)
  11 import Data.Ord (Ord(..))
  12 import Data.Ratio ((%))
  13 import Data.Set (Set)
  14 import GHC.Exts (IsList(..))
  15 import Text.Show (Show(..))
  16 import qualified Data.HashMap.Strict as HM
  17 import qualified Data.Set as Set
  18
  19 import Test.Tasty
  20 import Test.Tasty.HUnit
  21 import Majority.Judgment
  22 import HUnit.Utils
  23 import Types
  24
  25 hunit :: TestTree
  26 hunit = testGroup "Merit"
  27  [ let m = mkMerit ['A'..'F'] in
  28         testMajorityValueOfMerits
  29          [ (The, m [136,307,251,148,84,74])
  30          ]
  31          [ (The,
  32                  [ Middle ( 57 % 1) 'C' 'C'
  33                  , Middle (137 % 1) 'B' 'C'
  34                  , Middle (148 % 1) 'B' 'D'
  35                  , Middle ( 22 % 1) 'B' 'E'
  36                  , Middle ( 62 % 1) 'A' 'E'
  37                  , Middle ( 74 % 1) 'A' 'F'
  38                  ])
  39          ]
  40  , let m = mkMerit (enum::Set SchoolGrade) in
  41         testMajorityValueOfMerits
  42          [ (This, m [12,10,21,5,5,5])
  43          , (That, m [12,16,22,3,3,3])
  44          ]
  45          [ (This, [ Middle (7 % 1) Acceptable   Acceptable
  46                   , Middle (7 % 1) Insufficient Acceptable
  47                   , Middle (3 % 1) Insufficient Good
  48                   , Middle (2 % 1) ToReject     Good
  49                   , Middle (5 % 1) ToReject     VeryGood
  50                   , Middle (5 % 1) ToReject     Perfect
  51                   ])
  52          , (That, [ Middle ( 3 % 2) Acceptable   Acceptable
  53                   , Middle (16 % 1) Insufficient Acceptable
  54                   , Middle ( 3 % 1) ToReject     Acceptable
  55                   , Middle ( 3 % 1) ToReject     Good
  56                   , Middle ( 3 % 1) ToReject     VeryGood
  57                   , Middle ( 3 % 1) ToReject     Perfect
  58                   ])
  59          ]
  60  ]
  61 mkMerit :: (Ord grade, Show grade) => Set grade -> [Share] -> Merit grade
  62 mkMerit gs = fromList . (Set.toList gs`zip`)
  63
  64 mkMeritByChoice ::
  65  (Eq choice, Hashable choice, Ord grade) =>
  66  [(choice,[grade])] ->
  67  MeritByChoice choice grade
  68 mkMeritByChoice os =
  69         meritByChoice $ fromList $
  70         second (fromList . zip [1::Int ..] . (singleGrade <$>)) <$> os
  71
  72 testMajorityValueOfMerits ::
  73  (Show grade, Show choice, Ord grade, Eq choice, Hashable choice) =>
  74  MeritByChoice choice grade ->
  75  [(choice, [Middle grade])] -> TestTree
  76 testMajorityValueOfMerits ms expect =
  77         testCase (elide $ show $ unMeritByChoice ms) $
  78                 majorityValueByChoice ms
  79                  @?= (MajorityValue<$>HM.fromList expect)
  80