{-# LANGUAGE OverloadedLists #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module HUnit where

import Test.Tasty
import Test.Tasty.HUnit

import Control.Arrow (second)
import Data.Hashable (Hashable)
import qualified Data.HashMap.Strict as HM

import Hjugement
import Types

hunits :: TestTree
hunits =
	testGroup "HUnit"
	 [ testGroup "MajorityValue" $
		 [ testCompareValue
			 [(3,15), (2,7), (1,3), (0::Int,2)]
			 [(3,16), (2,6), (1,2), (0,3)]
		 , testGroup "OfMerits"
			 [  let m = mkMerit ['A'..'F'] in
				testMajorityValueOfMerits
				 [ (The, m [136,307,251,148,84,74])
				 ]
				 [ (The, [('C',251),('B',307),('D',148),('E',84),('A',136),('F',74)])
				 ]
			 , let m = mkMerit [ToReject .. TooGood] in
				testMajorityValueOfMerits
				 [ (This, m [12,10,21,5,5,5,2])
				 , (That, m [12,16,22,3,3,3,1])
				 ]
				 [ (This, [(Acceptable,21),(Insufficient,10),(Good,5),(ToReject,12),(Perfect,5),(VeryGood,5),(TooGood,2)])
				 , (That, [(Acceptable,22),(Insufficient,16),(ToReject,12),(VeryGood,3),(Perfect,3),(Good,3),(TooGood,1)])
				 ]
			 ]
		 , testGroup "OfOpinions"
			 [ testMajorityValueOfOpinions [No,Yes]
				 [ (The, [No,No,No,No,Yes,Yes]) ]
				 [ (The, [(No,4),(Yes,2)]) ]
			 , testMajorityValueOfOpinions [No,Yes]
				 [ (The, [No,No,No,Yes,Yes,Yes]) ]
				 [ (The, [(No,3),(Yes,3)]) ]
			 , testMajorityValueOfOpinions [No,Yes]
				 [ (This, [No,No,No,No,Yes,Yes])
				 , (That, [No,Yes,Yes,Yes,Yes,Yes])
				 ]
				 [ (This, [(No,4),(Yes,2)])
				 , (That, [(Yes,5),(No,1)])
				 ]
			 , testMajorityValueOfOpinions [No,Yes]
				 [ (This, [No,No,No,No,No,No])
				 , (That, [No,No,No,Yes,Yes,Yes])
				 ]
				 [ (This, [(No,6),(Yes,0)])
				 , (That, [(No,3),(Yes,3)])
				 ]
			 , testMajorityValueOfOpinions [No,Yes]
				 [ (This, [Yes,Yes,Yes,Yes,Yes,Yes])
				 , (That, [No,No,No,Yes,Yes,Yes])
				 ]
				 [ (This, [(Yes,6),(No,0)])
				 , (That, [(No,3),(Yes,3)])
				 ]
			 , testMajorityValueOfOpinions [No,Yes]
				 [ (This, [No,No,Yes,Yes,Yes,Yes])
				 , (That, [No,No,No,Yes,Yes,Yes])
				 ]
				 [ (This, [(Yes,4),(No,2)])
				 , (That, [(No,3),(Yes,3)])
				 ]
			 , testMajorityValueOfOpinions [ToReject,Insufficient,Acceptable,Good,VeryGood,Perfect]
				 [ (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, [(Perfect,5),(VeryGood,1),(ToReject,0),(Insufficient,0),(Acceptable,0),(Good,0)])
				 , (2, [(VeryGood,4),(Good,1),(Perfect,1),(ToReject,0),(Insufficient,0),(Acceptable,0)])
				 , (3, [(VeryGood,2),(Good,1),(Perfect,2),(Acceptable,1),(ToReject,0),(Insufficient,0)])
				 , (4, [(Good,4),(Acceptable,1),(VeryGood,1),(ToReject,0),(Insufficient,0),(Perfect,0)])
				 , (5, [(Good,4),(Acceptable,1),(VeryGood,1),(ToReject,0),(Insufficient,0),(Perfect,0)])
				 , (6, [(Acceptable,3),(Good,1),(Insufficient,1),(VeryGood,1),(ToReject,0),(Perfect,0)])
				 ]
			 ]
		 ]
	 ]


elide :: String -> String
elide s | length s > 42 = take 42 s ++ ['…']
        | otherwise = s

mkMerit :: (Ord grade, Show grade) => [grade] -> [Count] -> Merit grade
mkMerit gs = fromList . (gs`zip`)

mkMerits ::
 (Eq choice, Hashable choice, Ord grade) =>
 [grade] -> [(choice,[grade])] ->
 Merits choice grade
mkMerits gs os =
	merits (fromList gs) $ fromList $
	second (fromList . zip [1::Int ..]) <$> os

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

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

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

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