{-# LANGUAGE GADTs, PartialTypeSignatures #-}

module Tests_05(runTests, boolTests) where

import Template_05(large, largeFast, biLookupIte, biLookupGuarded,factorial,
  euler, factorialListNaive, factorialList, eulerList, eulerConvergence)
import Test.LeanCheck
import Test.LeanCheck.Error (errorToNothing)
import Data.Tuple (swap)

-- 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 

data AtoE = A | B | C | D | E deriving (Show, Eq)

instance Listable AtoE where
  tiers = [[A,B,C,D,E]]

newtype SmallNums = SNum { snum :: Integer }

instance Show SmallNums where
  show = show . snum

instance Listable SmallNums where
  tiers = [map SNum [0..30]]

largeEqTest x = largeFast (snum x) == large (snum x)

biLookupTest bil xy xs = case xy of
  Left x -> bil xy xs == fmap Right (lookup x xs)
  Right y -> bil xy xs == fmap Left (lookup y $ map swap xs)

biLookupIteTest, biLookupGuardedTest :: (Eq a, Eq b) => Either a b -> [(a,b)] -> Bool
biLookupIteTest = biLookupTest biLookupIte
biLookupGuardedTest = biLookupTest biLookupGuarded

largeSpeedTest () = largeFast 1000 == 100995490593595050326996041867114628213236955792780008915796929803616287319516496661338158791491868584962247594976919437628719278753088872421513968820130268317431386440087491317831693458247415259894462545994764485191058757695243528007505859423717366131276843816993940471323292751991681721534538030761087681513773972043201431865620016879974744653773270151384638588229194051963586973023287636295809163693816068217282939109495090232105607466623623159850418646887258558969364182562780041144974278895636130714464735510306811875086684300603755183517177490864290232536558236142468155958905423566663436217419948660730548803570545809050727370832002132721401616947718578755652807035678389568916641140472389400290453


eDoublePrec = 2.7182818284590455

eulerRangeTest :: (Integer -> Double) -> SmallNums -> Bool
eulerRangeTest fun n =
  let sn = snum n
      en = fun sn
  in (en >= 1) && (en <= eDoublePrec)

eulerValueTest :: (Integer -> Double) -> SmallNums -> Bool
eulerValueTest fun n =
  let sn = snum n
      en = fun sn
  in ((en == fun (sn+1)) ==> (en == eDoublePrec))

factorialListTest :: SmallNums -> Bool
factorialListTest n = let sn = snum n in factorialList sn == factorialListNaive sn

negativeInputTest :: (Integer -> a) -> Integer -> Bool
negativeInputTest fun n = n < 0 ==> case errorToNothing (fun n) of
  Just _ -> False
  Nothing -> True

eulerConvOrderTest :: Bool
eulerConvOrderTest = let ec = eulerConvergence in and $ zipWith (<) ec (tail ec)

eulerConvListTest :: Bool
eulerConvListTest = let ec = eulerConvergence in and $ zipWith (==) ec [euler n | n <- [0..]]

eulerConvLastElemTest :: Bool
eulerConvLastElemTest =
  let ec = eulerConvergence
      ecLast = last ec
  in (ecLast == euler (fromIntegral $ length ec)) && (ecLast == eDoublePrec)


tests :: [Test]
tests = [
  Test "1.1.a" "biLookupIte1" (biLookupIteTest :: Either Char Bool -> _),
  Test "1.1.a" "biLookupIte2" (biLookupIteTest :: Either AtoE AtoE -> _),
  Test "1.1.b" "biLookupGuarded1" (biLookupGuardedTest :: Either Char Bool -> _),
  Test "1.1.b" "biLookupGuarded2" (biLookupGuardedTest :: Either AtoE AtoE -> _),
  Test "1.2" "largeFast x = large x" largeEqTest,
  Test "1.2" "largeFast 1000" largeSpeedTest,
  Test "2.1" "euler n is between 1 and e" (eulerRangeTest euler),
  Test "2.1" "euler n == euler (n + 1) --> euler n = e" (eulerValueTest euler),
  Test "2.1" "eulerNegativeInput" (negativeInputTest euler),
  Test "2.2" "factorialList n = [factorial n, .., factorial 0]" factorialListTest,
  Test "2.2" "factorialListNegativeInput" (negativeInputTest factorialList),
  Test "2.3" "eulerList n is between 1 and e" (eulerRangeTest eulerList),
  Test "2.3" "eulerList n == eulerList (n + 1) --> eulerList n = e" (eulerValueTest eulerList),
  Test "2.4" "eulerConvergence is strictly ordered" eulerConvOrderTest,
  Test "2.4" "eulerConvergence == [euler 0, ..., euler n]" eulerConvListTest,
  Test "2.4" "eulerConvergence last element == e" eulerConvLastElemTest
  ]

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