Value.hs

{-# OPTIONS_GHC -fno-warn-orphans #-}
module QuickCheck.Value where

import Data.Bool
import Control.Monad (Monad(..))
import Data.Eq (Eq(..))
import Data.Function (($), (.))
import Data.Functor ((<$>))
import Data.Ord (Ord(..))
import Prelude (Enum(..), Bounded(..))
import Test.Tasty
import Test.Tasty.QuickCheck
import qualified Data.List as List

import Majority.Value
import Types
import QuickCheck.Merit
import QuickCheck.Utils

quickcheck :: TestTree
quickcheck =
	testGroup "Value"
	 [ testGroup "MajorityValue"
		 [ testProperty "compare" $ \(SameLength (x::MajorityValue SchoolGrade,y)) ->
			expandValue x `compare` expandValue y == x`compare`y
		 ]
	 ]

instance
 (Bounded g, Enum g, Ord g, Arbitrary g) =>
 Arbitrary (MajorityValue g) where
	arbitrary = List.head . (majorityValue <$>) <$> arbitraryMerits 1
	shrink (MajorityValue vs)
	 | List.null vs = []
	 | otherwise = (MajorityValue <$>) $ List.tail $ List.tails vs
instance (Bounded g, Enum g) => Arbitrary (Middle g) where
	arbitrary = do
		lowG  <- choose (fromEnum(minBound::g), fromEnum(maxBound::g))
		highG <- choose (lowG, fromEnum(maxBound::g))
		share <- choose (0, 1)
		return $ Middle share (toEnum lowG) (toEnum highG)
instance
 (Arbitrary g, Bounded g, Enum g, Ord g) =>
 Arbitrary (SameLength (MajorityValue g, MajorityValue g)) where
	arbitrary = do
		SameLength (x,y) <- arbitrary
		return $ SameLength (MajorityValue x, MajorityValue y)
instance
 (Arbitrary g, Bounded g, Enum g, Ord g) =>
  Arbitrary (SameLength ([Middle g], [Middle g])) where
	arbitrary = do
		SameLength (m0, m1) <- arbitrary
		return $ SameLength
		 ( unMajorityValue $ majorityValue m0
		 , unMajorityValue $ majorityValue m1 )