Value.hs

{-# OPTIONS_GHC -fno-warn-orphans #-}
module QuickCheck.Value where
import Majority.Value
import Types
import Data.List (head)

import QuickCheck.Merit
import QuickCheck.Utils

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

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

instance
 (Bounded g, Eq g, Integral g, Arbitrary g) =>
 Arbitrary (MajorityValue g) where
	arbitrary = head . (majorityValue <$>) <$> arbitraryMerits 1
	shrink (MajorityValue vs) = MajorityValue <$> shrink 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 )