content: {-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}
  
  module Set3aTest where
  
  --import Control.Monad
  import Data.Char
  import Data.List
  import Test.QuickCheck
  
  import Mooc.Th
  import Mooc.Test
  
  import Set3a
  
  main = score tests
  
  tests = [(1,"maxBy",[ex1_maxBy])
          ,(2,"mapMaybe",[ex2_mapMaybe_Nothing, ex2_mapMaybe_Just_String, ex2_mapMaybe_Just_Int])
          ,(3,"mapMaybe2",[ex3_mapMaybe2])
          ,(4,"palindromeHalfs",[ex4_palindromeHalfs])
          ,(5,"capitalize",[ex5_capitalize_1, ex5_capitalize_2])
          ,(6,"powers",[ex6_powers_small, ex6_powers_large])
          ,(7,"while",[ex7_while_number, ex7_while_string])
          ,(8,"whileRight",[ex8_whileRight_Left, ex8_whileRight_step])
          ,(9,"joinToLength",[ex9_1])
          ,(10,"+|+",[ex10])
          ,(11,"sumRights",[ex11])
          ,(12,"multiCompose",[ex12_empty, ex12_scalability, ex12_arithmetic, ex12_strings])
          ,(13,"multiApp",[ex13_empty, ex13_scalability, ex13_arithmetic, ex13_strings, ex13_mixed])
          ,(14,"interpreter",[ex14_interpreter_1, ex14_interpreter_2])
          ]
  
  -- -- -- -- -- --
  
  letter = choose ('a','z')
  word = listOf1 letter
  
  ex1_maxBy = property $ do
    t <- choose (0,20)
    f <- choose (0,20) `suchThat` \f -> f/=t
    let p True = t
        p False = f
    return $
      counterexample ("let p True = "++show t++"; p False = "++show f++" in maxBy p False True") $
      maxBy p False True ?== (t>f)
  
  ex2_mapMaybe_Nothing =
    $(testing' [|mapMaybe negate Nothing|]) (?==Nothing)
  
  ex2_mapMaybe_Just_String = forAllBlind word $ \w ->
    counterexample ("mapMaybe length (Just " ++ show w ++ ")") $
    mapMaybe length (Just w) ?== Just (length w)
  
  ex2_mapMaybe_Just_Int = forAll_ $ \(i::Int) ->
    counterexample ("mapMaybe negate (Just " ++ show i ++ ")") $
    mapMaybe negate (Just i) ?== Just (negate i)
  
  ex3_mapMaybe2 = forAll_ $ \(Positive i,Positive j) ->
    let t :: Maybe Integer -> Maybe Integer -> Maybe Integer -> Property
        t a b exp = counterexample ("mapMaybe div " ++ show' a ++ " " ++ show' b) $ mapMaybe2 div a b ?== exp
    in conjoin [t (Just i) (Just j) (Just (div i j))
               ,t Nothing (Just j) Nothing
               ,t (Just i) Nothing Nothing
               ,t Nothing Nothing Nothing]
  
  unpalindrome = word `suchThat` \w -> w /= reverse w
  
  ex4_palindromeHalfs = property $ do
    half1 <- word
    let palindrome1 = half1 ++ reverse half1
    half2 <- word
    let palindrome2 = half2 ++ reverse (init half2)
    un1 <- listOf1 unpalindrome
    un2 <- listOf1 unpalindrome
    un3 <- listOf1 unpalindrome
    let input = un1 ++ [palindrome1] ++ un2 ++ [palindrome2] ++ un3
    let expected = [half1, half2]
    let palindromeHalfs xs = map firstHalf (filter palindrome xs)
    return $ $(testing [|palindromeHalfs input|]) (?==expected)
  
  ex5_capitalize_1 = property $ do
    cap <- letter
    w1 <- word
    w2 <- word
    return $ $(testing [|capitalize (cap:w1++" "++cap:w2)|]) (?==(toUpper cap:w1++" "++toUpper cap:w2))
  
  ex5_capitalize_2 = property $ do
    ws <- listOf1 word
    let input = unwords ws
    let positions = init $ scanl (+) 0 $ map (succ.length) ws
    p <- elements positions
    q <- elements [0..length input - 1]
    return . $(testing [|capitalize input|]) $ \v ->
      conjoin [counterexample ("char at index "++show p) $ v !! p ?== toUpper (input !! p)
              ,not (elem q positions) ==> counterexample ("char at index "++show q) (v !! q ?== input !! q)]
  
  m_powers maxlen = property $ do
    n <- choose (2,5)
    len <- choose (1,maxlen)
    end <- choose (n^(len-1),n^len-1)
    return $ $(testing [|powers n end|]) $ \p -> conjoin
      [counterexample "all smaller than end" $ all (<=end) p
      ,counterexample "in ascending order" $ p == sort p
      ,counterexample "length" $ length p ?== len
      ,counterexample "all powers of n" $ all (check n) p]
    where check n 0 = True
          check n 1 = True
          check n k
            | k `mod` n == 0    = check n (div k n)
            | otherwise         = False
  
  ex6_powers_small = m_powers 5
  ex6_powers_large = m_powers 27 -- 5^27 still fits in Int
  
  ex7_while_number = property $ do
    n <- choose (0,20 :: Integer)
    return $ counterexample ("while (/="++show n++") (+1) 0") $ within timeLimit $
      while (/=n) (+1) 0 ?== n
  
  ex7_while_string = property $ do
    n <- word
    let w = n++n
        p = (/=n)
    return $ counterexample ("while (/="++show n++") tail "++show w) $ within timeLimit $
      while p tail w == n
  
  ex8_whileRight_Left = forAllBlind word $ \w ->
    forAllBlind (choose (1::Int,10)) $ \i ->
    counterexample ("let f _ = Left " ++ show w ++ " in whileRight f " ++ show i) $ within timeLimit $
    let f _ = Left w in whileRight f i ?== w
  
  ex8_whileRight_step = property $ do
    let step :: Int -> Int -> Either Int Int
        step k x = if x<k then Right (2*x) else Left x
    limit <- choose (1,1000)
    start <- elements [1,3,5]
    let log = ceiling . logBase 2 . fromIntegral
        divUp x y = ceiling (fromIntegral x / fromIntegral y)
        answer = start * 2 ^ (log (limit `divUp` start))
    return $ counterexample ("whileRight (step " ++ show limit ++ ") " ++ show start) $ within timeLimit $
      whileRight (step limit) start ?== answer
  
  ex9_1 = property $ do
    w <- word
    v <- word `suchThat` diffLength w
    let target = length w + length v
    cruft <- listOf1 word
    let input = sort $
                ([w,v]++) $
                nubBy (\x y -> length x + length y == target) $
                filter (\x -> 2 * length x /= target) $
                filter (\x -> diffLength x v && diffLength x w) $
                cruft
        output = [w++v, v++w]
    return $ $(testing [|joinToLength target input|]) (hasElements output)
    where diffLength a b = length a /= length b
  
  ex10 = $(withDefined "+|+") $ \op ->
    forAll_ $ \(x::Int,y::Int,xs'::[Int],ys'::[Int]) ->
    let xs = x:xs'
        ys = y:ys'
    in conjoin [counterexample (show xs ++ " +|+ " ++ show ys) $ op xs ys ?== [x,y]
               ,counterexample (show xs ++ " +|+ []") $ op xs [] ?== [x]
               ,counterexample ("[] +|+ " ++ show xs) $ op [] xs ?== [x]]
  
  ex11 = property $ do
    is <- listOf (choose (0,10))
    es <- listOf word
    input <- shuffle (map Right is ++ map Left es)
    return $ $(testing [|sumRights input|]) (?==sum is)
  
  ex12_empty = property $ do
    n <- choose (0,9) :: Gen Int
    let input  = multiCompose [] n
        output = n
    return $ counterexample ("multiCompose [] " ++ show n)
           $ input ?== output
  
  ex12_scalability = property $ do
    n <- choose (0,9) :: Gen Int
    let input  = multiCompose (replicate n (succ::Int->Int)) 0
        output = n
    return $ counterexample ("multiCompose (replicate " ++ show n ++ " succ) 0")
           $ input ?== output
  
  ex12_arithmetic = property $ do
    n  <- choose (0,5) :: Gen Int
    let input  = multiCompose [(3*), (^2), (+1)] n
        output = ((3*) . (^2) . (+1)) n
    return $ counterexample ("multiCompose [(3*), (^2), (+1)] " ++ show n)
           $ input ?== output
  
  ex12_strings = property $ do
    s <- listOf letter `suchThat` (\t -> length t > 1)
    let input  = multiCompose [(++"xy"), reverse, tail, reverse] s
        output = (++"xy") . reverse . tail . reverse $ s
    return $ counterexample ("multiCompose [(++\"xy\"), reverse, tail, reverse] " ++ show s)
           $ input ?== output
  
  ex13_empty = property $ do
    n <- choose (0,9) :: Gen Int
    let input  = multiApp id [] n
        output = [] :: [Int]
    return $ counterexample ("multiApp id [] " ++ show n)
           $ input ?== output
  
  ex13_scalability = property $ do
    n <- choose (0,9) :: Gen Int
    k <- choose (0,9) :: Gen Int
    let input  = multiApp (sum::[Int]->Int) (replicate n (succ::Int->Int)) k
        output = n*(k+1)
    return $ counterexample ("multiApp sum (replicate " ++ show n ++ " succ) " ++ show k)
           $ input ?== output
  
  ex13_arithmetic = property $ do
    n  <- choose (0,9) :: Gen Int
    let gs     = [(+1), (*2), (`div`2), (^2)]
        input  = multiApp (sum::[Int]->Int) gs n
        output = (n + 1) + (n * 2) + (n `div` 2) + n^2
    return $ counterexample ("multiApp sum [(+1), (*2), (`div`2), (^2)]" ++ show n)
           $ input ?== output
  
  ex13_strings = property $ do
    words <- vectorOf 3 word
    let gs     = [(\xs -> [head xs]), tail, reverse]
        input  = multiApp id gs words
        output = [[head words], tail words, reverse words]
    return $ counterexample ("multiApp id [(\\xs -> [head xs]), tail, reverse]" ++ show words)
           $ input ?== output
  
  ex13_mixed = counterexample ("multiApp sum [head, last] [1,2,3,4]") $
               multiApp (sum::[Int]->Int) [head, last] [1::Int,2,3,4] ?== 5
  
  ex14_interpreter_1 = property $ do
    up <- choose (0,10)
    right <- choose (0,10)
    down <- choose (1,3)
    left <- choose (0,1)
  
    let first = replicate up "up" ++ replicate right "right" ++ ["printY","printX"]
        second = replicate down "down" ++ replicate left "left" ++ ["printY","printX"]
        input = first ++ second
        output = [show up, show right, show (up-down), show (right-left)]
  
    return $ counterexample ("interpreter "++show input) $
      interpreter input ?== output
  
  ex14_interpreter_2 = property $ do
    nums <- vectorOf 4 $ choose (0,10)
    let diffs = zipWith (-) nums (0:nums)
        f x | x<0 = replicate (negate x) "down"
            | otherwise = replicate x "up"
        input = concatMap (\x -> f x ++ ["printY"]) diffs
        output = map show nums
    return $ $(testing [|interpreter input|]) (?== output)
  