{-# LANGUAGE GADTs #-}

module Tests_04(runTests, boolTests) where

import Template_04(ite, find, polymorphicFind,
  suffixes, removeLast, height, flatten, isSearchTree, Tree(..))
import Test.LeanCheck
import Data.List (sort, tails)

-- Generic Setup 
data Test = forall a. Testable a => Test String String a

runTests = flip mapM_ tests
  (\ (Test ex name t) -> putStrLn ("running " ++ ex ++ "(" ++ name ++ ")" ++ "-tests") >> checkFor 1000 t)

-- Tests for this week 

lookupEither :: (Eq a, Show a) => a -> [(a,b)] -> Either String b
lookupEither x m = case lookup x m of
  Nothing -> Left $ "cannot find " ++ show x
  Just v -> Right v

findTest :: (Eq b) => Char -> [(Char, b)] -> Bool
findTest x m = find x m == lookupEither x m 

polymorphicFindTest :: (Eq a, Eq b) => a -> [(a, b)] -> Bool
polymorphicFindTest x m = polymorphicFind x m == lookup x m

suffixesTest :: (Eq a) => [a] -> Bool
suffixesTest xs = suffixes xs == tails xs

removeLastTest :: (Eq a) => [a] -> Bool
removeLastTest [] = null (removeLast [])
removeLastTest xs = removeLast xs == init xs


instance Listable a => Listable (Tree a) where
  tiers = cons1 Leaf \/ cons3 Node

data GenTree = GLeft | GRight | GBoth deriving Show
instance Listable GenTree where
  tiers = cons0 GLeft \/ cons0 GRight \/ cons0 GBoth

genTree [] = Leaf ()
genTree (GLeft : dirs) = let t = genTree dirs in Node () t (Leaf ())
genTree (GRight : dirs) = let t = genTree dirs in Node () (Leaf ()) t
genTree (GBoth : dirs) = let t = genTree dirs in Node () t t

heightTest :: [GenTree] -> Bool
heightTest dirs 
  | height (genTree dirs) == fromIntegral (length dirs) = True
  | otherwise = error $ "height (" ++ show (genTree dirs) ++ ") /= " ++ show (length dirs)

flattenTest :: [Int] -> Bool
flattenTest xs = odd (length xs) ==> flatten (listToTree xs) == xs

listToTree :: [Int] -> Tree Int
listToTree [] = error "Empty list cannot be converted to a tree"
listToTree [x] = Leaf x
listToTree xs
  | odd (length xs) =
      let mid = length xs `div` 2
          newMid = if even mid then mid - 1 else mid
          root = xs !! newMid
          left = take newMid xs
          right = drop (newMid + 1) xs
      in Node root (listToTree left) (listToTree right)
  | otherwise = error "List of even length cannot be converted to a tree"

isSearchTreeTest :: Bool
isSearchTreeTest = isSearchTree (listToTree [1,2,3,4,5,6,7])
  && isSearchTree (listToTree [1])
  && not (isSearchTree (listToTree [3,5,2,7,4]))
  && not (isSearchTree (listToTree [3,4,4]))


tests :: [Test]
tests = [
  Test "1.1" "findInt" (findTest :: Char -> [(Char, Int)] -> Bool),
  Test "1.1" "findString" (findTest :: Char -> [(Char, [Char])] -> Bool),
  Test "1.2" "polymorphicFindInt" (polymorphicFindTest :: Int -> [(Int, Char)] -> Bool),
  Test "1.2" "polymorphicFindChar" (polymorphicFindTest :: Char -> [(Char, Char)] -> Bool),
  Test "1.2" "polymorphicFindString" (polymorphicFindTest :: String -> [(String, Int)] -> Bool),
  Test "1.3" "suffixesInt" (suffixesTest :: [Int] -> Bool),
  Test "1.3" "suffixesString" (suffixesTest :: [Char] -> Bool),
  Test "1.4" "removeLastInt" (removeLastTest :: [Int] -> Bool),
  Test "1.4" "removeLastString" (removeLastTest :: [Char] -> Bool),
  Test "3.1" "height" (heightTest :: [GenTree] -> Bool),
  Test "3.2" "flatten" (flattenTest :: [Int] -> Bool),
  Test "3.3" "isSearchTree" (isSearchTreeTest :: Bool)
  ]

boolTests :: [((String,String), Bool)]
boolTests = map (\ (Test ex n t) -> ((ex,n), holds 1000 t)) tests