diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2026-08-30 20:05:25 +0200 |
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2026-09-03 20:53:42 +0200 |
| commit | ac8bae764b026def10fa110c675002f14c84860a (patch) | |
| tree | 6afa7b9b4355d51768a01ca79ee08b4d370d9a1f /src/JUnit.hs | |
| parent | e1b7b08d398765676a1169fa4a1c0463b19f71d1 (diff) | |
Changelog: Added `--junit-report` switch to generate test report in JUnit XML format.
Diffstat (limited to 'src/JUnit.hs')
| -rw-r--r-- | src/JUnit.hs | 40 |
1 files changed, 40 insertions, 0 deletions
diff --git a/src/JUnit.hs b/src/JUnit.hs new file mode 100644 index 0000000..c935987 --- /dev/null +++ b/src/JUnit.hs @@ -0,0 +1,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" |