module Test.Simple
(test_all
,test
,test_all_IO
,test_IO)
where
import Error.Report
import Prelude hiding (catch)
import System.FilePath
import System.Directory
import Control.Exception
import Control.Monad
test_all :: (ErrorReport a, Show b)
=> String
-> (FilePath -> String -> Either a b)
-> IO ()
test_all process t =
test_all_abstract process t test
test_all_IO :: (ErrorReport a, Show b)
=> String
-> (FilePath -> String -> IO (Either a b))
-> IO ()
test_all_IO process t =
test_all_abstract process t test_IO
test_IO :: (ErrorReport a, Show b)
=> String
-> (FilePath -> String -> IO (Either a b))
-> Bool
-> FilePath
-> IO ()
test_IO process test success fp =
readFile fp >>= (\src -> do
putStrLn $ '\n' : replicate 50 '*'
putStrLn $ "Testing " ++ fp ++ ":"
catch (test fp src >>= approp success)
with_err)
where
with_err :: SomeException -> IO ()
with_err e =
if success
then throw e
else putStrLn $ show e
test_all_abstract :: String
-> (FilePath -> String -> a)
-> (String -> (FilePath -> String -> a) -> Bool -> FilePath -> IO ())
-> IO ()
test_all_abstract process t test =
catch (do
success >> failure
putStrLn "\n******AUTOMATIC TESTING PASSED******")
(\e -> do
print (e :: SomeException)
error "\n******TESTING FAILED!******")
where
test_dir n = joinPath ["tests", process, n]
success_files :: IO [FilePath]
success_files = test_files $ test_dir "success"
failure_files :: IO [FilePath]
failure_files = test_files $ test_dir "failure"
success = success_files >>= run_tests True
failure = failure_files >>= run_tests False
run_tests b =
mapM (test process t b)
test_files :: FilePath -> IO [FilePath]
test_files dir = do
putStrLn $ "\nIn directory: " ++ dir
conts <- getDirectoryContents dir
putStrLn $ "Found files: " ++ show conts
chosen <- filterM doesFileExist $ map (combine dir) $ filter (\f -> not $ head f == '.') conts
putStrLn $ "Choosing files: " ++ show chosen
return chosen
test :: (ErrorReport a, Show b)
=> String
-> (FilePath -> String -> Either a b)
-> Bool
-> FilePath
-> IO ()
test process test success fp =
readFile fp >>= (\src -> do
putStrLn $ '\n' : replicate 50 '*'
putStrLn $ "Testing " ++ fp ++ ":"
approp success $ test fp src)
approp :: (ErrorReport a, Show b) => Bool -> Either a b -> IO ()
approp b test_res = do
catch (without_error test_res) with_error
where
with_error :: SomeException -> IO ()
with_error e =
if b
then throw e
else putStrLn $ show e
without_error =
uncurry either $
if b
then (error . pretty . report, putStrLn . nl . show)
else (putStrLn . pretty . report, error . nl . ("ERROR:" ++ ) . nl . show)
nl = ('\n' :)