module Test.Sloth
(
strictCheck, verboseCheck, interactCheck, check,
Config(..), defaultConfig, verboseConfig, successesConfig, uncoloredConfig,
interactiveConfig,
Data, Typeable,
A,
) where
import Data.Data ( Data, Typeable )
import Test.Sloth.CoMonad ( extract )
import Test.Sloth.TestCase ( TestCase, isValid, showTestCase )
import Test.Sloth.Refine ( bfs, coSeq, A )
import Test.Sloth.CharSet ( Testable(..), checkCharSet, pruneSet )
import Test.Sloth.Search ( Search )
import Test.Sloth.Config
( Config(..), defaultConfig, verboseConfig, successesConfig,
uncoloredConfig, interactiveConfig )
strictCheck :: Testable fun => fun -> Int -> IO ()
strictCheck = check defaultConfig
verboseCheck :: Testable fun => fun -> Int -> IO ()
verboseCheck = check verboseConfig
interactCheck :: Testable fun => fun -> Int -> IO ()
interactCheck = check interactiveConfig
check :: Testable fun => Config -> fun -> Int -> IO ()
check config f n
| interactive config = interactCheck' results
| otherwise = putStr (unlines results)
where
results = listCheck config f n
interactCheck' [] = return ()
interactCheck' [r] = putStrLn r
interactCheck' (r:rs) = do
putStrLn r
putStr "More? [y(es)/n(o)/a(ll)]"
c <- getChar
putStr "\n"
case c of
'n' -> return ()
'a' -> putStr (unlines rs)
_ -> interactCheck' rs
listCheck :: Testable fun => Config -> fun -> Int -> [String]
listCheck config f size = showResults 1 config (bfs r)
where
r = pruneSet size config
(coSeq (checkCharSet (charSet f (simpleApprox config) size)))
showResults :: Int -> Config -> [Search TestCase] -> [String]
showResults n _ [] = ["Finished " ++ show (n1) ++ " tests."]
showResults n config (t:ts)
| isValid config (extract t) =
(show n ++ ": " ++ showTestCase config t) : showResults (n+1) config ts
| otherwise = showResults (n+1) config ts