diff options
| -rw-r--r-- | src/JUnit.hs | 44 |
1 files changed, 24 insertions, 20 deletions
diff --git a/src/JUnit.hs b/src/JUnit.hs index c935987..3649d53 100644 --- a/src/JUnit.hs +++ b/src/JUnit.hs @@ -10,6 +10,8 @@ import Data.Function import Data.List.NonEmpty qualified as NE import Data.Text.Encoding +import System.Directory +import System.FilePath import System.IO import Run @@ -17,24 +19,26 @@ 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>" - ] +writeJUnitReport path Report {..} = do + createDirectoryIfMissing True $ takeDirectory path + 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" + B.hPutStr h $ "</testsuite>" + B.hPutStr h $ "</testsuites>\n" |