myTestlll-1.0.0: Tests/RunAllTests.hs

module Main where
import Control.Monad
import System.Console.ANSI
import System.IO
import Data.IORef
import Test.QuickCheck
import Text.Printf
import EuterpeaTests
import Control.Concurrent

totalTests = 1000

-- Thank you, Rosetta Code!
colorStrLn :: ColorIntensity -> Color -> String -> IO ()
colorStrLn fgi fg str = do
    setSGR [SetColor Foreground fgi fg]
    putStr str
    setSGR [Reset]
    putStrLn ""

runTest :: MVar (String, Result) -> (String, IO Result) -> IO ()
runTest result (s, a) = do
    res <- a
    putMVar result (s, res)

printResults :: Int -> MVar (String, Result) -> Handle -> IORef Int -> IO ()
printResults n result log failsR = replicateM_ n $ do
    (s, res) <- takeMVar result
    printf ("%-" ++ show (1 + maximum (map length ((fst . unzip) tests))) ++ "s ") s
    case res of
        Failure _ _ _ _ _ True _ _ -> colorStrLn Vivid Yellow "Interrupted"
        Failure _ _ _ _ r _ _ o -> do
            hPutStrLn log $ s ++ ":\n" ++ o ++ "\n"
            colorStrLn Vivid Red r
            atomicModifyIORef failsR (\x -> (x+1, ()))
        _ -> colorStrLn Vivid Green $ "Passed " ++ show totalTests ++ " trials"

main :: IO ()
main = do
    log <- openFile "error.log" WriteMode
    failsR <- newIORef 0
    result <- newEmptyMVar

    mapM_ (forkIO . runTest result) tests
    printResults (length tests) result log failsR 

    fails <- readIORef failsR
    hClose log
    case fails of
        0 -> putStrLn "*** All tests passed!"
        _ -> error $ "+++ " ++ show fails ++ " of " ++ show (length tests) ++ " tests failed. See error.log for details."
    return ()

tests = [("AbsPitch_Pitch",            quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_AbsPitch_Pitch),
         ("Trans_Composition",         quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Trans_Composition),
         ("Retro_Composition",         quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Retro_Composition),
         ("Invert_Composition",        quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Invert_Composition),
         ("RetroInvert_Composition",   quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_RetroInvert_Composition),
         ("Dur_Times_Composition",     quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Dur_Times_Composition),
         ("Dur_Take_Composition",      quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Dur_Take_Composition),
         ("Take_Repeat_Id",            quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Take_Repeat_Id),
         ("Mmap_Id",                   quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Mmap_Id),
         ("Mmap_Function_Composition", quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Mmap_Function_Composition),
         ("TimesM_Seq",                quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_TimesM_Seq),
         ("Mfold_Identity",            quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Mfold_Identity),
         ("revM_SelfInverting",        quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_revM_SelfInverting),
         ("revM_SelfInverting_weak",   quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_revM_SelfInverting_weak),
         ("revM_DurationPreserving",   quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_revM_DurationPreserving),
         ("Perf_Id",                   quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Perf_Id),
         ("Axiom_11_2_1",              quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_2_1),
         ("Axiom_11_2_2",              quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_2_2),
         ("Axiom_11_2_3",              quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_2_3),
         ("Theorem_11_2_1",            quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Theorem_11_2_1),
         ("Axiom_11_3_1a",             quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_1a),
         ("Axiom_11_3_1b",             quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_1b),
         ("Axiom_11_3_2a",             quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_2a),
         ("Axiom_11_3_2b",             quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_2b),
         ("Axiom_11_3_2c",             quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_2c),
         ("Axiom_11_3_3a",             quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_3a),
         ("Axiom_11_3_3b",             quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_3b),
         ("Axiom_11_3_3c",             quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_3c),
         ("Axiom_11_3_3d",             quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_3d),
         ("Axiom_11_3_4a",             quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_4a),
         ("Axiom_11_3_4b",             quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_4b),
         ("Axiom_11_3_5",              quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_5),
         ("Axiom_11_3_6a",             quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_6a),
         ("Axiom_11_3_6b",             quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_6b),
         ("Axiom_11_3_6c",             quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_6c),
         ("Axiom_11_3_6d",             quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_6d),
         ("Axiom_11_3_8",              quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_8),
         ("Axiom_11_3_8_weak",         quickCheckWithResult (stdArgs { chatty = False, maxSuccess = totalTests }) prop_Axiom_11_3_8_weak)]