content: module W3Test where
  
  import W3
  import Impl.Test
  
  import Data.Either
  import Control.Monad
  import Test.QuickCheck hiding (Result,reason,classify,(===))
  
  main = testExs tests
  
  tests = [[property $ ex1_safeDiv_zero, property $ ex1_safeDiv_nonZero]
          ,[property $ ex2_eitherDiv_zero
           ,property $ ex2_eitherDiv_nonZero]
          ,[property $ ex3_mapMaybe_1, property $ ex3_mapMaybe_2]
          ,[property $ ex4_classify]
          ,[ex5_fred, ex5_age, ex5_name]
          ,[ex6_TwoCounters]
          ,[ex7_UpDown]
          ,[ex8_valAtRoot_Nothing, ex8_valAtRoot_Just]
          ,[ex9_treeSize]
          ,[ex10_leftest_Nothing, ex10_leftest_Just]
          ,[ex11_mapTree]
          ,[ex12_insertL]
          ,[ex13_measure]
          ,[property $ ex14_mysum, property $ ex14_mylength]
          ,[ex15_treeLeaves, ex15_treeSum]
          ,[ex16_rgb_red
           ,ex16_rgb_green
           ,ex16_rgb_blue
           ,ex16_rgb_darken
           ,ex16_rgb_mix
           ,ex16_rgb_complicated
           ]
          ]
  
  -- -- -- -- -- -- -- --
  
  ex1_safeDiv_zero x =
    safeDiv x 0 === Nothing
  
  ex1_safeDiv_nonZero x y =
    (y/=0) ==> safeDiv x y === Just (div x y)
  
  ex2_eitherDiv_zero x =
    eitherDiv x 0 === Left (show x++"/0")
  
  ex2_eitherDiv_nonZero x y =
    (y/=0) ==> eitherDiv x y === Right (div x y)
  
  ex3_mapMaybe_1 xs =
    counterexample ("let f True = Just True; f False = Nothing in mapMaybe f "++show xs) $
    mapMaybe f xs === filter id xs
    where f True = Just True
          f False = Nothing
  
  ex3_mapMaybe_2 :: [Integer] -> Property
  ex3_mapMaybe_2 is =
    counterexample ("let f x = if x>0 then Just (2*x) else Nothing\
                   \in mapMaybe f "++show is) $
    mapMaybe f is === map (2*) (filter (>0) is)
    where f x = if x>0 then Just (2*x) else Nothing
  
  ex4_classify :: [Either Integer Bool] -> Property
  ex4_classify es =
    classify es === partitionEithers es
  
  ex5_fred = property $ do
    conjoin [counterexample "getName fred" $
             getName fred === "Fred"
            ,counterexample "getAge fred" $
             getAge fred === 90]
  
  word = listOf1 (choose ('a','z'))
  
  ex5_name = property $ do
    n <- word
    return $ counterexample ("getName (setName "++show n++" fred)") $
      getName (setName n fred) === n
  
  ex5_age = property $ do
    a <- choose (0,89)
    return $ counterexample ("getAge (setAge "++show a++" fred)") $
      getAge (setAge a fred) === a
  
  ex6_TwoCounters = property $ do
    a <- choose (0,20)
    b' <- choose (0,20)
    let b = a+b'
    let tc0 = iterate (incA . incB) zeros !! a
        tc1 = iterate incB tc0 !! b'
    return $ counterexample ("Did "++show a++" incAs and "++show b++" incBs.") $
      (getA tc1, getB tc1) === (a,b)
  
  ex7_UpDown = property $ do
    a <- choose (0,20)
    b <- choose (0,20)
    let tc0 = iterate tick zero !! a
        tc1 = iterate tick (toggle tc0) !! b
    return $ counterexample ("Did "++show a++" ticks, a toggle, and "++show b++" ticks.") $
      get tc1 === a-b
  
  ex8_valAtRoot_Nothing =
    valAtRoot Leaf === (Nothing :: Maybe Bool)
  
  ex8_valAtRoot_Just = property $ do
    l <- genTree 3 :: Gen (Tree Integer)
    r <- genTree 3 :: Gen (Tree Integer)
    v <- choose (0,10 :: Integer)
    let t = Node v l r
    return $ counterexample (show t) $
      valAtRoot t === Just v
  
  genTree :: Arbitrary a => Int -> Gen (Tree a)
  genTree 0 = return Leaf
  genTree siz = do
    let siz' = siz-1
    sizl <- choose (0,siz')
    let sizr = siz'-sizl
    l <- genTree sizl
    r <- genTree sizr
    v <- arbitrary
    return $ Node v l r
  
  ex9_treeSize =
    forAllShrink (choose (0,50)) shrink $ \s -> do
      t <- genTree s
      return $ counterexample (show t) $
        treeSize (t :: Tree Int) === s
  
  genLeft :: Arbitrary a => a -> Int -> Gen (Tree a)
  genLeft k s = go s
    where go 0 = do t <- genTree s
                    return $ Node k Leaf t
          go n = do r <- genTree s
                    l <- go (n-1)
                    v <- arbitrary
                    return $ Node v l r
  
  ex10_leftest_Nothing = leftest Leaf === (Nothing :: Maybe Bool)
  
  ex10_leftest_Just = property $ do
    k <- choose (0,10)
    s <- choose (0,10)
    t <- genLeft k s
    return $ counterexample (show t) $
      leftest (t :: Tree Int) === Just k
  
  genL :: Int -> Gen (Tree Bool -> Tree Bool)
  genL s = go s
    where go 0 = do return $ id
          go n = do r <- genTree s
                    l <- go (n-1)
                    v <- arbitrary
                    return $ \k -> Node v (l k) r
  
  ex11_mapTree =
    forAllShrink (choose (0,50)) shrink $ \s -> do
      t <- genTree s
      let t' = mapTree (even::Int->Bool) t
      return $ counterexample ("mapTree even "++show t++"\returned:\n"++show t') $
        check t t'
    where check Leaf Leaf = property $ True
          check (Node a al ar) bt@(Node b bl br) =
            counterexample ("Alipuussa "++show bt) $
            conjoin [b === even a,
                     check al bl,
                     check ar br]
          check a b =
            counterexample ("Tree structures don't match:\n"++show a++"\n"++show b) False
  
  ex12_insertL =
    forAllShrink (choose (0,20)) shrink $ \s -> do
      f <- genL s
      let t0 = f Leaf
          t1 = f (Node True Leaf Leaf)
      return $ counterexample ("insertL True "++show t0) $
        insertL True t0 === t1
  
  genMeasure 0 = return $ Leaf
  genMeasure siz = do
    let siz' = siz-1
    sizl <- choose (0,siz')
    let sizr = siz'-sizl
    l <- genMeasure sizl
    r <- genMeasure sizr
    return $ Node siz l r
  
  zeroTree Leaf = Leaf
  zeroTree (Node _ l r) = Node 0 (zeroTree l) (zeroTree r)
  
  ex13_measure =
    forAllShrink (choose (0,20)) shrink $ \s -> do
      t <- genMeasure s
      let t' = zeroTree t :: Tree Int
      return $ counterexample (show t') $
        measure t' === t
  
  ex14_mysum :: [Int] -> Property
  ex14_mysum xs =
    foldr sumf 0 xs === sum xs
  
  ex14_mylength :: [Int] -> Property
  ex14_mylength xs =
    foldr lengthf 0 xs === length xs
  
  ex15_treeLeaves =
    forAllShrink (choose (0,20)) shrink $ \s -> do
      t <- genTree s
      let leaves = s+1
      return $ counterexample (show t) $
        foldTree leaft 1 (t :: Tree Bool) === leaves
  
  modTree k Leaf = Leaf
  modTree k (Node _ l r) = Node k (modTree k l) (modTree k r)
  
  ex15_treeSum = property $ do
    k <- choose (0,5 :: Int)
    s <- choose (0,5)
    t0 <- genTree s :: Gen (Tree ())
    let t = modTree k t0
    return $ counterexample (show t) $
      foldTree sumt 0 t === s*k
  
  ex16_rgb_red =
    counterexample (show Red) $
    rgb Red === [1,0,0]
  ex16_rgb_green =
    counterexample (show Green) $
    rgb Green === [0,1,0]
  ex16_rgb_blue =
    counterexample (show Blue) $
    rgb Blue === [0,0,1]
  
  fcmp actual expected =
    counterexample ("Expected " ++ show expected ++ ", got " ++ show actual) $
      diff < eps
    where diff = sum . map abs $ zipWith (-) actual expected
          eps = 0.01
  
  ex16_rgb_darken = property $ do
    s <- choose (0,1)
    let col = Darken s (Darken s Red)
    let ans = rgb col
    return $ counterexample (show col) $
      fcmp ans [(1-s)^2, 0, 0]
  
  ex16_rgb_mix = property $ do
    r <- choose (0,1)
    g <- choose (0,1)
    let col = Mix (Darken r Red) (Darken g Green)
    let ans = rgb col
    return $ counterexample (show col) $
      fcmp ans [(1-r), (1-g), 0]
  
  ex16_rgb_complicated = property $ do
    [r0,b0,g0,r1,b1,g1] <- replicateM 6 (choose (0,1))
    [x,y] <- replicateM 2 (choose (0,0.1))
    let c0 = Darken x (Mix (Darken (1-r0) Red) (Mix (Darken (1-b0) Blue) (Darken (1-g0) Green)))
        c1 = Mix (Darken (1-g1) Green) (Mix (Darken (1-b1) Blue) (Darken (1-r1) Red))
        c = Darken y (Mix c0 c1)
        ans = rgb c
        f = min 1
        x' = 1-x
        y' = 1-y
    return $ counterexample (show c) $
      fcmp ans [y'*(f $ x'*r0+r1),
                y'*(f $ x'*g0+g1),
                y'*(f $ x'*b0+b1)]
  