{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- A module for producing JUnit style XML reports, for consumption by CI
-- platforms like Jenkins.
-- Please see the README at <https://github.com/jwoudenberg/junit-xml>.
module Text.XML.JUnit
  ( -- * Writing test reports
    writeXmlReport,

    -- * Test report constructors
    passed,
    skipped,
    failed,
    errored,
    inSuite,

    -- * Adding test report details
    stdout,
    stderr,
    time,
    failureMessage,
    failureStackTrace,
    errorMessage,
    errorStackTrace,

    -- * Helper types
    TestReport,
    TestSuite,
  )
where

import Data.Function ((&))
import qualified Data.List.NonEmpty as NonEmpty
import Data.Maybe (fromMaybe)
import Data.Maybe (catMaybes)
import qualified Data.Text as T
import qualified Data.Text.Lazy.IO
import GHC.Exts (fromList)
import qualified Text.XML as XML

-- | This function writes an xml report to the provided path.
--
-- @
--     import Data.Function ((&))
--
--     writeXmlReport "report.xml"
--       [ 'passed' "A passing test"
--           & 'inSuite' "Test suite"
--       , 'failed' "A failing test"
--           & 'inSuite' "Test suite"
--       ]
-- @
writeXmlReport :: FilePath -> [TestSuite] -> IO ()
writeXmlReport :: FilePath -> [TestSuite] -> IO ()
writeXmlReport FilePath
out =
  FilePath -> Text -> IO ()
Data.Text.Lazy.IO.writeFile FilePath
out (Text -> IO ()) -> ([TestSuite] -> Text) -> [TestSuite] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderSettings -> Document -> Text
XML.renderText RenderSettings
forall a. Default a => a
XML.def (Document -> Text)
-> ([TestSuite] -> Document) -> [TestSuite] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TestSuite] -> Document
encode

-- | The report for a single test case.
data TestReport outcome where
  TestReport ::
    Outcome outcome =>
    { forall outcome. TestReport outcome -> Text
testName' :: T.Text,
      forall outcome. TestReport outcome -> outcome
outcome' :: outcome,
      forall outcome. TestReport outcome -> Maybe Text
stdout' :: Maybe T.Text,
      forall outcome. TestReport outcome -> Maybe Text
stderr' :: Maybe T.Text,
      forall outcome. TestReport outcome -> Maybe Double
time' :: Maybe Double
    } ->
    TestReport
      outcome

-- | A test report annotated with the test suite it is part of.
data TestSuite
  = TestSuite
      { TestSuite -> Text
suiteName :: T.Text,
        TestSuite -> Element
testReport :: XML.Element,
        TestSuite -> Counts
counts :: Counts
      }

-- | Wrap a test report in a suite, allowing it to be added to the list of
-- reports passed to 'writeXmlReports'.
--
-- @
--     import Data.Function ((&))
--
--     'writeXmlReport' "report.xml"
--       [ 'passed' "Passed test"
--           & inSuite "Some test suite"
--       ]
--
-- @
inSuite :: T.Text -> TestReport outcome -> TestSuite
inSuite :: forall outcome. Text -> TestReport outcome -> TestSuite
inSuite Text
name test :: TestReport outcome
test@TestReport {outcome
outcome' :: forall outcome. TestReport outcome -> outcome
outcome' :: outcome
outcome', Maybe Double
time' :: forall outcome. TestReport outcome -> Maybe Double
time' :: Maybe Double
time'} =
  TestSuite
    { suiteName :: Text
suiteName = Text
name,
      testReport :: Element
testReport = TestReport outcome -> Element
forall a. TestReport a -> Element
encodeTestCase TestReport outcome
test,
      counts :: Counts
counts = (outcome -> Counts
forall a. Outcome a => a -> Counts
outcomeCounter outcome
outcome') {cumTime :: Double
cumTime = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0 Maybe Double
time'}
    }

mapTest :: (a -> a) -> TestReport a -> TestReport a
mapTest :: forall a. (a -> a) -> TestReport a -> TestReport a
mapTest a -> a
f TestReport a
test = TestReport a
test {outcome' :: a
outcome' = a -> a
f (TestReport a -> a
forall outcome. TestReport outcome -> outcome
outcome' TestReport a
test)}

-- | Add the stdout produced running a test to the report for that test.
--
-- @
--     import Data.Function ((&))
--
--     'writeXmlReport' "report.xml"
--       [ 'passed' "A passing test"
--           & stdout "Test ran succesfully!"
--           & 'inSuite' "Test suite"
--       ]
-- @
stdout :: T.Text -> TestReport outcome -> TestReport outcome
stdout :: forall outcome. Text -> TestReport outcome -> TestReport outcome
stdout Text
log TestReport outcome
test = TestReport outcome
test {stdout' :: Maybe Text
stdout' = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
log}

-- | Add the stderr produced running a test to the report for that test.
--
-- @
--     import Data.Function ((&))
--
--     'writeXmlReport' "report.xml"
--       [ 'failed' "A failing test"
--           & stderr "Expected 4, but got 2."
--           & 'inSuite' "Test suite"
--       ]
-- @
stderr :: T.Text -> TestReport outcome -> TestReport outcome
stderr :: forall outcome. Text -> TestReport outcome -> TestReport outcome
stderr Text
log TestReport outcome
test = TestReport outcome
test {stderr' :: Maybe Text
stderr' = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
log}

-- | Add the running time of a test to the report for that test.
--
-- @
--     import Data.Function ((&))
--
--     'writeXmlReport' "report.xml"
--       [ 'passed' "A passing test"
--           & time 0.003
--           & 'inSuite' "Test suite"
--       ]
-- @
time :: Double -> TestReport outcome -> TestReport outcome
time :: forall outcome. Double -> TestReport outcome -> TestReport outcome
time Double
seconds TestReport outcome
test = TestReport outcome
test {time' :: Maybe Double
time' = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
seconds}

-- | Create a report for a passing test.
--
-- @
--     import Data.Function ((&))
--
--     'writeXmlReport' "report.xml"
--       [ passed "A passing test"
--           & 'stdout' "Test ran succesfully!"
--           & 'stderr' "Warning: don't overcook the vegetables!"
--           & 'time' 0.003
--           & 'inSuite' "Test suite"
--       ]
-- @
passed :: T.Text -> TestReport Passed
passed :: Text -> TestReport Passed
passed Text
name =
  TestReport
    { testName' :: Text
testName' = Text
name,
      outcome' :: Passed
outcome' = Passed
Passed,
      stdout' :: Maybe Text
stdout' = Maybe Text
forall a. Maybe a
Nothing,
      stderr' :: Maybe Text
stderr' = Maybe Text
forall a. Maybe a
Nothing,
      time' :: Maybe Double
time' = Maybe Double
forall a. Maybe a
Nothing
    }

-- | Create a report for a skipped test.
--
-- @
--     import Data.Function ((&))
--
--     'writeXmlReport' "report.xml"
--       [ skipped "A skipped test"
--           & 'inSuite' "Test suite"
--       ]
-- @
skipped :: T.Text -> TestReport Skipped
skipped :: Text -> TestReport Skipped
skipped Text
name =
  TestReport
    { testName' :: Text
testName' = Text
name,
      outcome' :: Skipped
outcome' = Skipped
Skipped,
      stdout' :: Maybe Text
stdout' = Maybe Text
forall a. Maybe a
Nothing,
      stderr' :: Maybe Text
stderr' = Maybe Text
forall a. Maybe a
Nothing,
      time' :: Maybe Double
time' = Maybe Double
forall a. Maybe a
Nothing
    }

-- | Create a report for a failed test.
--
-- @
--     import Data.Function ((&))
--
--     'writeXmlReport' "report.xml"
--       [ failed "A failing test"
--           & 'stdout' "Running test..."
--           & 'stderr' "Test failed: expected 3 slices of pizza but got one."
--           & 'failureMessage' "Not enough pizza"
--           & 'failureStackTrace' ["pizza", "pizzeria", "italy"]
--           & 'time' 0.08
--           & 'inSuite' "Test suite"
--       ]
-- @
failed :: T.Text -> TestReport Failed
failed :: Text -> TestReport Failed
failed Text
name =
  TestReport
    { testName' :: Text
testName' = Text
name,
      outcome' :: Failed
outcome' = Maybe Text -> [Text] -> Failed
Failure Maybe Text
forall a. Maybe a
Nothing [],
      stdout' :: Maybe Text
stdout' = Maybe Text
forall a. Maybe a
Nothing,
      stderr' :: Maybe Text
stderr' = Maybe Text
forall a. Maybe a
Nothing,
      time' :: Maybe Double
time' = Maybe Double
forall a. Maybe a
Nothing
    }

-- | Create a report for a test that threw an error.
--
-- @
--     import Data.Function ((&))
--
--     'writeXmlReport' "report.xml"
--       [ errored "A test that threw an error"
--           & 'stdout' "Running test..."
--           & 'stderr' "Unexpected exception: BedTime"
--           & 'errorMessage' "Operation canceled due to BedTimeOut"
--           & 'errorStackTrace' ["bed", "sleep", "night"]
--           & 'time' 0.08
--           & 'inSuite' "Test suite"
--       ]
-- @
errored :: T.Text -> TestReport Errored
errored :: Text -> TestReport Errored
errored Text
name =
  TestReport
    { testName' :: Text
testName' = Text
name,
      outcome' :: Errored
outcome' = Maybe Text -> [Text] -> Errored
Error Maybe Text
forall a. Maybe a
Nothing [],
      stdout' :: Maybe Text
stdout' = Maybe Text
forall a. Maybe a
Nothing,
      stderr' :: Maybe Text
stderr' = Maybe Text
forall a. Maybe a
Nothing,
      time' :: Maybe Double
time' = Maybe Double
forall a. Maybe a
Nothing
    }

class Outcome a where
  outcomeToXML :: a -> Maybe XML.Element

  outcomeCounter :: a -> Counts

data Passed = Passed

instance Outcome Passed where
  outcomeToXML :: Passed -> Maybe Element
outcomeToXML Passed
_ = Maybe Element
forall a. Maybe a
Nothing

  outcomeCounter :: Passed -> Counts
outcomeCounter Passed
_ = Counts
forall a. Monoid a => a
mempty {cumTests :: Int
cumTests = Int
1}

data Skipped = Skipped

instance Outcome Skipped where
  outcomeToXML :: Skipped -> Maybe Element
outcomeToXML Skipped
_ = Element -> Maybe Element
forall a. a -> Maybe a
Just (Element -> Maybe Element) -> Element -> Maybe Element
forall a b. (a -> b) -> a -> b
$ Name -> Map Name Text -> [Node] -> Element
XML.Element Name
"skipped" Map Name Text
forall a. Monoid a => a
mempty []

  outcomeCounter :: Skipped -> Counts
outcomeCounter Skipped
_ = Counts
forall a. Monoid a => a
mempty {cumSkipped :: Int
cumSkipped = Int
1, cumTests :: Int
cumTests = Int
1}

data Failed
  = Failure
      { -- Warning: newlines in the failure message will look like spaces in the
        -- Jenkins UI!
        Failed -> Maybe Text
failureMessage' :: Maybe T.Text,
        Failed -> [Text]
failureStackTrace' :: [T.Text]
      }

instance Outcome Failed where
  outcomeToXML :: Failed -> Maybe Element
outcomeToXML = Element -> Maybe Element
forall a. a -> Maybe a
Just (Element -> Maybe Element)
-> (Failed -> Element) -> Failed -> Maybe Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Failed -> Element
encodeFailure

  outcomeCounter :: Failed -> Counts
outcomeCounter Failed
_ = Counts
forall a. Monoid a => a
mempty {cumFailed :: Int
cumFailed = Int
1, cumTests :: Int
cumTests = Int
1}

-- | Add an error message to the report of a failed test.
--
-- @
--     import Data.Function ((&))
--
--     'writeXmlReport' "report.xml"
--       [ failed "A failing test"
--           & failureMessage "Laundromat exceeds noise tolerance."
--           & 'inSuite' "Test suite"
--       ]
-- @
failureMessage :: T.Text -> TestReport Failed -> TestReport Failed
failureMessage :: Text -> TestReport Failed -> TestReport Failed
failureMessage Text
msg TestReport Failed
test =
  (Failed -> Failed) -> TestReport Failed -> TestReport Failed
forall a. (a -> a) -> TestReport a -> TestReport a
mapTest (\Failed
outcome -> Failed
outcome {failureMessage' :: Maybe Text
failureMessage' = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
msg}) TestReport Failed
test

-- | Add a stack trace to the report of a failed test.
--
-- @
--     import Data.Function ((&))
--
--     'writeXmlReport' "report.xml"
--       [ failed "A failing test"
--           & failureStackTrace ["ankleClass", "legClass", "limbClass"]
--           & 'inSuite' "Test suite"
--       ]
-- @
failureStackTrace :: [T.Text] -> TestReport Failed -> TestReport Failed
failureStackTrace :: [Text] -> TestReport Failed -> TestReport Failed
failureStackTrace [Text]
trace TestReport Failed
test =
  (Failed -> Failed) -> TestReport Failed -> TestReport Failed
forall a. (a -> a) -> TestReport a -> TestReport a
mapTest (\Failed
outcome -> Failed
outcome {failureStackTrace' :: [Text]
failureStackTrace' = [Text]
trace}) TestReport Failed
test

data Errored
  = Error
      { -- Warning: newlines in the failure message will look like spaces in the
        -- Jenkins UI!
        Errored -> Maybe Text
errorMessage' :: Maybe T.Text,
        Errored -> [Text]
errorStackTrace' :: [T.Text]
      }

instance Outcome Errored where
  outcomeToXML :: Errored -> Maybe Element
outcomeToXML = Element -> Maybe Element
forall a. a -> Maybe a
Just (Element -> Maybe Element)
-> (Errored -> Element) -> Errored -> Maybe Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Errored -> Element
encodeError

  outcomeCounter :: Errored -> Counts
outcomeCounter Errored
_ = Counts
forall a. Monoid a => a
mempty {cumErrored :: Int
cumErrored = Int
1, cumTests :: Int
cumTests = Int
1}

-- | Add an error message to the report for a test that threw an exception.
--
-- @
--     import Data.Function ((&))
--
--     'writeXmlReport' "report.xml"
--       [ errored "A test that threw an error"
--           & errorMessage "Too much Netflix"
--           & 'inSuite' "Test suite"
--       ]
-- @
errorMessage :: T.Text -> TestReport Errored -> TestReport Errored
errorMessage :: Text -> TestReport Errored -> TestReport Errored
errorMessage Text
msg TestReport Errored
test =
  (Errored -> Errored) -> TestReport Errored -> TestReport Errored
forall a. (a -> a) -> TestReport a -> TestReport a
mapTest (\Errored
outcome -> Errored
outcome {errorMessage' :: Maybe Text
errorMessage' = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
msg}) TestReport Errored
test

-- | Add a stack trace to a report for a test that threw an exception
--
-- @
--     import Data.Function ((&))
--
--     'writeXmlReport' "report.xml"
--       [ errored "A test that threw an error"
--           & errorStackTrace ["at closeCurtain line 3", "at goToSleep line 8"]
--           & 'inSuite' "Test suite"
--       ]
-- @
errorStackTrace :: [T.Text] -> TestReport Errored -> TestReport Errored
errorStackTrace :: [Text] -> TestReport Errored -> TestReport Errored
errorStackTrace [Text]
trace TestReport Errored
test =
  (Errored -> Errored) -> TestReport Errored -> TestReport Errored
forall a. (a -> a) -> TestReport a -> TestReport a
mapTest (\Errored
outcome -> Errored
outcome {errorStackTrace' :: [Text]
errorStackTrace' = [Text]
trace}) TestReport Errored
test

data Counts
  = Counts
      { Counts -> Int
cumTests :: Int,
        Counts -> Int
cumFailed :: Int,
        Counts -> Int
cumErrored :: Int,
        Counts -> Int
cumSkipped :: Int,
        Counts -> Double
cumTime :: Double
      }

instance Semigroup Counts where
  Counts
c1 <> :: Counts -> Counts -> Counts
<> Counts
c2 =
    Counts
      { cumTests :: Int
cumTests = Counts -> Int
cumTests Counts
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Counts -> Int
cumTests Counts
c2,
        cumFailed :: Int
cumFailed = Counts -> Int
cumFailed Counts
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Counts -> Int
cumFailed Counts
c2,
        cumErrored :: Int
cumErrored = Counts -> Int
cumErrored Counts
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Counts -> Int
cumErrored Counts
c2,
        cumSkipped :: Int
cumSkipped = Counts -> Int
cumSkipped Counts
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Counts -> Int
cumSkipped Counts
c2,
        cumTime :: Double
cumTime = Counts -> Double
cumTime Counts
c1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Counts -> Double
cumTime Counts
c2
      }

instance Monoid Counts where
  mempty :: Counts
mempty = Int -> Int -> Int -> Int -> Double -> Counts
Counts Int
0 Int
0 Int
0 Int
0 Double
0

encode :: [TestSuite] -> XML.Document
encode :: [TestSuite] -> Document
encode [TestSuite]
suites =
  Prologue -> Element -> [Miscellaneous] -> Document
XML.Document Prologue
prologue Element
element []
  where
    prologue :: Prologue
prologue = [Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
XML.Prologue [] Maybe Doctype
forall a. Maybe a
Nothing []
    (Counts
totalCounts, [Node]
suiteElements) =
      (NonEmpty TestSuite -> (Counts, [Node]))
-> [NonEmpty TestSuite] -> (Counts, [Node])
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
        ((Element -> [Node]) -> (Counts, Element) -> (Counts, [Node])
forall a b. (a -> b) -> (Counts, a) -> (Counts, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Node -> [Node]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Node -> [Node]) -> (Element -> Node) -> Element -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Node
XML.NodeElement) ((Counts, Element) -> (Counts, [Node]))
-> (NonEmpty TestSuite -> (Counts, Element))
-> NonEmpty TestSuite
-> (Counts, [Node])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty TestSuite -> (Counts, Element)
encodeSuite)
        ((TestSuite -> Text) -> [TestSuite] -> [NonEmpty TestSuite]
forall b a. Ord b => (a -> b) -> [a] -> [NonEmpty a]
NonEmpty.groupAllWith TestSuite -> Text
suiteName [TestSuite]
suites)
    element :: Element
element =
      Name -> Map Name Text -> [Node] -> Element
XML.Element
        Name
"testsuites"
        ([Item (Map Name Text)] -> Map Name Text
forall l. IsList l => [Item l] -> l
fromList (Counts -> [(Name, Text)]
countAttributes Counts
totalCounts))
        [Node]
suiteElements

encodeSuite :: NonEmpty.NonEmpty TestSuite -> (Counts, XML.Element)
encodeSuite :: NonEmpty TestSuite -> (Counts, Element)
encodeSuite NonEmpty TestSuite
suite =
  (Counts
suiteCounts, Element
element)
  where
    suiteCounts :: Counts
suiteCounts = (TestSuite -> Counts) -> NonEmpty TestSuite -> Counts
forall m a. Monoid m => (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TestSuite -> Counts
counts NonEmpty TestSuite
suite
    element :: Element
element =
      Name -> Map Name Text -> [Node] -> Element
XML.Element
        Name
"testsuite"
        ([Item (Map Name Text)] -> Map Name Text
forall l. IsList l => [Item l] -> l
fromList ([Item (Map Name Text)] -> Map Name Text)
-> [Item (Map Name Text)] -> Map Name Text
forall a b. (a -> b) -> a -> b
$ (Name
"name", TestSuite -> Text
suiteName (NonEmpty TestSuite -> TestSuite
forall a. NonEmpty a -> a
NonEmpty.head NonEmpty TestSuite
suite)) (Name, Text) -> [(Name, Text)] -> [(Name, Text)]
forall a. a -> [a] -> [a]
: Counts -> [(Name, Text)]
countAttributes Counts
suiteCounts)
        (NonEmpty Node -> [Node]
forall a. NonEmpty a -> [a]
NonEmpty.toList (Element -> Node
XML.NodeElement (Element -> Node) -> (TestSuite -> Element) -> TestSuite -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestSuite -> Element
testReport (TestSuite -> Node) -> NonEmpty TestSuite -> NonEmpty Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty TestSuite
suite))

encodeTestCase :: TestReport a -> XML.Element
encodeTestCase :: forall a. TestReport a -> Element
encodeTestCase TestReport {Text
testName' :: forall outcome. TestReport outcome -> Text
testName' :: Text
testName', a
outcome' :: forall outcome. TestReport outcome -> outcome
outcome' :: a
outcome', Maybe Text
stdout' :: forall outcome. TestReport outcome -> Maybe Text
stdout' :: Maybe Text
stdout', Maybe Text
stderr' :: forall outcome. TestReport outcome -> Maybe Text
stderr' :: Maybe Text
stderr', Maybe Double
time' :: forall outcome. TestReport outcome -> Maybe Double
time' :: Maybe Double
time'} =
  Name -> Map Name Text -> [Node] -> Element
XML.Element Name
"testcase" Map Name Text
attributes [Node]
children
  where
    attributes :: Map Name Text
attributes =
      [Item (Map Name Text)] -> Map Name Text
forall l. IsList l => [Item l] -> l
fromList ([Item (Map Name Text)] -> Map Name Text)
-> [Item (Map Name Text)] -> Map Name Text
forall a b. (a -> b) -> a -> b
$
        [Maybe (Name, Text)] -> [(Name, Text)]
forall a. [Maybe a] -> [a]
catMaybes
          [ (Name, Text) -> Maybe (Name, Text)
forall a. a -> Maybe a
Just ((Name, Text) -> Maybe (Name, Text))
-> (Name, Text) -> Maybe (Name, Text)
forall a b. (a -> b) -> a -> b
$ (Name
"name", Text
testName'),
            (,) Name
"time" (Text -> (Name, Text))
-> (Double -> Text) -> Double -> (Name, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Text) -> (Double -> FilePath) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> FilePath
forall a. Show a => a -> FilePath
show (Double -> (Name, Text)) -> Maybe Double -> Maybe (Name, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Double
time'
          ]
    children :: [Node]
children =
      Element -> Node
XML.NodeElement
        (Element -> Node) -> [Element] -> [Node]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe Element] -> [Element]
forall a. [Maybe a] -> [a]
catMaybes
          [ a -> Maybe Element
forall a. Outcome a => a -> Maybe Element
outcomeToXML a
outcome',
            Name -> Map Name Text -> [Node] -> Element
XML.Element Name
"system-out" Map Name Text
forall a. Monoid a => a
mempty ([Node] -> Element) -> (Text -> [Node]) -> Text -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> [Node]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Node -> [Node]) -> (Text -> Node) -> Text -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Node
XML.NodeContent (Text -> Element) -> Maybe Text -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
stdout',
            Name -> Map Name Text -> [Node] -> Element
XML.Element Name
"system-err" Map Name Text
forall a. Monoid a => a
mempty ([Node] -> Element) -> (Text -> [Node]) -> Text -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> [Node]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Node -> [Node]) -> (Text -> Node) -> Text -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Node
XML.NodeContent (Text -> Element) -> Maybe Text -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
stderr'
          ]

encodeFailure :: Failed -> XML.Element
encodeFailure :: Failed -> Element
encodeFailure Failed
failure =
  Name -> Map Name Text -> [Node] -> Element
XML.Element
    Name
"failure"
    (Map Name Text
-> (Text -> Map Name Text) -> Maybe Text -> Map Name Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map Name Text
forall a. Monoid a => a
mempty (\Text
v -> [Item (Map Name Text)] -> Map Name Text
forall l. IsList l => [Item l] -> l
fromList [(Name
"message", Text
v)]) (Failed -> Maybe Text
failureMessage' Failed
failure))
    [Text -> Node
XML.NodeContent ([Text] -> Text
T.unlines (Failed -> [Text]
failureStackTrace' Failed
failure))]

encodeError :: Errored -> XML.Element
encodeError :: Errored -> Element
encodeError Errored
err =
  Name -> Map Name Text -> [Node] -> Element
XML.Element
    Name
"error"
    (Map Name Text
-> (Text -> Map Name Text) -> Maybe Text -> Map Name Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map Name Text
forall a. Monoid a => a
mempty (\Text
v -> [Item (Map Name Text)] -> Map Name Text
forall l. IsList l => [Item l] -> l
fromList [(Name
"message", Text
v)]) (Errored -> Maybe Text
errorMessage' Errored
err))
    [Text -> Node
XML.NodeContent ([Text] -> Text
T.unlines (Errored -> [Text]
errorStackTrace' Errored
err))]

countAttributes :: Counts -> [(XML.Name, T.Text)]
countAttributes :: Counts -> [(Name, Text)]
countAttributes Counts
counts =
  [ (Name
"tests", FilePath -> Text
T.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show (Counts -> Int
cumTests Counts
counts))),
    (Name
"failures", FilePath -> Text
T.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show (Counts -> Int
cumFailed Counts
counts))),
    (Name
"errors", FilePath -> Text
T.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show (Counts -> Int
cumErrored Counts
counts))),
    (Name
"skipped", FilePath -> Text
T.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show (Counts -> Int
cumSkipped Counts
counts))),
    (Name
"time", FilePath -> Text
T.pack (Double -> FilePath
forall a. Show a => a -> FilePath
show (Counts -> Double
cumTime Counts
counts)))
  ]