hjugement/tests/QuickCheck/Rank.hs

   1 {-# LANGUAGE TypeApplications #-}
   2 module QuickCheck.Rank where
   3 import Data.Bool
   4
   5 import Data.Eq (Eq(..))
   6 import Data.Function (($))
   7 import Data.Functor ((<$>))
   8 import Data.Ratio (numerator)
   9 import Prelude (Enum(..), (*), fromIntegral)
  10 import Test.Tasty
  11 import Test.Tasty.QuickCheck
  12 import qualified Data.List as List
  13
  14 import Majority.Merit
  15 import Majority.Value
  16 import Majority.Rank
  17 import Types
  18 import QuickCheck.Value ()
  19
  20 quickcheck :: TestTree
  21 quickcheck =
  22         testGroup "Rank"
  23          [ testGroup "majorityValueOfRank . rankOfMajorityValue == id"
  24                  [ testProperty "SchoolGrade" $ testMVRankMV @SchoolGrade
  25                  , testProperty "DanishSchoolGrade" $ testMVRankMV @DanishSchoolGrade
  26                  ]
  27          ]
  28
  29 testMVRankMV :: forall g. Enum g => MajorityValue g -> Bool
  30 testMVRankMV mv =
  31         let gs = fromIntegral $ List.length (enumFrom (toEnum 0) :: [g]) in
  32         let js = numerator $ (2 *) $ List.sum $ middleShare <$> unMajorityValue mv in
  33         majorityValueOfRank js gs (rankOfMajorityValue gs mv') == mv'
  34         where
  35         ranked a = Ranked (fromIntegral (fromEnum a), ())
  36         mv' = MajorityValue $
  37                 (<$> unMajorityValue mv) $ \(Middle s l h) ->
  38                         Middle s (ranked l) (ranked h)