hjugement/tests/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 )