{-# LANGUAGE CPP #-}
--
-- Copyright (c) 2005-2022   Stefan Wehr - http://www.stefanwehr.de
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- You should have received a copy of the GNU Lesser General Public
-- License along with this library; if not, write to the Free Software
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA
--
{- |

XML-output following the JUnit output format.

The data types exposed by this module give a rough specification of
the output format.

Here is a sample ouput:

@
\<?xml version="1.0" encoding="UTF-8" standalone="yes"?\>
\<testsuites tests="6" failures="2" errors="0" time="0.705"\>
  \<testsuite id="0" tests="2" failures="0" errors="0" time="0.000" name="MyPkg.A" package="MyPkg.A"\>
    \<testcase classname="MyPkg.A" name="test_funA2" time="0.000"/\>
    \<testcase classname="MyPkg.A" name="test_funA1" time="0.000"/\>
  \</testsuite\>
  \<testsuite id="1" tests="2" failures="0" errors="0" time="0.000" name="MyPkg.B" package="MyPkg.B"\>
    \<testcase classname="MyPkg.B" name="test_funB2" time="0.000"/\>
    \<testcase classname="MyPkg.B" name="test_funB1" time="0.000"/\>
  \</testsuite\>
  \<testsuite id="2" tests="2" failures="2" errors="0" time="0.703" name="bbts" package="bbts"\>
    \<testcase classname="bbts" name="bbt_bbt-dir/should-pass/x.num" time="0.230"\>
      \<failure type="failure" message="test is supposed to succeed but failed with exit code 255"\>test is supposed to succeed but failed with exit code 255\</failure\>
    \</testcase\>
    \<testcase classname="bbts" name="bbt_bbt-dir/should-fail/z.num" time="0.473"\>
      \<failure type="failure" message="Mismatch on stderr:"\>Mismatch on stderr:
--- bbt-dir/should-fail/z.err	2015-09-05 18:37:30.000000000 +0200
+++ -	2022-03-06 09:49:55.480265000 +0100
\@\@ -1 +1 \@\@
-invalid input
+sample[88331]: [fatal] unable to read input graph: The data couldn’t be read because it isn’t in the correct format.
[end of diff output]
\</failure\>
    \</testcase\>
  \</testsuite\>
\</testsuites\>
@

-}
{-# LANGUAGE OverloadedStrings #-}
module Test.Framework.XmlOutput (

  JunitXmlOutput(..), Testsuites(..), Testsuite(..), Testcase(..), Result(..)
  , mkGlobalResultsXml

) where

import qualified Data.ByteString.Lazy as BSL
import qualified Data.List as List

#ifndef MIN_VERSION_containers
#define MIN_VERSION_containers(a,b,c) 1
#endif
#if MIN_VERSION_containers(0,5,0)
import qualified Data.Map.Strict as Map
#else
import qualified Data.Map as Map
#endif

import qualified Data.Text as T
import Text.Printf

import Text.XML.Generator

import Test.Framework.TestTypes
import Test.Framework.Colors

-- | A "specification" of the output format in terms of haskell data types:
-- The name of each data type corresponds to the name of an XML element
-- (lowercase first letter).
-- The name of a field with a primitive corresponds to an attribute with
-- then same name as the field (without the prefix up to the first @_@).
--
-- The root element is @testsuites@
data JunitXmlOutput = JunitXmlOutput Testsuites

type Seconds = Double

data Testsuites
    = Testsuites
      { Testsuites -> Milliseconds
tss_tests :: Int
      , Testsuites -> Milliseconds
tss_failures :: Int
      , Testsuites -> Milliseconds
tss_errors :: Int
      , Testsuites -> Seconds
tss_time :: Seconds
      , Testsuites -> [Testsuite]
tss_suites :: [Testsuite] }

data Testsuite
    = Testsuite
      { Testsuite -> Milliseconds
ts_tests :: Int
      , Testsuite -> Milliseconds
ts_failures :: Int
      , Testsuite -> Milliseconds
ts_errors :: Int
      , Testsuite -> Seconds
ts_time :: Seconds
      , Testsuite -> Milliseconds
ts_id :: Int
      , Testsuite -> String
ts_name :: String
      , Testsuite -> String
ts_package :: String
      , Testsuite -> [Testcase]
ts_testcases :: [Testcase] }

data Testcase
    = Testcase
      { Testcase -> String
tc_classname :: String
      , Testcase -> String
tc_name :: String
      , Testcase -> Seconds
tc_time :: Seconds
      , Testcase -> Maybe Result
tc_result :: Maybe Result }

-- For this datatype, the elemName field specifies the name of the element
data Result
    = Result
      { Result -> String
r_elemName :: String
      , Result -> Name
r_message :: T.Text
      , Result -> String
r_type :: String
      , Result -> Name
r_textContent :: T.Text }

renderAsXml :: JunitXmlOutput -> BSL.ByteString
renderAsXml :: JunitXmlOutput -> ByteString
renderAsXml (JunitXmlOutput Testsuites
suites) =
    Xml Doc -> ByteString
forall r t. (Renderable r, XmlOutput t) => Xml r -> t
xrender (Xml Doc -> ByteString) -> Xml Doc -> ByteString
forall a b. (a -> b) -> a -> b
$
    DocInfo -> Xml Elem -> Xml Doc
doc DocInfo
defaultDocInfo (Xml Elem -> Xml Doc) -> Xml Elem -> Xml Doc
forall a b. (a -> b) -> a -> b
$
        Name -> (Xml Attr, [Xml Elem]) -> Xml Elem
forall c. AddChildren c => Name -> c -> Xml Elem
xelem Name
"testsuites" ((Xml Attr, [Xml Elem]) -> Xml Elem)
-> (Xml Attr, [Xml Elem]) -> Xml Elem
forall a b. (a -> b) -> a -> b
$
              Name -> Name -> Xml Attr
xattr Name
"tests" (Milliseconds -> Name
showT (Testsuites -> Milliseconds
tss_tests Testsuites
suites)) Xml Attr -> Xml Attr -> Xml Attr
forall a. Semigroup a => a -> a -> a
<>
              Name -> Name -> Xml Attr
xattr Name
"failures" (Milliseconds -> Name
showT (Testsuites -> Milliseconds
tss_failures Testsuites
suites)) Xml Attr -> Xml Attr -> Xml Attr
forall a. Semigroup a => a -> a -> a
<>
              Name -> Name -> Xml Attr
xattr Name
"errors" (Milliseconds -> Name
showT (Testsuites -> Milliseconds
tss_errors Testsuites
suites)) Xml Attr -> Xml Attr -> Xml Attr
forall a. Semigroup a => a -> a -> a
<>
              Name -> Name -> Xml Attr
xattr Name
"time" (Seconds -> Name
showTime (Testsuites -> Seconds
tss_time Testsuites
suites)) Xml Attr -> [Xml Elem] -> (Xml Attr, [Xml Elem])
forall a b. a -> b -> (a, b)
<#>
              ((Testsuite -> Xml Elem) -> [Testsuite] -> [Xml Elem]
forall a b. (a -> b) -> [a] -> [b]
map Testsuite -> Xml Elem
testsuiteXml (Testsuites -> [Testsuite]
tss_suites Testsuites
suites))
    where
      testsuiteXml :: Testsuite -> Xml Elem
testsuiteXml Testsuite
suite =
          Name -> (Xml Attr, [Xml Elem]) -> Xml Elem
forall c. AddChildren c => Name -> c -> Xml Elem
xelem Name
"testsuite" ((Xml Attr, [Xml Elem]) -> Xml Elem)
-> (Xml Attr, [Xml Elem]) -> Xml Elem
forall a b. (a -> b) -> a -> b
$
                Name -> Name -> Xml Attr
xattr Name
"id" (Milliseconds -> Name
showT (Testsuite -> Milliseconds
ts_id Testsuite
suite)) Xml Attr -> Xml Attr -> Xml Attr
forall a. Semigroup a => a -> a -> a
<>
                Name -> Name -> Xml Attr
xattr Name
"tests" (Milliseconds -> Name
showT (Testsuite -> Milliseconds
ts_tests Testsuite
suite)) Xml Attr -> Xml Attr -> Xml Attr
forall a. Semigroup a => a -> a -> a
<>
                Name -> Name -> Xml Attr
xattr Name
"failures" (Milliseconds -> Name
showT (Testsuite -> Milliseconds
ts_failures Testsuite
suite)) Xml Attr -> Xml Attr -> Xml Attr
forall a. Semigroup a => a -> a -> a
<>
                Name -> Name -> Xml Attr
xattr Name
"errors" (Milliseconds -> Name
showT (Testsuite -> Milliseconds
ts_errors Testsuite
suite)) Xml Attr -> Xml Attr -> Xml Attr
forall a. Semigroup a => a -> a -> a
<>
                Name -> Name -> Xml Attr
xattr Name
"time" (Seconds -> Name
showTime (Testsuite -> Seconds
ts_time Testsuite
suite)) Xml Attr -> Xml Attr -> Xml Attr
forall a. Semigroup a => a -> a -> a
<>
                Name -> Name -> Xml Attr
xattr Name
"name" (String -> Name
T.pack (Testsuite -> String
ts_name Testsuite
suite)) Xml Attr -> Xml Attr -> Xml Attr
forall a. Semigroup a => a -> a -> a
<>
                Name -> Name -> Xml Attr
xattr Name
"package" (String -> Name
T.pack (Testsuite -> String
ts_package Testsuite
suite)) Xml Attr -> [Xml Elem] -> (Xml Attr, [Xml Elem])
forall a b. a -> b -> (a, b)
<#>
                ((Testcase -> Xml Elem) -> [Testcase] -> [Xml Elem]
forall a b. (a -> b) -> [a] -> [b]
map Testcase -> Xml Elem
testcaseXml (Testsuite -> [Testcase]
ts_testcases Testsuite
suite))
      testcaseXml :: Testcase -> Xml Elem
testcaseXml Testcase
tc =
          Name -> (Xml Attr, Xml Elem) -> Xml Elem
forall c. AddChildren c => Name -> c -> Xml Elem
xelem Name
"testcase" ((Xml Attr, Xml Elem) -> Xml Elem)
-> (Xml Attr, Xml Elem) -> Xml Elem
forall a b. (a -> b) -> a -> b
$
                Name -> Name -> Xml Attr
xattr Name
"classname" (String -> Name
T.pack (Testcase -> String
tc_classname Testcase
tc)) Xml Attr -> Xml Attr -> Xml Attr
forall a. Semigroup a => a -> a -> a
<>
                Name -> Name -> Xml Attr
xattr Name
"name" (String -> Name
T.pack (Testcase -> String
tc_name Testcase
tc)) Xml Attr -> Xml Attr -> Xml Attr
forall a. Semigroup a => a -> a -> a
<>
                Name -> Name -> Xml Attr
xattr Name
"time" (Seconds -> Name
showTime (Testcase -> Seconds
tc_time Testcase
tc)) Xml Attr -> Xml Elem -> (Xml Attr, Xml Elem)
forall a b. a -> b -> (a, b)
<#>
                Maybe Result -> Xml Elem
resultXml (Testcase -> Maybe Result
tc_result Testcase
tc)
      resultXml :: Maybe Result -> Xml Elem
resultXml Maybe Result
Nothing = Xml Elem
forall t. Renderable t => Xml t
xempty
      resultXml (Just Result
res) =
          Name -> (Xml Attr, Xml Elem) -> Xml Elem
forall c. AddChildren c => Name -> c -> Xml Elem
xelem (String -> Name
T.pack (Result -> String
r_elemName Result
res)) ((Xml Attr, Xml Elem) -> Xml Elem)
-> (Xml Attr, Xml Elem) -> Xml Elem
forall a b. (a -> b) -> a -> b
$
                Name -> Name -> Xml Attr
xattr Name
"type" (String -> Name
T.pack (Result -> String
r_type Result
res)) Xml Attr -> Xml Attr -> Xml Attr
forall a. Semigroup a => a -> a -> a
<>
                Name -> Name -> Xml Attr
xattr Name
"message" (Result -> Name
r_message Result
res) Xml Attr -> Xml Elem -> (Xml Attr, Xml Elem)
forall a b. a -> b -> (a, b)
<#>
                Name -> Xml Elem
xtext (Result -> Name
r_textContent Result
res)
      showT :: Milliseconds -> Name
showT = String -> Name
T.pack (String -> Name)
-> (Milliseconds -> String) -> Milliseconds -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Milliseconds -> String
forall a. Show a => a -> String
show
      showTime :: Seconds -> Name
showTime = String -> Name
T.pack (String -> Name) -> (Seconds -> String) -> Seconds -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Seconds -> String
forall r. PrintfType r => String -> r
printf String
"%.3f"

groupByModule :: [FlatTestResult] -> [(String, [FlatTestResult])]
groupByModule :: [FlatTestResult] -> [(String, [FlatTestResult])]
groupByModule [FlatTestResult]
l =
    let m :: Map String [FlatTestResult]
m = (Map String [FlatTestResult]
 -> FlatTestResult -> Map String [FlatTestResult])
-> Map String [FlatTestResult]
-> [FlatTestResult]
-> Map String [FlatTestResult]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\Map String [FlatTestResult]
m FlatTestResult
r -> ([FlatTestResult] -> [FlatTestResult] -> [FlatTestResult])
-> String
-> [FlatTestResult]
-> Map String [FlatTestResult]
-> Map String [FlatTestResult]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith [FlatTestResult] -> [FlatTestResult] -> [FlatTestResult]
forall a. [a] -> [a] -> [a]
(++) (TestPath -> String
prefixName (FlatTestResult -> TestPath
forall a. GenFlatTest a -> TestPath
ft_path FlatTestResult
r)) [FlatTestResult
r] Map String [FlatTestResult]
m) Map String [FlatTestResult]
forall k a. Map k a
Map.empty [FlatTestResult]
l
    in Map String [FlatTestResult] -> [(String, [FlatTestResult])]
forall k a. Map k a -> [(k, a)]
Map.toList Map String [FlatTestResult]
m

mkTestSuite :: (Int, (String, [FlatTestResult])) -> Testsuite
mkTestSuite :: (Milliseconds, (String, [FlatTestResult])) -> Testsuite
mkTestSuite (Milliseconds
id, (String
modName, [FlatTestResult]
results)) =
    Testsuite
    { ts_tests :: Milliseconds
ts_tests = Milliseconds
nTests
    , ts_failures :: Milliseconds
ts_failures = Milliseconds
nFailures
    , ts_errors :: Milliseconds
ts_errors = Milliseconds
nErrors
    , ts_time :: Seconds
ts_time = Milliseconds -> Seconds
millisToSeconds Milliseconds
millis
    , ts_id :: Milliseconds
ts_id = Milliseconds
id
    , ts_name :: String
ts_name = String
modName
    , ts_package :: String
ts_package = String
modName
    , ts_testcases :: [Testcase]
ts_testcases = (FlatTestResult -> Testcase) -> [FlatTestResult] -> [Testcase]
forall a b. (a -> b) -> [a] -> [b]
map FlatTestResult -> Testcase
mkTestCase [FlatTestResult]
results }
    where
      (Milliseconds
nTests, Milliseconds
nFailures, Milliseconds
nErrors, Milliseconds
millis) =
          ((Milliseconds, Milliseconds, Milliseconds, Milliseconds)
 -> FlatTestResult
 -> (Milliseconds, Milliseconds, Milliseconds, Milliseconds))
-> (Milliseconds, Milliseconds, Milliseconds, Milliseconds)
-> [FlatTestResult]
-> (Milliseconds, Milliseconds, Milliseconds, Milliseconds)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\(Milliseconds
t, Milliseconds
f, Milliseconds
e, Milliseconds
m) FlatTestResult
r -> (Milliseconds
t Milliseconds -> Milliseconds -> Milliseconds
forall a. Num a => a -> a -> a
+ Milliseconds
1, Milliseconds
f Milliseconds -> Milliseconds -> Milliseconds
forall a. Num a => a -> a -> a
+ FlatTestResult -> Milliseconds
forall {a}. Num a => FlatTestResult -> a
failureInc FlatTestResult
r, Milliseconds
e Milliseconds -> Milliseconds -> Milliseconds
forall a. Num a => a -> a -> a
+ FlatTestResult -> Milliseconds
forall {a}. Num a => FlatTestResult -> a
errorInc FlatTestResult
r,
                                           Milliseconds
m Milliseconds -> Milliseconds -> Milliseconds
forall a. Num a => a -> a -> a
+ (RunResult -> Milliseconds
rr_wallTimeMs (RunResult -> Milliseconds)
-> (FlatTestResult -> RunResult) -> FlatTestResult -> Milliseconds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlatTestResult -> RunResult
forall a. GenFlatTest a -> a
ft_payload) FlatTestResult
r))
                      (Milliseconds
0, Milliseconds
0, Milliseconds
0, Milliseconds
0) [FlatTestResult]
results
      failureInc :: FlatTestResult -> a
failureInc FlatTestResult
r = if FlatTestResult -> Bool
isFailure FlatTestResult
r then a
1 else a
0
      errorInc :: FlatTestResult -> a
errorInc FlatTestResult
r = if FlatTestResult -> Bool
isError FlatTestResult
r then a
1 else a
0

isFailure :: FlatTestResult -> Bool
isFailure :: FlatTestResult -> Bool
isFailure FlatTestResult
r = TestResult
Fail TestResult -> TestResult -> Bool
forall a. Eq a => a -> a -> Bool
== (RunResult -> TestResult
rr_result (RunResult -> TestResult)
-> (FlatTestResult -> RunResult) -> FlatTestResult -> TestResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlatTestResult -> RunResult
forall a. GenFlatTest a -> a
ft_payload) FlatTestResult
r

isError :: FlatTestResult -> Bool
isError :: FlatTestResult -> Bool
isError FlatTestResult
r = TestResult
Error TestResult -> TestResult -> Bool
forall a. Eq a => a -> a -> Bool
== (RunResult -> TestResult
rr_result (RunResult -> TestResult)
-> (FlatTestResult -> RunResult) -> FlatTestResult -> TestResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlatTestResult -> RunResult
forall a. GenFlatTest a -> a
ft_payload) FlatTestResult
r

mkTestCase :: FlatTestResult -> Testcase
mkTestCase :: FlatTestResult -> Testcase
mkTestCase FlatTestResult
r =
    Testcase
    { tc_classname :: String
tc_classname = String
modName
    , tc_name :: String
tc_name = String
simpleName
    , tc_time :: Seconds
tc_time = Milliseconds -> Seconds
millisToSeconds (RunResult -> Milliseconds
rr_wallTimeMs RunResult
payload)
    , tc_result :: Maybe Result
tc_result = Maybe Result
result }
    where
      payload :: RunResult
payload = FlatTestResult -> RunResult
forall a. GenFlatTest a -> a
ft_payload FlatTestResult
r
      simpleName :: String
simpleName = String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ TestPath -> String
finalName (FlatTestResult -> TestPath
forall a. GenFlatTest a -> TestPath
ft_path FlatTestResult
r)
      modName :: String
modName = TestPath -> String
prefixName (FlatTestResult -> TestPath
forall a. GenFlatTest a -> TestPath
ft_path FlatTestResult
r)
      prefix :: String
prefix = case FlatTestResult -> TestSort
forall a. GenFlatTest a -> TestSort
ft_sort FlatTestResult
r of
                 TestSort
UnitTest -> String
"test_"
                 TestSort
QuickCheckTest -> String
"prop_"
                 TestSort
BlackBoxTest -> String
"bbt_"
      result :: Maybe Result
result =
          if FlatTestResult -> Bool
isFailure FlatTestResult
r
          then Result -> Maybe Result
forall a. a -> Maybe a
Just (String -> Result
mkResult String
"failure")
          else if FlatTestResult -> Bool
isError FlatTestResult
r
               then Result -> Maybe Result
forall a. a -> Maybe a
Just (String -> Result
mkResult String
"error")
               else Maybe Result
forall a. Maybe a
Nothing
      mkResult :: String -> Result
mkResult String
elemName =
          Result
          { r_elemName :: String
r_elemName = String
elemName
          , r_message :: Name
r_message = (Char -> Bool) -> Name -> Name
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') Name
msg
          , r_type :: String
r_type = String
elemName
          , r_textContent :: Name
r_textContent = Name
msg }
      msg :: Name
msg = ColorString -> Bool -> Name
renderColorString (ColorString -> HtfStack -> ColorString
attachCallStack (RunResult -> ColorString
rr_message RunResult
payload) (RunResult -> HtfStack
rr_stack RunResult
payload)) Bool
False

millisToSeconds :: Milliseconds -> Seconds
millisToSeconds :: Milliseconds -> Seconds
millisToSeconds Milliseconds
millis =
    Integer -> Seconds
forall a. Num a => Integer -> a
fromInteger (Milliseconds -> Integer
forall a. Integral a => a -> Integer
toInteger Milliseconds
millis) Seconds -> Seconds -> Seconds
forall a. Fractional a => a -> a -> a
/ Seconds
1000.0

mkGlobalResultsXml :: ReportGlobalResultsArg -> BSL.ByteString
mkGlobalResultsXml :: ReportGlobalResultsArg -> ByteString
mkGlobalResultsXml ReportGlobalResultsArg
arg =
    let nPassed :: Milliseconds
nPassed = [FlatTestResult] -> Milliseconds
forall a. [a] -> Milliseconds
forall (t :: * -> *) a. Foldable t => t a -> Milliseconds
length (ReportGlobalResultsArg -> [FlatTestResult]
rgra_passed ReportGlobalResultsArg
arg)
        nPending :: Milliseconds
nPending = [FlatTestResult] -> Milliseconds
forall a. [a] -> Milliseconds
forall (t :: * -> *) a. Foldable t => t a -> Milliseconds
length (ReportGlobalResultsArg -> [FlatTestResult]
rgra_pending ReportGlobalResultsArg
arg)
        nFailed :: Milliseconds
nFailed = [FlatTestResult] -> Milliseconds
forall a. [a] -> Milliseconds
forall (t :: * -> *) a. Foldable t => t a -> Milliseconds
length (ReportGlobalResultsArg -> [FlatTestResult]
rgra_failed ReportGlobalResultsArg
arg)
        nErrors :: Milliseconds
nErrors = [FlatTestResult] -> Milliseconds
forall a. [a] -> Milliseconds
forall (t :: * -> *) a. Foldable t => t a -> Milliseconds
length (ReportGlobalResultsArg -> [FlatTestResult]
rgra_errors ReportGlobalResultsArg
arg)
        byModules :: [(String, [FlatTestResult])]
byModules = [FlatTestResult] -> [(String, [FlatTestResult])]
groupByModule (ReportGlobalResultsArg -> [FlatTestResult]
rgra_passed ReportGlobalResultsArg
arg [FlatTestResult] -> [FlatTestResult] -> [FlatTestResult]
forall a. [a] -> [a] -> [a]
++ ReportGlobalResultsArg -> [FlatTestResult]
rgra_pending ReportGlobalResultsArg
arg [FlatTestResult] -> [FlatTestResult] -> [FlatTestResult]
forall a. [a] -> [a] -> [a]
++
                                   ReportGlobalResultsArg -> [FlatTestResult]
rgra_failed ReportGlobalResultsArg
arg [FlatTestResult] -> [FlatTestResult] -> [FlatTestResult]
forall a. [a] -> [a] -> [a]
++ ReportGlobalResultsArg -> [FlatTestResult]
rgra_errors ReportGlobalResultsArg
arg)
        suites :: [Testsuite]
suites = ((Milliseconds, (String, [FlatTestResult])) -> Testsuite)
-> [(Milliseconds, (String, [FlatTestResult]))] -> [Testsuite]
forall a b. (a -> b) -> [a] -> [b]
map (Milliseconds, (String, [FlatTestResult])) -> Testsuite
mkTestSuite ([Milliseconds]
-> [(String, [FlatTestResult])]
-> [(Milliseconds, (String, [FlatTestResult]))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Milliseconds
0..] [(String, [FlatTestResult])]
byModules)
        root :: Testsuites
root = Testsuites
               { tss_tests :: Milliseconds
tss_tests = Milliseconds
nPassed Milliseconds -> Milliseconds -> Milliseconds
forall a. Num a => a -> a -> a
+ Milliseconds
nPending Milliseconds -> Milliseconds -> Milliseconds
forall a. Num a => a -> a -> a
+ Milliseconds
nFailed Milliseconds -> Milliseconds -> Milliseconds
forall a. Num a => a -> a -> a
+ Milliseconds
nErrors
               , tss_failures :: Milliseconds
tss_failures = Milliseconds
nFailed
               , tss_errors :: Milliseconds
tss_errors = Milliseconds
nErrors
               , tss_time :: Seconds
tss_time = Milliseconds -> Seconds
millisToSeconds (ReportGlobalResultsArg -> Milliseconds
rgra_timeMs ReportGlobalResultsArg
arg)
               , tss_suites :: [Testsuite]
tss_suites = [Testsuite]
suites }
    in JunitXmlOutput -> ByteString
renderAsXml (Testsuites -> JunitXmlOutput
JunitXmlOutput Testsuites
root)