Value.hs

{-# LANGUAGE OverloadedLists #-}
module HUnit.Value where
import Data.Function (($))
import Data.Int (Int)
import Data.Hashable (Hashable)
import Data.Eq (Eq(..))
import Data.Functor ((<$>))
import Data.Ord (Ord(..), Ordering(..))
import Data.Ratio ((%))
import Text.Show (Show(..))
import qualified Data.HashMap.Strict as HM

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

hunit :: TestTree
hunit = testGroup "Value"
 [ testGroup "MajorityValue"
	 [ testCompareValue
		 (majorityValue $ Merit [(3,15), (2,7), (1,3), (0::Int,2)])
		 (majorityValue $ Merit [(3,16), (2,6), (1,2), (0,3)])
	 ]
 , testGroup "MajorityRanking"
	 [ testMajorityValueOfOpinions
		 [ (The, [No,No,No,No,Yes,Yes]) ]
		 [ (The, [ Middle (1 % 1) No No
		         , Middle (2 % 1) No Yes
		         ]) ]
	 , testMajorityValueOfOpinions
		 [ (The, [No,No,No,Yes,Yes,Yes]) ]
		 [ (The, [ Middle (3 % 1) No Yes ]) ]
	 , testMajorityValueOfOpinions
		 [ (The, [No,No,No,No,Yes,Yes,Yes]) ]
		 [ (The, [ Middle (1 % 2) No No
		         , Middle (3 % 1) No Yes ]) ]
	 , testMajorityValueOfOpinions
		 [ (This, [No,No,No,No,Yes,Yes])
		 , (That, [No,Yes,Yes,Yes,Yes,Yes])
		 ]
		 [ (This, [ Middle (1 % 1) No No
		          , Middle (2 % 1) No Yes
		          ])
		 , (That, [ Middle (2 % 1) Yes Yes
		          , Middle (1 % 1) No  Yes
		          ])
		 ]
	 , testMajorityValueOfOpinions
		 [ (This, [No,No,No,No,No,No])
		 , (That, [No,No,No,Yes,Yes,Yes])
		 ]
		 [ (This, [Middle (3 % 1) No No])
		 , (That, [Middle (3 % 1) No Yes])
		 ]
	 , testMajorityValueOfOpinions
		 [ (This, [Yes,Yes,Yes,Yes,Yes,Yes])
		 , (That, [No,No,No,Yes,Yes,Yes])
		 ]
		 [ (This, [Middle (3 % 1) Yes Yes])
		 , (That, [Middle (3 % 1) No  Yes])
		 ]
	 , testMajorityValueOfOpinions
		 [ (This, [No,No,Yes,Yes,Yes,Yes])
		 , (That, [No,No,No,Yes,Yes,Yes])
		 ]
		 [ (This, [ Middle (1 % 1) Yes Yes
		          , Middle (2 % 1) No  Yes
		          ])
		 , (That, [ Middle (3 % 1) No Yes ])
		 ]
	 , testMajorityValueOfOpinions
		 [ (1::Int, [Perfect,Perfect,VeryGood,Perfect,Perfect,Perfect])
		 , (2, [Perfect,VeryGood,VeryGood,VeryGood,Good,VeryGood])
		 , (3, [Acceptable,Perfect,Good,VeryGood,VeryGood,Perfect])
		 , (4, [VeryGood,Good,Acceptable,Good,Good,Good])
		 , (5, [Good,Acceptable,VeryGood,Good,Good,Good])
		 , (6, [VeryGood,Acceptable,Insufficient,Acceptable,Acceptable,Good])
		 ]
		 [ (1, [ Middle (2 % 1) Perfect      Perfect
		       , Middle (1 % 1) VeryGood     Perfect
		       ])
		 , (2, [ Middle (2 % 1) VeryGood     VeryGood
		       , Middle (1 % 1) Good         Perfect
		       ])
		 , (3, [ Middle (1 % 1) VeryGood     VeryGood
		       , Middle (1 % 1) Good         Perfect
		       , Middle (1 % 1) Acceptable   Perfect
		       ])
		 , (4, [ Middle (2 % 1) Good         Good
		       , Middle (1 % 1) Acceptable   VeryGood
		       ])
		 , (5, [ Middle (2 % 1) Good         Good
		       , Middle (1 % 1) Acceptable   VeryGood
		       ])
		 , (6, [ Middle (1 % 1) Acceptable   Acceptable
		       , Middle (1 % 1) Acceptable   Good
		       , Middle (1 % 1) Insufficient VeryGood
		       ])
		 ]
	 ]
 ]

testCompareValue ::
 (Ord grade, Show grade) =>
 MajorityValue grade -> MajorityValue grade -> TestTree
testCompareValue x y =
	testGroup (elide $ show (unMajorityValue x, unMajorityValue y))
	 [ testCase "x == x" $ x`compare`x @?= EQ
	 , testCase "y == y" $ y`compare`y @?= EQ
	 , testCase "x <  y" $ x`compare`y @?= LT
	 , testCase "y >  x" $ y`compare`x @?= GT
	 ]

testMajorityRanking ::
 (Eq choice, Hashable choice, Ord grade, Show grade, Show choice) =>
 [(choice, [grade])] ->
 MajorityRanking choice grade -> TestTree
testMajorityRanking os expect =
	testCase (elide $ show os) $
		majorityRanking (mkMeritByChoice os) @?= expect

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