hjugement/tests/Bug.hs

   1 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
   2 module Bug where
   3
   4 import Hjugement
   5
   6 -- | Decompress a 'Value'.
   7 expandValue :: Value a -> [a]
   8 expandValue (Value []) = []
   9 expandValue (Value ((x,c):xs)) = replicate c x ++ expandValue (Value xs)
  10
  11 data Grade = Null | Pass | Good
  12  deriving (Eq, Ord, Show, Bounded, Enum)
  13
  14 (meritX,meritY) = (Merit (fromList [(Null,1),(Pass,71-50-3),(Good,15-3)])
  15                   ,Merit (fromList [(Null,7),(Pass,68-50-3),(Good,12-3)]))
  16
  17 totX = let Merit x = meritX in sum x
  18 totY = let Merit x = meritY in sum x
  19
  20 (mgX,mgY) = (majorityGauge meritX,majorityGauge meritY)
  21 (mvX,mvY) = (majorityValue meritX,majorityValue meritY)
  22 mgC = compare mgX mgY
  23 mvC = compare mvX mvY
  24
  25 allX = expandValue (majorityValue meritX)
  26 allY = expandValue (majorityValue meritY)
  27
  28 (simpX, simpY) = simpl allX allY
  29
  30 simpl [] ys = ([], ys)
  31 simpl xs [] = (xs, [])
  32 simpl (x:xs) (y:ys) | x == y = simpl xs ys
  33                     | otherwise = (xs, ys)