test/HUnit/Merit.hs

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