Section.hs

{-# LANGUAGE OverloadedLists #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module HUnit.Section where
import Data.Either (Either(..))
import Data.Eq (Eq(..))
import Data.Function (($), (.))
import Data.Hashable (Hashable)
import Data.Int (Int)
import Data.Maybe (Maybe(..))
import Data.Ord (Ord(..))
import Data.Ratio ((%))
import Data.String (String)
import Data.Tree (Tree(..))
import GHC.Exts (IsList(..))
import Prelude (Num(..))
import Test.Tasty
import Test.Tasty.HUnit
import Text.Show (Show(..))

import Majority.Judgment
import HUnit.Utils
import Types

hunit :: TestTree
hunit = testGroup "Section"
 [ testSection "0 judge"
	 ([]::Choices C2)
	 ([]::Judges Int SchoolGrade)
	 (node0 [])
	 (Right $ node0 [])
 , testSection "1 judge, default grade"
	 [This]
	 [(1::Int,ToReject)]
	 (node0 [])
	 (Right $ node0 [(This, [(1,[(ToReject,1%1)])])])
 , testSection "1 judge, default grade, 2 choices"
	 [This, That]
	 [(1::Int,ToReject)]
	 (node0 [])
	 (Right $ node0 [ (This, [(1,[(ToReject,1%1)])])
	                , (That, [(1,[(ToReject,1%1)])])
	                ])
 , testSection "1 judge, default grade"
	 [This]
	 [(1::Int,ToReject)]
	 (node0 [(This,[(1,Section Nothing Nothing)])])
	 (Right $ node0 [(This,[(1,[(ToReject,1%1)])])])
 , testSection "2 judges, default grade"
	 [This]
	 [(1::Int,ToReject), (2::Int,ToReject)]
	 (node0
		 [ (This, [(1,Section Nothing Nothing)])
		 ])
	 (Right $ node0
		 [ (This, [ (1,[(ToReject,1%1)])
		          , (2,[(ToReject,1%1)])
		          ])
		 ])
 , testSection "ErrorSection_unknown_choices"
	 []
	 [(1::Int,ToReject)]
	 (node0 [(This,[])])
	 (Left $ ErrorSection_unknown_choices [This])
 , testSection "ErrorSection_unknown_choices"
	 []
	 [(1::Int,ToReject)]
	 (node0 [(This,[(2,Section Nothing Nothing)])])
	 (Left $ ErrorSection_unknown_choices [This])
 , testSection "ErrorSection_unknown_choices"
	 [This]
	 [(1::Int,ToReject)]
	 (node0 [ (This,[(1,Section Nothing Nothing)])
	        , (That,[(2,Section Nothing Nothing)])
	        ])
	 (Left $ ErrorSection_unknown_choices [That])
 , testSection "ErrorSection_unknown_judges"
	 [This]
	 [(1::Int,ToReject)]
	 (node0 [(This,[(2,Section Nothing Nothing)])])
	 (Left $ ErrorSection_unknown_judges [(This,[2])])
 , testSection "1 judge, 1 grade"
	 [This]
	 [(1::Int,ToReject)]
	 (node0 [(This,[(1,Section Nothing (Just Acceptable))])])
	 (Right $ node0 [(This,[(1,[(Acceptable,1%1)])])])
 , testSection "1 judge, 1 grade, 2 sections"
	 [This]
	 [(1::Int,ToReject)]
	 (Node
		 [ (This, [(1,Section Nothing (Just Acceptable))]) ]
		 [ node0 [(This, [(1,Section (Just $ 1%2) Nothing)])]
		 , node0 [(This, [(1,Section (Just $ 1%2) Nothing)])]
		 ])
	 (Right $ Node
		 [ (This, [(1,[(Acceptable,1%1)])]) ]
		 [ node0 [(This, [(1,[(Acceptable,1%1)])])]
		 , node0 [(This, [(1,[(Acceptable,1%1)])])]
		 ])
 , testSection "sectionNodeShare with judge"
	 [This]
	 [(1::Int,ToReject), (2,Insufficient)]
	 (Node
		 [(This, [(1,Section Nothing (Just Acceptable))])]
		 [ node0 $ SectionNode (Just $ 1%3) [(This, [ (1,Section (Just $ 1%2) Nothing)
		                                            , (2,Section Nothing Nothing)
		                                            ])]
		 , node0                            [(This, [ (1,Section (Just $ 1%2) Nothing)
		                                            , (2,Section Nothing (Just Good))
		                                            ])]
		 ])
	 (Right $ Node
		 [ (This, [ (1,[(Acceptable,1%2 + 1%2)])
		          , (2,[(Insufficient,1%3), (Good,2%3)])
		          ]) ]
		 [ node0 [(This, [ (1,[(Acceptable,1%1)])
		                 , (2,[(Insufficient,1%1)])
		                 ])]
		 , node0 [(This, [ (1,[(Acceptable,1%1)])
		                 , (2,[(Good,1%1)])
		                 ])]
		 ])
 , testSection "sectionNodeShare without judge"
	 [This]
	 [(1::Int,ToReject), (2,Insufficient)]
	 (Node
		 [(This, [(1,Section Nothing (Just Acceptable))])]
		 [ node0 $ SectionNode (Just $ 1%3) [(This, [ (1,Section (Just $ 1%2) Nothing) ])]
		 , node0                            [(This, [ (1,Section (Just $ 1%2) Nothing)
		                                            , (2,Section Nothing (Just Good))
		                                            ])]
		 ])
	 (Right $ Node
		 [ (This, [ (1,[(Acceptable,1%2 + 1%2)])
		          , (2,[(Insufficient,1%3), (Good,2%3)])
		          ]) ]
		 [ node0 [(This, [ (1,[(Acceptable,1%1)])
		                 , (2,[(Insufficient,1%1)])
		                 ])]
		 , node0 [(This, [ (1,[(Acceptable,1%1)])
		                 , (2,[(Good,1%1)])
		                 ])]
		 ])
 , testSection "1 judge, 2 grades, 2 sections"
	 [This]
	 [(1::Int,ToReject)]
	 (Node
		 [ (This, [(1,Section Nothing (Just Acceptable))]) ]
		 [ node0 [(This, [(1,Section (Just $ 1%2) Nothing)])]
		 , node0 [(This, [(1,Section (Just $ 1%2) (Just Good))])]
		 ])
	 (Right $ Node
		 [(This, [(1,[(Acceptable,1%2), (Good,1%2)])])]
		 [ node0 [(This, [(1,[(Acceptable,1%1)])])]
		 , node0 [(This, [(1,[(Good,1%1)])])]
		 ])
 , testSection "1 judge, 2 grades, 2 sections (1 default)"
	 [This]
	 [(1::Int,ToReject)]
	 (Node
		 [ (This, [(1,Section Nothing (Just Acceptable))]) ]
		 [ node0 [(This, [(1,Section Nothing Nothing)])]
		 , node0 [(This, [(1,Section (Just $ 1%2) (Just Good))])]
		 ])
	 (Right $ Node
		 [(This, [(1,[(Acceptable,1%2), (Good,1%2)])])]
		 [ node0 [(This, [(1,[(Acceptable,1%1)])])]
		 , node0 [(This, [(1,[(Good,1%1)])])]
		 ])
 , testSection "1 judge, 3 grades, 3 sections (2 default)"
	 [This]
	 [(1::Int,ToReject)]
	 (Node
		 [ (This, [(1,Section Nothing (Just Acceptable))]) ]
		 [ node0 [(This, [(1,Section Nothing Nothing)])]
		 , node0 [(This, [(1,Section (Just $ 1%2) (Just Good))])]
		 , node0 [(This, [(1,Section Nothing (Just VeryGood))])]
		 ])
	 (Right $ Node
		 [(This, [(1,[(Acceptable,1%4), (Good,1%2), (VeryGood,1%4)])])]
		 [ node0 [(This, [(1,[(Acceptable,1%1)])])]
		 , node0 [(This, [(1,[(Good,1%1)])])]
		 , node0 [(This, [(1,[(VeryGood,1%1)])])]
		 ])
 , testSection "ErrorSection_invalid_shares sum not 1"
	 [This]
	 [(1::Int,ToReject)]
	 (Node
		 [ (This, [(1,Section Nothing (Just Acceptable))]) ]
		 [ node0 [(This, [(1,Section (Just $ 1%2) Nothing)])]
		 , node0 [(This, [(1,Section (Just $ 1%3) (Just Good))])]
		 ])
	 (Left $ ErrorSection_invalid_shares [(This, [(1,[1%2,1%3])])])
 , testSection "ErrorSection_invalid_shares negative share"
	 [This]
	 [(1::Int,ToReject)]
	 (Node
		 [ (This, [(1,Section Nothing (Just Acceptable))]) ]
		 [ node0 [(This, [(1,Section (Just $ 1%2) Nothing)])]
		 , node0 [(This, [(1,Section (Just $ -1%2) (Just Good))])]
		 ])
	 (Left $ ErrorSection_invalid_shares [(This, [(1,[1%2,-1%2])])])
 , testSection "2 judges, 3 grade, 3 sections (1 default)"
	 [This]
	 [(1::Int,ToReject), (2::Int,ToReject)]
	 (Node
		 [ (This, [(1,Section Nothing (Just Acceptable))])
		 ]
		 [ node0
			 [ (This, [(1,Section Nothing Nothing)])
			 ]
		 , node0
			 [ (This, [(1,Section (Just $ 1%2) (Just Good))])
			 ]
		 ])
	 (Right $ Node
		 [ (This, [ (1,[(Acceptable,1%2), (Good,1%2)])
		          , (2,[(ToReject,1%1)])
		          ])
		 ]
		 [ node0
			 [ (This, [ (1,[(Acceptable,1%1)])
			          , (2,[(ToReject,1%1)])
			          ])
			 ]
		 , node0
			 [ (This, [ (1,[(Good,1%1)])
			          , (2,[(ToReject,1%1)])
			          ])
			 ]
		 ])
 , testSection "2 judges, 4 grades, 5 sections (2 defaults)"
	 [This]
	 [(1::Int,ToReject), (2::Int,ToReject)]
	 (Node
		 [ (This, [(1,Section Nothing (Just Acceptable))])
		 ]
		 [ node0
			 [ (This, [(1,Section Nothing Nothing)])
			 ]
		 , node0
			 [ (This, [(1,Section (Just $ 1%2) (Just Good))])
			 ]
		 , Node
			 [ (This, [(1,Section Nothing (Just Good))])
			 ]
			 [ node0
				 [ (This, [ (1,Section Nothing (Just VeryGood))
				          , (2,Section Nothing (Just Insufficient))
				          ])
				 ]
			 ]
		 ])
	 (Right $ Node
		 [ (This, [ (1,[(Acceptable,1%4), (Good,1%2), (VeryGood,1%4)])
		          , (2,[(ToReject,2%3), (Insufficient,1%3)])
		          ])
		 ]
		 [ node0
			 [ (This, [ (1,[(Acceptable,1%1)])
			          , (2,[(ToReject,1%1)])
			          ])
			 ]
		 , node0
			 [ (This, [ (1,[(Good,1%1)])
			          , (2,[(ToReject,1%1)])
			          ])
			 ]
		 , Node
			 [ (This, [ (1,[(VeryGood,1%1)])
			          , (2,[(Insufficient,1%1)])
			          ])
			 ]
			 [ node0
				 [ (This, [ (1,[(VeryGood,1%1)])
				          , (2,[(Insufficient,1%1)])
				          ])
				 ]
			 ]
		 ])
 , testSection "1 judge, default grade, 2 choices"
	 [This, That]
	 [(1::Int,ToReject)]
	 (node0 [])
	 (Right $ node0 [ (This,[(1,[(ToReject,1%1)])])
	                , (That,[(1,[(ToReject,1%1)])])
	                ])
 , testSection "2 judges, 2 choices"
	 [This, That]
	 [(1::Int,ToReject), (2::Int,ToReject)]
	 (Node
		 [ ]
		 [ node0
			 [ (This, [(1,Section Nothing (Just Good))])
			 , (That, [(2,Section Nothing (Just Insufficient))])
			 ]
		 , node0
			 [ (This, [(1,Section Nothing (Just Acceptable))])
			 , (That, [(2,Section Nothing (Just VeryGood))])
			 ]
		 ])
	 (Right $ Node
		 [ (This, [ (1,[(Good,1%2), (Acceptable,1%2)])
		          , (2,[(ToReject,1%1)])
		          ])
		 , (That, [ (1,[(ToReject,1%1)])
		          , (2,[(Insufficient,1%2), (VeryGood,1%2)])
		          ])
		 ]
		 [ node0 [ (This, [ (1,[(Good,1%1)])
		                  , (2,[(ToReject,1%1)])
		                  ])
		         , (That, [ (1,[(ToReject,1%1)])
		                  , (2,[(Insufficient,1%1)])
		                  ])
		         ]
		 , node0 [ (This, [ (1,[(Acceptable,1%1)])
		                  , (2,[(ToReject,1%1)])
		                  ])
		         , (That, [ (1,[(ToReject,1%1)])
		                  , (2,[(VeryGood,1%1)])
		                  ])
		         ]
		 ])
 , testSection "1 judge, 1 choice"
	 [This]
	 [(1::Int,ToReject)]
	 (Node []
		 [ node0 [ (This, [(1,Section (Just $ 1%8) (Just Acceptable))])
		         ]
		 , node0 [ (This, [(1,Section Nothing Nothing)])
		         ]
		 ])
	 (Right $ Node
		 [ (This, [(1,[(Acceptable,1%8), (ToReject,7%8)])])
		 ]
		 [ node0 [ (This, [(1,[(Acceptable, 1%1)])])
		         ]
		 , node0 [ (This, [(1,[(ToReject, 1%1)])])
		         ]
		 ])
 , testSection "1 judge, 1 choice (missing judge)"
	 [This]
	 [(1::Int,ToReject)]
	 (Node []
		 [ node0 [ (This, [(1,Section (Just $ 1%8) (Just Acceptable))])
		         ]
		 , node0 [ (This, [])
		         ]
		 ])
	 (Right $ Node
		 [ (This, [(1,[(Acceptable,1%8), (ToReject,7%8)])])
		 ]
		 [ node0 [ (This, [(1,[(Acceptable, 1%1)])])
		         ]
		 , node0 [ (This, [(1,[(ToReject, 1%1)])])
		         ]
		 ])
 , testSection "1 judge, 1 choice (missing judge)"
	 [This]
	 [(1::Int,ToReject)]
	 (Node []
		 [ node0 [ (This, [])
		         ]
		 , node0 [ (This, [(1,Section (Just $ 1%8) (Just Acceptable))])
		         ]
		 ])
	 (Right $ Node
		 [ (This, [(1,[(Acceptable,1%8), (ToReject,7%8)])])
		 ]
		 [ node0 [ (This, [(1,[(ToReject, 1%1)])])
		         ]
		 , node0 [ (This, [(1,[(Acceptable, 1%1)])])
		         ]
		 ])
 , testSection "1 judge, 1 choice (missing choice)"
	 [This]
	 [(1::Int,ToReject)]
	 (Node []
		 [ node0 [ (This, [(1,Section (Just $ 1%8) (Just Acceptable))])
		         ]
		 , node0 [
		         ]
		 ])
	 (Right $ Node
		 [ (This, [(1,[(Acceptable,1%8), (ToReject,7%8)])])
		 ]
		 [ node0 [ (This, [(1,[(Acceptable, 1%1)])])
		         ]
		 , node0 [ (This, [(1,[(ToReject, 1%1)])])
		         ]
		 ])
 , testSection "1 judge, 1 choice (missing choice)"
	 [This]
	 [(1::Int,ToReject)]
	 (Node []
		 [ node0 [ 
		         ]
		 , node0 [ (This, [(1,Section (Just $ 1%8) (Just Acceptable))])
		         ]
		 ])
	 (Right $ Node
		 [ (This, [(1,[(Acceptable,1%8), (ToReject,7%8)])])
		 ]
		 [ node0 [ (This, [(1,[(ToReject, 1%1)])])
		         ]
		 , node0 [ (This, [(1,[(Acceptable, 1%1)])])
		         ]
		 ])
 , testSection "2 judges, 2 choices"
	 [This, That]
	 [(1::Int,ToReject), (2::Int,ToReject)]
	 (node0
		 [ (This, [(1,Section Nothing (Just Acceptable))])
		 , (That, [(2,Section (Just $ 1%8) (Just VeryGood))])
		 ])
	 (Right $ node0
		 [ (This, [ (1,[(Acceptable,1%1)])
		          , (2,[(ToReject,1%1)])
		          ])
		 , (That, [ (1,[(ToReject,1%1)])
		          , (2,[(VeryGood,1%1)])
		          ])
		 ])
 , testSection "2 judges, 2 choices"
	 [This, That]
	 [(1::Int,ToReject), (2::Int,ToReject)]
	 (Node
		 [ ]
		 [ node0
			 [ (This, [(1,Section Nothing (Just Good))])
			 , (That, [(2,Section Nothing (Just Insufficient))])
			 ]
		 , node0
			 [ (This, [(1,Section Nothing (Just Acceptable))])
			 , (That, [(2,Section (Just $ 1%8) (Just VeryGood))])
			 ]
		 ])
	 (Right $ Node
		 [ (This, [ (1,[(Good,1%2), (Acceptable,1%2)])
		          , (2,[(ToReject,1%1)])
		          ])
		 , (That, [ (1,[(ToReject,1%1)])
		          , (2,[(Insufficient,7%8), (VeryGood,1%8)])
		          ])
		 ]
		 [ node0 [ (This, [ (1,[(Good,1%1)])
		                  , (2,[(ToReject,1%1)])
		                  ])
		         , (That, [ (1,[(ToReject,1%1)])
		                  , (2,[(Insufficient,1%1)])
		                  ])
		         ]
		 , node0 [ (This, [ (1,[(Acceptable,1%1)])
		                  , (2,[(ToReject,1%1)])
		                  ])
		         , (That, [ (1,[(ToReject,1%1)])
		                  , (2,[(VeryGood,1%1)])
		                  ])
		         ]
		 ])
 , testSection "2 judges, 2 choices"
	 [This, That]
	 [(1::Int,ToReject), (2::Int,ToReject)]
	 (Node [ (This, [(1,Section Nothing (Just Acceptable))])
	       ]
	       [ node0 [ (This, [(1,Section Nothing Nothing)])
	               ]
	       , node0 [ (This, [ (1,Section (Just $ 1%2) (Just Good)) ])
	               , (That, [ (1,Section (Just $ 1%3) Nothing)
	                        , (2,Section (Just $ 1%5) (Just Insufficient))
	                        ])
	               ]
	       , Node [ (This, [(1,Section Nothing (Just Good))])
	              , (That, [(2,Section Nothing (Just VeryGood))])
	              ]
	              [ node0 [ (This, [ (1,Section Nothing (Just VeryGood))
	                               , (2,Section Nothing (Just Insufficient))
	                               ])
	                      , (That, [ (1,Section Nothing (Just Acceptable)) ])
	                      ]
	              , node0 [ (This, [ (1,Section Nothing (Just Acceptable))
	                               ])
	                      , (That, [ (1,Section Nothing (Just VeryGood))
	                               , (2,Section Nothing (Just Good))
	                               ])
	                      ]
	              ]
	       ])
	 (Right $
		Node [ (This, [ (1,[(Acceptable,1%4 + 1%8), (Good,1%2), (VeryGood,1%8)])
		              , (2,[(ToReject,1%3 + 1%3 + 1%6), (Insufficient,1%6)])
		              ])
		     , (That, [ (1,[(ToReject,1%3 + 1%3), (Acceptable,1%6), (VeryGood,1%6)])
		              , (2,[(ToReject,4%10), (Insufficient,1%5), (VeryGood,4%20), (Good,4%20)])
		              ])
		     ]
		     [ node0 [ (This, [ (1,[(Acceptable,1%1)]) -- 1%4
		                      , (2,[(ToReject,1%1)])   -- 1%3
		                      ])
		             , (That, [ (1,[(ToReject,1%1)])   -- 1%3
		                      , (2,[(ToReject,1%1)])   -- 4%10
		                      ])
		             ]
		     , node0 [ (This, [ (1,[(Good,1%1)])         -- 1%2
		                      , (2,[(ToReject,1%1)])     -- 1%3
		                      ])
		             , (That, [ (1,[(ToReject,1%1)])     -- 1%3
		                      , (2,[(Insufficient,1%1)]) -- 1%5
		                      ])
		             ]
		     , Node [ (This, [ (1,[(VeryGood,1%2), (Acceptable,1%2)])   -- 1%4
		                     , (2,[(Insufficient,1%2), (ToReject,1%2)]) -- 1%3
		                     ])
		            , (That, [ (1,[(Acceptable,1%2), (VeryGood,1%2)])   -- 1%3
		                     , (2,[(VeryGood,1%2), (Good,1%2)])         -- 4%10
		                     ])
		            ]
		            [ node0 [ (This, [ (1,[(VeryGood,1%1)])
		                             , (2,[(Insufficient,1%1)])
		                             ])
		                    , (That, [ (1,[(Acceptable,1%1)])
		                             , (2,[(VeryGood,1%1)])
		                             ])
		                    ]
		            , node0 [ (This, [ (1,[(Acceptable,1%1)])
		                             , (2,[(ToReject,1%1)])
		                             ])
		                    , (That, [ (1,[(VeryGood,1%1)])
		                             , (2,[(Good,1%1)])
		                             ])
		                    ]
		            ]
		     ]
	 )
 ]

testSection ::
 Eq choice =>
 Hashable choice =>
 Eq judge =>
 Hashable judge =>
 Ord grade =>
 Show choice =>
 Show judge =>
 Show grade =>
 String ->
 Choices choice ->
 Judges judge grade ->
 Tree (SectionNode choice judge grade) ->
 Either (ErrorSection choice judge grade)
        (Tree (OpinionsByChoice choice judge grade)) ->
 TestTree
testSection msg cs js ss expect =
	testCase (elide msg) $
		opinionsBySection cs js ss @?= expect

node0 :: a -> Tree a
node0 = (`Node`[])

instance
 (Eq choice, Hashable choice) =>
 IsList (SectionNode choice judge grade) where
	type Item (SectionNode choice judge grade) = (choice, SectionByJudge judge grade)
	fromList = SectionNode Nothing . fromList
	toList = GHC.Exts.toList . sectionByJudgeByChoice