src/JUnit.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40

module JUnit (
    writeJUnitReport,
) where

import Control.Monad

import Data.ByteString qualified as B
import Data.ByteString.Char8 qualified as BC
import Data.Function
import Data.List.NonEmpty qualified as NE
import Data.Text.Encoding

import System.IO

import Run
import Script.Var


writeJUnitReport :: FilePath -> Report -> IO ()
writeJUnitReport path Report {..} = withFile path WriteMode $ \h -> do
    B.hPutStr h $ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"
    B.hPutStr h $ "<testsuites time=\"" <> BC.pack (show reportTotalTime) <> "\">\n"
    forM_ (NE.groupBy ((==) `on` (testNameModule . reportTestName)) reportTests) $ \grp -> do
        B.hPutStr h $ "<testsuite name=\"" <> encodeUtf8 (textModuleName $ testNameModule $ reportTestName $ NE.head grp) <> "\" time=\"" <> BC.pack (show $ sum $ map reportTime $ NE.toList grp) <> "\">"
        forM_ grp $ \SingleTestReport {..} -> do
            B.hPutStr h $ B.concat
                [ "<testcase name=\"", encodeUtf8 (testNameBase reportTestName), "\""
                , " classname=\"", encodeUtf8 (textModuleName $ testNameModule reportTestName), "\""
                , " time=\"", BC.pack (show reportTime), "\""
                , case reportTestFailed of
                    Nothing -> do
                        " />"
                    Just Failed -> do
                        "><failure message=\"Test failed\"></failure></testcase>"
                    Just (ProcessCrashed _) -> do
                        "><error message=\"Process crashed\"></error></testcase>"
                ]

        B.hPutStr h $ "</testsuite>"
    B.hPutStr h $ "</testsuites>\n"