1 a95f0ac6 2022-01-17 falsifian module Test.TestTree
 2 a95f0ac6 2022-01-17 falsifian 
 3 a95f0ac6 2022-01-17 falsifian %default total
 4 a95f0ac6 2022-01-17 falsifian 
 5 a95f0ac6 2022-01-17 falsifian public export
 6 a95f0ac6 2022-01-17 falsifian data TestResult = MkSuccess | MkFailure String
 7 a95f0ac6 2022-01-17 falsifian 
 8 a95f0ac6 2022-01-17 falsifian public export
 9 a95f0ac6 2022-01-17 falsifian record TestCase where
10 a95f0ac6 2022-01-17 falsifian   constructor MkTestCase
11 a95f0ac6 2022-01-17 falsifian   name : String
12 a95f0ac6 2022-01-17 falsifian   run : IO TestResult
13 a95f0ac6 2022-01-17 falsifian 
14 a95f0ac6 2022-01-17 falsifian runTestCase : TestCase -> IO TestResult
15 a95f0ac6 2022-01-17 falsifian runTestCase testCase =
16 a95f0ac6 2022-01-17 falsifian   do putStrLn $ "Running test case: " <+> testCase.name
17 a95f0ac6 2022-01-17 falsifian      result <- testCase.run
18 a95f0ac6 2022-01-17 falsifian      case result of
19 a95f0ac6 2022-01-17 falsifian        MkSuccess => putStrLn "Success"
20 a95f0ac6 2022-01-17 falsifian        MkFailure message => putStrLn $ "Failure: " <+> message
21 a95f0ac6 2022-01-17 falsifian      pure result
22 a95f0ac6 2022-01-17 falsifian 
23 a95f0ac6 2022-01-17 falsifian public export
24 a95f0ac6 2022-01-17 falsifian data TestTree = MkTestLeaf TestCase | MkTestGroup String (List TestTree)
25 a95f0ac6 2022-01-17 falsifian 
26 a95f0ac6 2022-01-17 falsifian mutual
27 a95f0ac6 2022-01-17 falsifian   -- Helper. We can't just call use sequence . map runTestTree in runTestTree because the compiler wouldn't be able to tell runTestTree is total.
28 a95f0ac6 2022-01-17 falsifian   runTestTrees : List TestResult -> List TestTree -> IO (List TestResult)
29 a95f0ac6 2022-01-17 falsifian   runTestTrees acc [] = pure $ reverse acc
30 a95f0ac6 2022-01-17 falsifian   runTestTrees acc (tree :: trees) =
31 a95f0ac6 2022-01-17 falsifian     do result <- runTestTree tree
32 a95f0ac6 2022-01-17 falsifian        runTestTrees (result :: acc) trees
33 a95f0ac6 2022-01-17 falsifian 
34 a95f0ac6 2022-01-17 falsifian   export
35 a95f0ac6 2022-01-17 falsifian   runTestTree : TestTree -> IO TestResult
36 a95f0ac6 2022-01-17 falsifian   runTestTree (MkTestLeaf testCase) = runTestCase testCase
37 a95f0ac6 2022-01-17 falsifian   runTestTree (MkTestGroup name subTrees) =
38 a95f0ac6 2022-01-17 falsifian     let resultToNumFailures : TestResult -> Nat
39 a95f0ac6 2022-01-17 falsifian         resultToNumFailures MkSuccess = 0
40 a95f0ac6 2022-01-17 falsifian         resultToNumFailures (MkFailure _) = 1
41 a95f0ac6 2022-01-17 falsifian     in
42 a95f0ac6 2022-01-17 falsifian     do putStrLn $ "Starting test group: " <+> name
43 a95f0ac6 2022-01-17 falsifian        results <- runTestTrees [] subTrees
44 a95f0ac6 2022-01-17 falsifian        let numFailures = sum $ map resultToNumFailures results
45 a95f0ac6 2022-01-17 falsifian        putStrLn $
46 a95f0ac6 2022-01-17 falsifian            "Test group finished: " <+> name <+> ". " <+>
47 a95f0ac6 2022-01-17 falsifian            show numFailures <+> "/" <+> show (length results) <+>
48 a95f0ac6 2022-01-17 falsifian            " failed."
49 a95f0ac6 2022-01-17 falsifian        pure $
50 a95f0ac6 2022-01-17 falsifian          if numFailures == 0
51 a95f0ac6 2022-01-17 falsifian            then MkSuccess
52 a95f0ac6 2022-01-17 falsifian            else MkFailure name