Merit.hs

{-# LANGUAGE OverloadedLists #-}
module HUnit.Merit where

import Control.Arrow (second)
import Data.Eq (Eq(..))
import Data.Function (($), (.))
import Data.Functor ((<$>))
import Data.Hashable (Hashable)
import Data.Int (Int)
import Data.List (zip)
import Data.Ord (Ord(..))
import Data.Ratio ((%))
import Data.Set (Set)
import GHC.Exts (IsList(..))
import Text.Show (Show(..))
import qualified Data.HashMap.Strict as HM
import qualified Data.Set as Set

import Test.Tasty
import Test.Tasty.HUnit
import Majority.Judgment
import HUnit.Utils
import Types

hunit :: TestTree
hunit = testGroup "Merit"
 [ let m = mkMerit ['A'..'F'] in
	testMajorityValueOfMerits
	 [ (The, m [136,307,251,148,84,74])
	 ]
	 [ (The,
		 [ Middle ( 57 % 1) 'C' 'C'
		 , Middle (137 % 1) 'B' 'C'
		 , Middle (148 % 1) 'B' 'D'
		 , Middle ( 22 % 1) 'B' 'E'
		 , Middle ( 62 % 1) 'A' 'E'
		 , Middle ( 74 % 1) 'A' 'F'
		 ])
	 ]
 , let m = mkMerit (enum::Set SchoolGrade) in
	testMajorityValueOfMerits
	 [ (This, m [12,10,21,5,5,5])
	 , (That, m [12,16,22,3,3,3])
	 ]
	 [ (This, [ Middle (7 % 1) Acceptable   Acceptable
	          , Middle (7 % 1) Insufficient Acceptable
	          , Middle (3 % 1) Insufficient Good
	          , Middle (2 % 1) ToReject     Good
	          , Middle (5 % 1) ToReject     VeryGood
	          , Middle (5 % 1) ToReject     Perfect
	          ])
	 , (That, [ Middle ( 3 % 2) Acceptable   Acceptable
	          , Middle (16 % 1) Insufficient Acceptable
	          , Middle ( 3 % 1) ToReject     Acceptable
	          , Middle ( 3 % 1) ToReject     Good
	          , Middle ( 3 % 1) ToReject     VeryGood
	          , Middle ( 3 % 1) ToReject     Perfect
	          ])
	 ]
 ]
mkMerit :: (Ord grade, Show grade) => Set grade -> [Share] -> Merit grade
mkMerit gs = fromList . (Set.toList gs`zip`)

mkMeritByChoice ::
 (Eq choice, Hashable choice, Ord grade) =>
 [(choice,[grade])] ->
 MeritByChoice choice grade
mkMeritByChoice os =
	meritByChoice $ fromList $
	second (fromList . zip [1::Int ..] . (singleGrade <$>)) <$> os

testMajorityValueOfMerits ::
 (Show grade, Show choice, Ord grade, Eq choice, Hashable choice) =>
 MeritByChoice choice grade ->
 [(choice, [Middle grade])] -> TestTree
testMajorityValueOfMerits ms expect =
	testCase (elide $ show $ unMeritByChoice ms) $
		majorityValueByChoice ms
		 @?= (MajorityValue<$>HM.fromList expect)