]> Git — Sourcephile - majurity.git/blob - hjugement/test/QuickCheck/Value.hs
protocol: Add Election
[majurity.git] / hjugement / test / QuickCheck / Value.hs
1 {-# OPTIONS_GHC -fno-warn-orphans #-}
2 module QuickCheck.Value where
3
4 import Data.Bool
5 import Control.Monad (Monad(..))
6 import Data.Eq (Eq(..))
7 import Data.Function (($), (.))
8 import Data.Functor ((<$>))
9 import Data.Ord (Ord(..))
10 import Prelude (Enum(..), Bounded(..))
11 import Test.Tasty
12 import Test.Tasty.QuickCheck
13 import qualified Data.List as List
14
15 import Majority.Value
16 import Types
17 import QuickCheck.Merit
18 import QuickCheck.Utils
19
20 quickcheck :: TestTree
21 quickcheck =
22 testGroup "Value"
23 [ testGroup "MajorityValue"
24 [ testProperty "compare" $ \(SameLength (x::MajorityValue SchoolGrade,y)) ->
25 expandValue x `compare` expandValue y == x`compare`y
26 ]
27 ]
28
29 instance
30 (Bounded g, Enum g, Ord g, Arbitrary g) =>
31 Arbitrary (MajorityValue g) where
32 arbitrary = List.head . (majorityValue <$>) <$> arbitraryMerits 1
33 shrink (MajorityValue vs)
34 | List.null vs = []
35 | otherwise = (MajorityValue <$>) $ List.tail $ List.tails vs
36 instance (Bounded g, Enum g) => Arbitrary (Middle g) where
37 arbitrary = do
38 lowG <- choose (fromEnum(minBound::g), fromEnum(maxBound::g))
39 highG <- choose (lowG, fromEnum(maxBound::g))
40 share <- choose (0, 1)
41 return $ Middle share (toEnum lowG) (toEnum highG)
42 instance
43 (Arbitrary g, Bounded g, Enum g, Ord g) =>
44 Arbitrary (SameLength (MajorityValue g, MajorityValue g)) where
45 arbitrary = do
46 SameLength (x,y) <- arbitrary
47 return $ SameLength (MajorityValue x, MajorityValue y)
48 instance
49 (Arbitrary g, Bounded g, Enum g, Ord g) =>
50 Arbitrary (SameLength ([Middle g], [Middle g])) where
51 arbitrary = do
52 SameLength (m0, m1) <- arbitrary
53 return $ SameLength
54 ( unMajorityValue $ majorityValue m0
55 , unMajorityValue $ majorityValue m1 )