content: {-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}
  
  module Set6Test where
  
  import Data.List
  import Data.Maybe
  import Data.Char (toUpper)
  import Language.Haskell.TH.Syntax (lift,isInstance,mkName)
  import Test.QuickCheck
  
  import Mooc.Th
  import Mooc.Test
  
  import Set6
  
  testEquals x y exp = $(testing [|x == y|]) (?==exp)
  
  ex1 = conjoin [testEquals Finland Finland True
                ,testEquals Norway Norway True
                ,testEquals Switzerland Switzerland True
                ,testEquals Finland Norway False
                ,testEquals Finland Switzerland False
                ,testEquals Norway Finland False
                ,testEquals Norway Switzerland False
                ,testEquals Switzerland Finland False
                ,testEquals Switzerland Norway False]
  
  ex2 = conjoin
    [Finland ?<= Finland, Finland ?<= Norway, Finland ?<= Switzerland
    ,Norway ?<= Norway, Norway ?<= Switzerland
    ,Switzerland ?<= Switzerland
    ,Norway ?> Finland
    ,Switzerland ?> Norway, Switzerland ?> Finland
    ,$(testing [|compare Norway Switzerland|]) (?==LT)
    ,$(testing [|compare Finland Finland|]) (?==EQ)
    ,$(testing [|min Switzerland Norway|]) (?==Norway)
    ,$(testing [|max Norway Finland|]) (?==Norway)]
    where x ?<= y = $(testing [|x <= y|]) (?==True)
          x ?>  y = $(testing [|x > y|]) (?==True)
  
  word = listOf1 (choose ('a','z'))
  
  capitalizeOne :: String -> Gen String
  capitalizeOne [c] = return [toUpper c]
  capitalizeOne (c:cs) = oneof [return (toUpper c:cs)
                               ,(c:) <$> capitalizeOne cs]
  
  ex3 = property $ do
    name <- word
    diff <- word `suchThat` (/=name)
    namev1 <- capitalizeOne name
    namev2 <- capitalizeOne name
    diffv1 <- capitalizeOne diff
    return $ conjoin [testEquals (Name namev1) (Name namev2) True
                     ,testEquals (Name namev1) (Name diffv1) False
                     ,testEquals (Name namev1) (Name (namev1++diff)) False]
  
  fromList = foldr LNode Empty
  
  ex4_eq = forAll_ $ \(xs::[Bool]) -> testEquals (fromList xs) (fromList xs) True
  
  ex4_neq = forAll_ $ \(xs::[Int],ys) -> testEquals (fromList xs) (fromList ys) (xs == ys)
  
  ex5_egg = $(withInstance "Price" "Egg" [|price|]) $ \price -> conjoin [$(testing [|price ChocolateEgg|]) (?==30)
                                                                        ,$(testing [|price ChickenEgg|]) (?==20)]
  
  
  ex5_milk = $(withInstance "Price" "Milk" [|price|]) $ \price ->
    forAllBlind (choose (0,100)) $ \l ->
    $(testing [|price (Milk l)|]) (?==(15*l))
  
  ex6_maybe_egg =
    $(withInstanceType "Price" [t|Maybe Egg|] [|price|]) $ \price ->
    $(testing [|price [Just ChickenEgg]|]) (?==20)
  
  ex6_maybe_milk =
    $(withInstanceType "Price" [t|Maybe Milk|] [|price|]) $ \price ->
    forAllBlind (choose (0,100)) $ \l ->
    $(testing [|price [Just (Milk l)]|]) (?==(15*l))
  
  ex6_list_egg =
    $(withInstanceType "Price" [t|[Egg]|] [|price|]) $ \price ->
    $(testing [|price [ChocolateEgg, ChickenEgg]|]) (?==50)
  
  ex6_list_milk =
    $(withInstanceType "Price" [t|[Milk]|] [|price|]) $ \price ->
    forAllBlind (choose (0,100)) $ \l ->
    $(testing [|price [Milk l, Milk 1]|]) (?==(15*(l+1)))
  
  ex6_list_maybe_egg =
    $(withInstanceType "Price" [t|[Maybe Egg]|] [|price|]) $ \price ->
    conjoin [$(testing [|price [Just ChocolateEgg, Nothing, Just ChickenEgg]|]) (?==50)
            ,$(testing [|price [Nothing, Nothing, Nothing :: Maybe Egg]|]) (?==0)]
  
  
  ex6_list_maybe_milk =
    $(withInstanceType "Price" [t|[Maybe Milk]|] [|price|]) $ \price ->
    forAllBlind (choose (0,10)) $ \milk1 ->
    forAllBlind (choose (0,10)) $ \milk2 ->
    conjoin [$(testing [|price [Just (Milk milk1), Nothing, Just (Milk milk2)]|]) (?==(15*milk1+15*milk2))
            ,$(testing [|price [Nothing, Nothing, Nothing :: Maybe Milk]|]) (?==0)]
  
  instance Arbitrary Number where
    arbitrary = do
      b <- arbitrary
      if b then arbitrary >>= return . Finite else return Infinite
  
  ex7_eq_check =
    $(withInstance "Eq" "Number" [|(==) :: Number -> Number -> Bool|]) $ \(==) ->
    forAll_ $ \i ->
    forAll_ $ \j ->
    conjoin [$(testing [|Finite i == Finite j|]) (?==(i Prelude.== j))
            ,$(testing [|Finite i == Infinite|]) (?==False)
            ,$(testing [|Infinite == Infinite|]) (?==True)]
  
  ex7_finite_finite =
    $(withInstance "Ord" "Number" [|((<) :: Number -> Number -> Bool
                                    ,(>) :: Number -> Number -> Bool
                                    ,(<=) :: Number -> Number -> Bool
                                    ,(>=) :: Number -> Number -> Bool)|]) $ \((<),(>),(<=),(>=)) ->
    forAll_ $ \i ->
    forAll_ $ \(Positive delta) ->
    let a = Finite i
        b = Finite (i+delta)
    in conjoin [$(testing [|a < b|]) (?==True)
               ,$(testing [|b < a|]) (?==False)
               ,$(testing [|a > b|]) (?==False)
               ,$(testing [|b > a|]) (?==True)
               ,$(testing [|a <= b|]) (?==True)
               ,$(testing [|b <= a|]) (?==False)
               ,$(testing [|a >= b|]) (?==False)
               ,$(testing [|b >= a|]) (?==True)
               ]
  
  ex7_finite_infinite =
    $(withInstance "Ord" "Number" [|((<) :: Number -> Number -> Bool
                                    ,(>) :: Number -> Number -> Bool
                                    ,(<=) :: Number -> Number -> Bool
                                    ,(>=) :: Number -> Number -> Bool)|]) $ \((<),(>),(<=),(>=)) ->
    forAll_ $ \i ->
    let a = Finite i
        b = Infinite
    in conjoin [$(testing [|a < b|]) (?==True)
               ,$(testing [|b < a|]) (?==False)
               ,$(testing [|a > b|]) (?==False)
               ,$(testing [|b > a|]) (?==True)
               ,$(testing [|a <= b|]) (?==True)
               ,$(testing [|b <= a|]) (?==False)
               ,$(testing [|a >= b|]) (?==False)
               ,$(testing [|b >= a|]) (?==True)
               ]
  
  ex7_infinite_infinite =
    $(withInstance "Ord" "Number" [|((<) :: Number -> Number -> Bool
                                    ,(>) :: Number -> Number -> Bool
                                    ,(<=) :: Number -> Number -> Bool
                                    ,(>=) :: Number -> Number -> Bool)|]) $ \((<),(>),(<=),(>=)) ->
    conjoin [$(testing [|Infinite < Infinite|]) (?==False)
            ,$(testing [|Infinite > Infinite|]) (?==False)
            ,$(testing [|Infinite <= Infinite|]) (?==True)
            ,$(testing [|Infinite >= Infinite|]) (?==True)
            ]
  
  ex7_max_finite =
    $(withInstance "Ord" "Number" [|max :: Number -> Number -> Number|]) $ \max ->
    forAll_ $ \i ->
    forAll_ $ \j ->
    $(testing [|max (Finite i) (Finite j)|]) (?==Finite (Prelude.max i j))
  
  ex7_max_infinite =
    $(withInstance "Ord" "Number" [|max :: Number -> Number -> Number|]) $ \max ->
    forAll_ $ \i ->
    conjoin [$(testing [|max (Finite i) Infinite|]) (?==Infinite)
            ,$(testing [|max Infinite (Finite i)|]) (?==Infinite)
            ,$(testing [|max Infinite Infinite|]) (?==Infinite)]
  
  instance Arbitrary RationalNumber where
    arbitrary = do num <- arbitrary
                   (Positive den) <- arbitrary
                   return (RationalNumber num den)
  
  ex8_refl =
    $(withInstance "Eq" "RationalNumber" [|(==) :: RationalNumber -> RationalNumber -> Bool|]) $ \(==) ->
    forAll_ $ \r ->
    $(testing [|r == r|]) (?==True)
  
  ex8_eq = $(withInstance "Eq" "RationalNumber" [|(==) :: RationalNumber -> RationalNumber -> Bool|]) $ \(==) ->
    forAll_ $ \r@(RationalNumber p q) ->
    forAll_ $ \(NonZero i) ->
    forAll_ $ \(NonZero j) ->
    conjoin [$(testing [|r == (RationalNumber (i*p) (i*q))|]) (?==True)
            ,$(testing [|r == (RationalNumber (i*p+j) (i*q))|]) (?==False)]
  
  primes = nubBy (\x y -> mod y x == 0) [2..]
  genPrime = elements $ take 100 primes
  
  identical :: RationalNumber -> RationalNumber -> Bool
  identical (RationalNumber a b) (RationalNumber c d) = a==c && b==d
  
  exactly should was = expectation should was (identical should was)
  
  genSimpl = do
    q <- genPrime
    p <- choose (1,q-1)
    return $ RationalNumber p q
  
  ex9_prime = forAllBlind genSimpl $ \(RationalNumber p q) ->
    forAll_ $ \(Positive i) ->
    $(testing [|simplify (RationalNumber (i*p) (i*q))|]) (exactly (RationalNumber p q))
  
  ex9_eq = forAll_ $ \r@(RationalNumber p q) ->
    forAll_ $ \(Positive i) ->
    let s = RationalNumber (i*p) (i*q)
    in $(testing [|simplify r|]) . was $ \r' ->
      $(testing [|simplify s|]) . was $ \s' ->
      counterexample "  Should be the same" (identical r' s')
  
  ex10_add_zero = $(withInstance "Num" "RationalNumber" [|(+) :: RationalNumber -> RationalNumber -> RationalNumber|]) $ \(+) ->
    forAllBlind genSimpl $ \r ->
    forAll_ $ \(Positive q) ->
    $(testing [|r + (RationalNumber 0 q)|]) (exactly r)
  
  ex10_add_commut = $(withInstance "Num" "RationalNumber" [|(+) :: RationalNumber -> RationalNumber -> RationalNumber|]) $ \(+) ->
    forAll_ $ \r ->
    forAll_ $ \s ->
    $(testing [|r + s|]) . was $ \was1 ->
    $(testing [|s + r|]) . was $ \was2 ->
    counterexample "  Should be the same" (identical was1 was2)
  
  ex10_add_whole = $(withInstance "Num" "RationalNumber" [|(+) :: RationalNumber -> RationalNumber -> RationalNumber|]) $ \(+) ->
    forAll_ $ \(Positive q) ->
    forAll_ $ \(i,j) ->
    $(testing [|RationalNumber (q*i) q + RationalNumber (q*j) q|]) (exactly (RationalNumber (i Prelude.+ j) 1))
  
  ex10_add = $(withInstance "Num" "RationalNumber" [|(+) :: RationalNumber -> RationalNumber -> RationalNumber|]) $ \(+) ->
    forAll_ $ \(Positive n) ->
    $(testing [|RationalNumber 1 (n Prelude.+ 1) + RationalNumber 1 (n*(n Prelude.+ 1))|]) (exactly (RationalNumber 1 n))
  
  ex10_multiply_one = $(withInstance "Num" "RationalNumber" [|(*) :: RationalNumber -> RationalNumber -> RationalNumber|]) $ \(*) ->
    forAllBlind genSimpl $ \r ->
    forAll_ $ \(Positive q) ->
    $(testing [|r * (RationalNumber q q)|]) (exactly r)
  
  ex10_multiply_commut = $(withInstance "Num" "RationalNumber" [|(*) :: RationalNumber -> RationalNumber -> RationalNumber|]) $ \(*) ->
    forAll_ $ \r ->
    forAll_ $ \s ->
    $(testing [|r * s|]) . was $ \was1 ->
    $(testing [|s * r|]) . was $ \was2 ->
    counterexample "  Should be the same" (identical was1 was2)
  
  ex10_multiply_inverse = $(withInstance "Num" "RationalNumber" [|(*) :: RationalNumber -> RationalNumber -> RationalNumber|]) $ \(*) ->
    forAllBlind genPrime $ \p ->
    forAllBlind genPrime $ \q ->
    $(testing [|RationalNumber p q * RationalNumber q p|]) (exactly (RationalNumber 1 1))
  
  ex10_multiply = $(withInstance "Num" "RationalNumber" [|(*) :: RationalNumber -> RationalNumber -> RationalNumber|]) $ \(*) ->
    forAllBlind genPrime $ \p ->
    forAllBlind genPrime $ \q ->
    forAllBlind genPrime $ \r ->
    nub [p,q,r] == [p,q,r] ==>
    forAll_ $ \(Positive i) ->
    $(testing [|RationalNumber (i Prelude.* p) q * RationalNumber q (r Prelude.* i)|]) (exactly (RationalNumber p r))
  
  ex10_abs = $(withInstance "Num" "RationalNumber" [|abs :: RationalNumber -> RationalNumber|]) $ \abs ->
    forAllBlind genSimpl $ \r@(RationalNumber p q) ->
    conjoin [$(testing [|abs (RationalNumber (-p) q)|]) (exactly r)
            ,$(testing [|abs r|]) (exactly r)]
  
  ex10_signum_abs = $(withInstance "Num" "RationalNumber" [|abs :: RationalNumber -> RationalNumber|]) $ \abs ->
    forAll_ $ \r ->
    counterexample "signum r * abs r == r" $
    counterexample ("  failed with r = " ++ show r) $
    signum r * abs r == r
  
  ex10_fromInteger = $(withInstance "Num" "RationalNumber" [|fromInteger :: Integer -> RationalNumber|]) $ \fromInteger ->
    forAll_ $ \(i,j) ->
    counterexample ("fromIntegral "++show i++" + fromIntegral "++show j) $
    exactly (RationalNumber (i+j) 1) (fromIntegral i + fromIntegral j)
  
  ex10_negate = $(withInstance "Num" "RationalNumber" [|negate :: RationalNumber -> RationalNumber|]) $ \negate ->
    forAll_ $ \r ->
    counterexample ("("++show r++") + negate ("++show r++")") $
    exactly (RationalNumber 0 1) (r + negate r)
  
  ex11_integer = $(withInstance "Addable" "Integer" [|(zero::Integer,add::Integer->Integer->Integer)|]) $ \(zero,add) ->
    forAll_ $ \(x::Integer,y) ->
    conjoin [$(testing [|add x y|]) (?==x+y)
            ,$(testing [|add zero x|]) (?==x)]
  
  ex11_list = $(withInstance1 "Addable" "[]" [|(zero::[Bool],add::[Bool]->[Bool]->[Bool])|]) $ \(zero,add) ->
    forAll_ $ \(x::[Bool],y) ->
    conjoin [$(testing [|add x y|]) (?==x++y)
            ,$(testing [|add zero x|]) (?==x)
            ,$(testing [|add x zero|]) (?==x)]
  
  ex12_step_color = $(withInstance "Cycle" "Color" [|step|]) $ \step ->
    conjoin [$(testing [|step Red|]) (?==Green)
            ,$(testing [|step Green|]) (?==Blue)
            ,$(testing [|step Blue|]) (?==Red)]
  
  ex12_step_suit = $(withInstance "Cycle" "Suit" [|step|]) $ \step ->
    conjoin [$(testing [|step Club|]) (?==Spade)
            ,$(testing [|step Spade|]) (?==Diamond)
            ,$(testing [|step Diamond|]) (?==Heart)
            ,$(testing [|step Heart|]) (?==Club)]
  
  ex12_stepMany_color = $(withInstance "Cycle" "Color" [|stepMany|]) $ \stepMany ->
    property $ do
      let vals = [Red,Green,Blue]
      i <- choose (0,2)
      j <- choose (0,20)
      return $ $(testing [|stepMany j (vals!!i)|]) (?==vals!!(mod (i+j) 3))
  
  ex12_stepMany_suit = $(withInstance "Cycle" "Suit" [|stepMany|]) $ \stepMany ->
    property $ do
      let vals = [Club,Spade,Diamond,Heart]
      i <- choose (0,3)
      j <- choose (0,20)
      return $ $(testing [|stepMany j (vals!!i)|]) (?==vals!!(mod (i+j) 4))
  
  ex12_stepMany_class = $(classContains "Cycle" "stepMany")
  
  $(defineInstance "Cycle" ''Int "step" [|succ|])
  
  $(return []) -- hack to make next test see instance
  
  ex12_stepMany_default = counterexample "After defining\n  instance Cycle Int where step = succ" $
    $(withInstance "Cycle" "Int" [|stepMany|]) $ \stepMany ->
    forAllBlind (choose (0,100::Int)) $ \n ->
    forAllBlind (choose (0,100::Int)) $ \m ->
    $(testing [|stepMany n m|]) (?==n+m)
  
  -- -- -- -- -- -- -- -- tests need to be defined after TH splice above
  
  main = score tests
  
  tests = [(1,"Eq Country",[ex1])
          ,(2,"Ord Country",[ex2])
          ,(3,"Eq Name",[ex3])
          ,(4,"Eq List",[ex4_eq, ex4_neq])
          ,(5,"Price",[ex5_egg, ex5_milk])
          ,(6,"Price List",[ ex6_maybe_egg, ex6_maybe_milk
                           , ex6_list_egg, ex6_list_milk
                           , ex6_list_maybe_egg, ex6_list_maybe_milk])
          ,(7,"Ord Number",[ ex7_eq_check
                           , ex7_finite_finite, ex7_finite_infinite, ex7_infinite_infinite
                           , ex7_max_finite, ex7_max_infinite ])
          ,(8,"Eq RationalNumber",[ex8_refl, ex8_eq])
          ,(9,"simplify",[ex9_prime, ex9_eq])
          ,(10,"Num RationalNumber",[ex10_add_zero, ex10_add_commut, ex10_add_whole, ex10_add
                                    ,ex10_multiply_one, ex10_multiply_commut, ex10_multiply_inverse, ex10_multiply
                                    ,ex10_abs
                                    ,ex10_signum_abs
                                    ,ex10_fromInteger
                                    ,ex10_negate
                                    ])
          ,(11,"Addable",[ex11_integer, ex11_list])
          ,(12,"Cycle",[ex12_step_color, ex12_step_suit, ex12_stepMany_color, ex12_stepMany_suit
                       ,ex12_stepMany_class, ex12_stepMany_default])
          ]
  