hspec-junit-formatter 1.2.1.0 → 1.3.0.0
raw patch · 9 files changed
+880/−586 lines, 9 filesdep +mtldep +semigroupsdep −containersdep −exceptionsdep −hspec-golden
Dependencies added: mtl, semigroups
Dependencies removed: containers, exceptions, hspec-golden, pretty-simple
Files
- hspec-junit-formatter.cabal +16/−24
- library/Test/Hspec/JUnit/Format.hs +175/−110
- library/Test/Hspec/JUnit/Render.hs +195/−83
- library/Test/Hspec/JUnit/Schema.hs +185/−28
- tests/Test/Hspec/JUnit/FormatterSpec.hs +309/−73
- tests/golden/default-base-4.21.xml +0/−67
- tests/golden/default.xml +0/−67
- tests/golden/prefixed-base-4.21.xml +0/−67
- tests/golden/prefixed.xml +0/−67
hspec-junit-formatter.cabal view
@@ -1,25 +1,19 @@-cabal-version: 1.18-name: hspec-junit-formatter-version: 1.2.1.0-license: MIT-license-file: LICENSE-copyright: 2021 Renaissance Learning Inc-maintainer: engineering@freckle.com-author: Freckle R&D-homepage: https://github.com/freckle/hspec-junit-formatter#readme-bug-reports: https://github.com/freckle/hspec-junit-formatter/issues-synopsis: A JUnit XML runner/formatter for hspec+cabal-version: 1.18+name: hspec-junit-formatter+version: 1.3.0.0+license: MIT+license-file: LICENSE+copyright: 2021 Renaissance Learning Inc+maintainer: engineering@freckle.com+author: Freckle R&D+homepage: https://github.com/freckle/hspec-junit-formatter#readme+bug-reports: https://github.com/freckle/hspec-junit-formatter/issues+synopsis: A JUnit XML runner/formatter for hspec description: Allows hspec tests to write JUnit XML output for parsing in various tools. -category: Testing-build-type: Simple-extra-source-files:- tests/golden/default-base-4.21.xml- tests/golden/default.xml- tests/golden/prefixed-base-4.21.xml- tests/golden/prefixed.xml-+category: Testing+build-type: Simple extra-doc-files: README.md CHANGELOG.md@@ -58,15 +52,15 @@ array >=0.5.4.0, base >=4.16.4.0 && <5, conduit >=1.3.5,- containers >=0.6.5.1, directory >=1.3.6.2,- exceptions >=0.10.4, filepath >=1.4.2.2, hspec-api >=2.10.0, hspec-core >=2.10.0, iso8601-time >=0.1.5,+ mtl >=2.2.2, regex-base >=0.94.0.2, regex-tdfa >=1.3.2.1,+ semigroups >=0.20, text >=1.2.5.0, time >=1.11.1.1, xml-conduit >=1.10.0.0,@@ -137,12 +131,10 @@ build-depends: base >=4.16.4.0 && <5,- containers >=0.6.5.1, filepath >=1.4.2.2, hspec >=2.10.0,- hspec-golden >=0.2.1.0, hspec-junit-formatter,- pretty-simple >=4.1.2.0,+ iso8601-time >=0.1.5, temporary >=1.3, text >=1.2.5.0, xml-conduit >=1.10.0.0
library/Test/Hspec/JUnit/Format.hs view
@@ -1,23 +1,40 @@+{-# OPTIONS_GHC -Wno-ambiguous-fields #-}+ module Test.Hspec.JUnit.Format ( junit ) where import Prelude -import Conduit (runConduitRes, sinkFile, yield, (.|))+import Conduit import Control.Applicative ((<|>))-import Data.Functor ((<&>))-import Data.Map.Strict qualified as Map-import Data.Maybe (fromMaybe)-import Data.Text (Text, pack, unpack)-import Data.Text qualified as T-import Data.Time (getCurrentTime)+import Control.Exception (displayException)+import Control.Monad.Reader (runReaderT)+import Data.List (intercalate)+import Data.List.NonEmpty (NonEmpty)+import Data.List.NonEmpty qualified as NE+import Data.Monoid (First (..))+import Data.Semigroup (Sum (..))+import Data.Semigroup.Generic (GenericSemigroupMonoid (..))+import Data.Text (Text, pack)+import Data.Time (UTCTime, getCurrentTime)+import Data.Typeable (typeOf)+import GHC.Generics (Generic)+import Numeric.Natural (Natural) import System.Directory (createDirectoryIfMissing)-import System.FilePath (splitFileName)+import System.FilePath (takeDirectory) import Test.Hspec.Api.Format.V1+ ( Event (..)+ , Format+ , FormatConfig+ , Item (..)+ , Location (..)+ , Path+ )+import Test.Hspec.Api.Format.V1 qualified as Hspec import Test.Hspec.JUnit.Config as Config-import Test.Hspec.JUnit.Render (renderJUnit)-import Test.Hspec.JUnit.Schema qualified as Schema+import Test.Hspec.JUnit.Render+import Test.Hspec.JUnit.Schema import Text.XML.Stream.Render (def, renderBytes) import Text.XML.Stream.Render.Internal (rsPretty) @@ -29,121 +46,169 @@ Progress _ _ -> pure () ItemStarted _ -> pure () ItemDone _ _ -> pure ()- Done paths -> do- time <- getCurrentTime-- let (directory, _) = splitFileName file- createDirectoryIfMissing True directory-- let- groups = groupItems paths- output =- Schema.Suites- { name = suiteName- , suites =- groups <&> \(group, items) -> do- let suite xs =- Schema.Suite- { name = group- , timestamp = time- , cases = xs- }- suite $ uncurry (itemToTestCase applyPrefix group) <$> items- }-+ Done items -> do+ now <- getCurrentTime+ createDirectoryIfMissing True $ takeDirectory file runConduitRes- $ yield output- .| renderJUnit dropConsoleFormatting+ $ transPipe (`runReaderT` junitConfig)+ $ renderTestsuites (formatTestsuites now suiteName items) .| renderBytes renderConfig .| sinkFile file where file = getJUnitConfigOutputFile junitConfig suiteName = getJUnitConfigSuiteName junitConfig- applyPrefix = getJUnitPrefixSourcePath junitConfig- dropConsoleFormatting = getJUnitConfigDropConsoleFormatting junitConfig renderConfig = def {rsPretty = getJUnitConfigPretty junitConfig} -groupItems :: [(Path, Item)] -> [(Text, [(Text, Item)])]-groupItems = Map.toList . Map.fromListWith (<>) . fmap group+formatTestsuites :: UTCTime -> Text -> [(Path, Item)] -> Testsuites+formatTestsuites now suiteName items =+ Testsuites+ { name = Attr suiteName+ , tests = getSum totals.tests+ , failures = getSum totals.failures+ , errors = getSum totals.errors+ , skipped = getSum totals.skipped+ , assertions = getSum totals.assertions+ , time = getSum totals.time+ , timestamp = Attr now+ , children = suites+ } where- group ((path, name), item) =- (T.intercalate "/" $ pack <$> path, [(pack name, item)])+ -- Group all items by prefix and then convert each group to a suite. In an+ -- ideal world, we would build a tree instead so we could correctly render+ -- nested contexts as nested testsuites, but that is hard and I'm tired.+ suites :: [Testsuite]+ suites = map (formatTestsuite now) $ NE.groupAllWith (fst . fst) items -itemToTestCase- :: (FilePath -> FilePath) -> Text -> Text -> Item -> Schema.TestCase-itemToTestCase applyPrefix group name item =- Schema.TestCase- { location =- toSchemaLocation applyPrefix- <$> (itemResultLocation item <|> itemLocation item)- , className = group- , name = name- , duration = unSeconds $ itemDuration item- , result = case itemResult item of- Success -> Nothing- Pending mLocation mMessage ->- Just- $ Schema.Skipped- $ prefixLocation mLocation- $ prefixInfo- $ maybe "" pack mMessage- Failure mLocation reason ->- Just- $ Schema.Failure "error"- $ prefixLocation mLocation- $ prefixInfo- $ reasonToText reason+ totals :: SuiteTotals+ totals = foldMap getSuiteTotals suites++formatTestsuite :: UTCTime -> NonEmpty (Path, Item) -> Testsuite+formatTestsuite now items =+ Testsuite+ { name = Attr $ pack $ intercalate "/" path+ , tests = getSum totals.tests+ , failures = getSum totals.failures+ , errors = getSum totals.errors+ , skipped = getSum totals.skipped+ , assertions = getSum totals.assertions+ , time = getSum totals.time+ , timestamp = Attr now+ , file = getFirst totals.file+ , children } where- prefixLocation mLocation str = case mLocation of- Nothing -> str- Just l ->- mconcat- [ pack $ applyPrefix $ locationFile l- , ":"- , pack $ show $ locationLine l- , ":"- , pack $ show $ locationColumn l- , "\n"- ]- <> str- prefixInfo str- | T.null $ T.strip $ pack $ itemInfo item = str- | otherwise = pack (itemInfo item) <> "\n\n" <> str+ path :: [String]+ path = fst $ fst $ NE.head items -itemResultLocation :: Item -> Maybe Location-itemResultLocation item = case itemResult item of- Success -> Nothing- Pending mLocation _ -> mLocation- Failure mLocation _ -> mLocation+ children :: [TestsuiteChild]+ children = NE.toList $ TestsuiteTestcase . formatTestcase <$> items -toSchemaLocation :: (FilePath -> FilePath) -> Location -> Schema.Location-toSchemaLocation applyPrefix l =- Schema.Location- { Schema.file = applyPrefix $ locationFile l- , Schema.line = fromIntegral $ max 0 $ locationLine l+ totals :: SuiteTotals+ totals = foldMap getSuiteChildTotals children++formatTestcase :: (Path, Item) -> Testcase+formatTestcase ((path, name), item) =+ Testcase+ { name = Attr $ pack name+ , classname = Attr $ pack $ intercalate "/" path+ , assertions = Attr 0 -- not available with Hspec+ , time = Attr $ itemDuration item+ , file = Attr . locationFile <$> location+ , line = Attr . fromIntegral . locationLine <$> location+ , properties = Nothing+ , systemStream = []+ , child }+ where+ (location, child) = case itemResult item of+ Hspec.Success ->+ ( itemLocation item+ , TestcaseEmpty+ )+ Hspec.Pending mLocation mMessage ->+ ( mLocation <|> itemLocation item+ , TestcaseSkipped $ Skipped $ maybe "" (Attr . pack) mMessage+ )+ Hspec.Failure mLocation reason ->+ ( mLocation <|> itemLocation item+ , formatFailureReason reason+ ) -unSeconds :: Seconds -> Double-unSeconds (Seconds x) = x+formatFailureReason :: Hspec.FailureReason -> TestcaseChild+formatFailureReason = \case+ Hspec.NoReason ->+ TestcaseFailure+ $ Failure+ { message = "No reason given"+ , type_ = "Failure.NoReason"+ , content = "No reason given"+ }+ Hspec.Reason msg ->+ TestcaseFailure+ $ Failure+ { message = Attr $ firstLineOf msg+ , type_ = "Failure.Reason"+ , content = Content $ pack $ msg <> "\n"+ }+ Hspec.ExpectedButGot mPrefix expected got ->+ TestcaseFailure+ $ Failure+ { message = Attr "Received value did not match expected"+ , type_ = Attr "Failure.ExpectedButGot"+ , content =+ Content+ $ pack+ $ mconcat+ [ maybe "" (<> "\n") mPrefix+ , "Expected: " <> show expected <> "\n"+ , " but got: " <> show got <> "\n"+ ]+ }+ Hspec.Error mPrefix ex ->+ TestcaseError+ $ Error+ { message = Attr $ firstLineOf $ displayException ex+ , type_ = Attr $ pack $ show $ typeOf ex+ , content =+ Content+ $ pack+ $ mconcat+ [ maybe "" (<> "\n") mPrefix+ , displayException ex <> "\n"+ ]+ }+ where+ firstLineOf =+ maybe "" (pack . NE.head)+ . NE.nonEmpty+ . lines -reasonToText :: FailureReason -> Text-reasonToText = \case- Error _ err -> pack $ show err- NoReason -> "no reason"- Reason err -> pack err- ExpectedButGot preface expected actual ->- T.unlines- $ pack- <$> fromMaybe "" preface- : ( foundLines "expected" expected- <> foundLines " but got" actual- )+data SuiteTotals = SuiteTotals+ { tests :: Sum (Attr Natural)+ , failures :: Sum (Attr Natural)+ , errors :: Sum (Attr Natural)+ , skipped :: Sum (Attr Natural)+ , assertions :: Sum (Attr Natural)+ , time :: Sum (Attr Seconds)+ , file :: First (Attr FilePath)+ }+ deriving stock (Generic)+ deriving (Monoid, Semigroup) via GenericSemigroupMonoid SuiteTotals -foundLines :: Show a => Text -> a -> [String]-foundLines msg found = case lines' of- [] -> []- first : rest ->- unpack (msg <> ": " <> first) : (unpack . (T.replicate 9 " " <>) <$> rest)- where- lines' = T.lines . pack $ show found+getSuiteTotals :: Testsuite -> SuiteTotals+getSuiteTotals s = foldMap getSuiteChildTotals s.children++getSuiteChildTotals :: TestsuiteChild -> SuiteTotals+getSuiteChildTotals = \case+ TestsuiteTestcase tc ->+ let+ base :: SuiteTotals+ base = mempty {tests = 1, time = Sum tc.time, file = First tc.file}+ in+ case tc.child of+ TestcaseEmpty -> base+ TestcaseSkipped {} -> base {skipped = 1}+ TestcaseFailure {} -> base {failures = 1}+ TestcaseError {} -> base {errors = 1}+ TestsuiteTestsuite s -> getSuiteTotals s+ _ -> mempty
library/Test/Hspec/JUnit/Render.hs view
@@ -1,103 +1,215 @@ module Test.Hspec.JUnit.Render- ( renderJUnit+ ( renderTestsuites ) where import Prelude -import Conduit (ConduitT, awaitForever, mergeSource, yield, yieldMany, (.|))-import Control.Monad.Catch (MonadThrow)+import Conduit (ConduitT)+import Control.Monad (unless)+import Control.Monad.Reader (MonadReader (..), asks) import Data.Array qualified as Array-import Data.Conduit.List qualified as CL+import Data.Fixed (Nano) import Data.Foldable (traverse_)+import Data.Semigroup (Endo (..)) import Data.Text (Text, pack)-import Data.Text qualified as Text+import Data.Text qualified as T import Data.Time.ISO8601 (formatISO8601) import Data.XML.Types (Event)+import Test.Hspec.JUnit.Config import Test.Hspec.JUnit.Schema- ( Location (..)- , Result (..)- , Suite (..)- , Suites (..)- , TestCase (..)- )-import Text.Printf import Text.Regex.Base qualified as Regex-import Text.Regex.TDFA.Text qualified as Regex-import Text.XML.Stream.Render (attr, content, tag)+import Text.Regex.TDFA.Text (Regex)+import Text.XML.Stream.Render (attr, content, optionalAttr, tag) -renderJUnit :: MonadThrow m => Bool -> ConduitT Suites Event m ()-renderJUnit shouldDropConsoleFormatting = awaitForever $ \s ->- tag "testsuites" (attr "name" s.name)- $ yieldMany s.suites- .| mergeSource idStream- .| suite shouldDropConsoleFormatting- where- idStream = CL.iterate (+ 1) 0+renderTestsuites+ :: MonadReader JUnitConfig m+ => Testsuites+ -> ConduitT i Event m ()+renderTestsuites s = do+ tag+ "testsuites"+ ( attr "name" (unAttr id s.name)+ <> attr "tests" (unAttr (pack . show) s.tests)+ <> attr "failures" (unAttr (pack . show) s.failures)+ <> attr "errors" (unAttr (pack . show) s.errors)+ <> attr "skipped" (unAttr (pack . show) s.skipped)+ <> attr "assertions" (unAttr (pack . show) s.assertions)+ <> attr "time" (unAttr unSeconds s.time)+ <> attr "timestamp" (unAttr (pack . formatISO8601) s.timestamp)+ )+ $ traverse_ renderTestsuite s.children -suite :: MonadThrow m => Bool -> ConduitT (Int, Suite) Event m ()-suite shouldDropConsoleFormatting = awaitForever $ \(i, s) ->- tag "testsuite" (attributes i s) $ do- tag "properties" mempty mempty- yieldMany s.cases .| testCase shouldDropConsoleFormatting- where- -- TODO these need to be made real values- attributes i s =- attr "name" s.name- <> attr "package" s.name- <> attr "id" (tshow i)- <> attr "time" (roundToStr $ sumDurations s.cases)- <> attr "timestamp" (pack $ formatISO8601 s.timestamp)- <> attr "hostname" "localhost"- <> attr "tests" (tshow $ length s.cases)- <> attr "failures" (tshow $ length [() | Just Failure {} <- (.result) <$> s.cases])- <> attr "errors" "0"- <> attr "skipped" (tshow $ length [() | Just Skipped {} <- (.result) <$> s.cases])+renderTestsuite+ :: MonadReader JUnitConfig m+ => Testsuite+ -> ConduitT i Event m ()+renderTestsuite s = do+ prefix <- asks getJUnitPrefixSourcePath -tshow :: Show a => a -> Text-tshow = pack . show+ tag+ "testsuite"+ ( attr "name" (unAttr id s.name)+ <> attr "tests" (unAttr (pack . show) s.tests)+ <> attr "failures" (unAttr (pack . show) s.failures)+ <> attr "errors" (unAttr (pack . show) s.errors)+ <> attr "skipped" (unAttr (pack . show) s.skipped)+ <> attr "assertions" (unAttr (pack . show) s.assertions)+ <> attr "time" (unAttr unSeconds s.time)+ <> attr "timestamp" (unAttr (pack . formatISO8601) s.timestamp)+ <> optionalAttr "file" (unAttr (pack . prefix) <$> s.file)+ )+ $ traverse_ renderTestsuiteChild s.children -testCase :: MonadThrow m => Bool -> ConduitT TestCase Event m ()-testCase shouldDropConsoleFormatting =- awaitForever $ \(TestCase mLocation className name duration mResult) ->- tag "testcase" (attributes mLocation className name duration)- $ traverse_ yield mResult- .| result shouldDropConsoleFormatting- where- attributes mLocation className name duration =- maybe mempty (attr "file" . pack . (.file)) mLocation- <> maybe mempty (attr "line" . pack . show . (.line)) mLocation- <> attr "name" name- <> attr "classname" className- <> attr "time" (roundToStr duration)+renderTestsuiteChild+ :: MonadReader JUnitConfig m+ => TestsuiteChild+ -> ConduitT i Event m ()+renderTestsuiteChild = \case+ TestsuiteProperties x -> renderProperties x+ TestsuiteSystemOut x -> renderSystemOut x+ TestsuiteSystemErr x -> renderSystemErr x+ TestsuiteTestcase x -> renderTestcase x+ TestsuiteTestsuite x -> renderTestsuite x -result :: MonadThrow m => Bool -> ConduitT Result Event m ()-result shouldDropConsoleFormatting = awaitForever go- where- go (Failure fType contents) =- tag "failure" (attr "type" fType) $ content $ dropConsoleFormatting contents- go (Skipped contents) = tag "skipped" mempty $ content $ dropConsoleFormatting contents+renderProperties+ :: MonadReader JUnitConfig m+ => Properties+ -> ConduitT i Event m ()+renderProperties ps = unless (null ps.unwrap) $ do+ tag "properties" mempty $ traverse_ renderProperty $ ps.unwrap - -- Drops ANSI control characters which might be used to set colors.- -- Including these breaks XML, there is not much point encoding them.- dropConsoleFormatting :: Text -> Text- dropConsoleFormatting input- | shouldDropConsoleFormatting =- let- regex = Regex.makeRegex (pack "\x1b\\[[0-9;]*[mGKHF]") :: Regex.Regex- matches = Regex.matchAll regex input- dropMatch (offset, len) input' =- let- (begining, rest) = Text.splitAt offset input'- (_, end) = Text.splitAt len rest- in- begining <> end- matchTuples = map (Array.! 0) matches- in- foldr dropMatch input matchTuples- | otherwise = input+renderProperty+ :: MonadReader JUnitConfig m+ => Property+ -> ConduitT i Event m ()+renderProperty p = case p.value of+ Left a ->+ tag "property" (attr "name" (unAttr id p.name) <> attr "value" (unAttr id a))+ $ pure ()+ Right c -> tag "property" (attr "name" (unAttr id p.name)) $ renderContent c -sumDurations :: [TestCase] -> Double-sumDurations cases = sum $ (.duration) <$> cases+renderSystemOut+ :: MonadReader JUnitConfig m+ => SystemOut+ -> ConduitT i Event m ()+renderSystemOut = tag "system-out" mempty . renderContent . (.unwrap) -roundToStr :: PrintfArg a => a -> Text-roundToStr = pack . printf "%0.9f"+renderSystemErr+ :: MonadReader JUnitConfig m+ => SystemErr+ -> ConduitT i Event m ()+renderSystemErr = tag "system-err" mempty . renderContent . (.unwrap)++renderTestcase+ :: MonadReader JUnitConfig m+ => Testcase+ -> ConduitT i Event m ()+renderTestcase c = do+ prefix <- asks getJUnitPrefixSourcePath++ tag+ "testcase"+ ( attr "name" (unAttr id c.name)+ <> attr "classname" (unAttr id c.classname)+ <> attr "assertions" (unAttr (pack . show) c.assertions)+ <> attr "time" (unAttr unSeconds c.time)+ <> optionalAttr "file" (unAttr (pack . prefix) <$> c.file)+ <> optionalAttr "line" (unAttr (pack . show) <$> c.line)+ )+ $ do+ traverse_ renderProperties c.properties+ traverse_ (either renderSystemOut renderSystemErr) c.systemStream+ renderTestcaseChild c.child++renderTestcaseChild+ :: MonadReader JUnitConfig m+ => TestcaseChild+ -> ConduitT i Event m ()+renderTestcaseChild = \case+ TestcaseEmpty -> pure ()+ TestcaseSkipped x -> renderSkipped x+ TestcaseFailure x -> renderFailure x+ TestcaseError x -> renderError x++renderSkipped+ :: MonadReader JUnitConfig m+ => Skipped+ -> ConduitT i Event m ()+renderSkipped s = tag "skipped" (attr "message" (unAttr id s.message)) $ pure ()++renderFailure+ :: MonadReader JUnitConfig m+ => Failure+ -> ConduitT i Event m ()+renderFailure f =+ tag+ "failure"+ (attr "message" (unAttr id f.message) <> attr "type" (unAttr id f.type_))+ $ renderContent f.content++renderError+ :: MonadReader JUnitConfig m+ => Error+ -> ConduitT i Event m ()+renderError e =+ tag+ "error"+ (attr "message" (unAttr id e.message) <> attr "type" (unAttr id e.type_))+ $ renderContent e.content++renderContent+ :: MonadReader JUnitConfig m+ => Content+ -> ConduitT i Event m ()+renderContent c = do+ shouldDropConsoleFormatting <- asks getJUnitConfigDropConsoleFormatting++ let clean =+ if shouldDropConsoleFormatting+ then dropConsoleFormatting+ else id++ content $ clean $ c.unwrap++unSeconds :: Seconds -> Text+unSeconds (Seconds d) = pack $ show $ realToFrac @_ @Nano d++-- | Safely render an attribute+--+-- HTML encoding is handled by @xml-conduit@, but additionally we:+--+-- * Drop console formatting (always)+-- * Extra-escape unsupported characters (e.g @\a@ becomes @\\a@)+unAttr :: (a -> Text) -> Attr a -> Text+unAttr f = escapeIllegal . dropConsoleFormatting . f . (.unwrap)++escapeIllegal :: Text -> Text+escapeIllegal =+ appEndo+ $ foldMap+ (\(a, b) -> Endo $ T.replace a b)+ [ ("\0", "\\0")+ , ("\a", "\\a")+ , ("\b", "\\b")+ , ("\f", "\\f")+ , ("\v", "\\v")+ , ("\ESC", "\\ESC")+ ]++-- | Drop ANSI control characters which might be used to set colors+--+-- We always do this in attribute values, since they'd only break XML, but we+-- only do it in content if configured by options, since we want any content+-- node changes to be opt-in.+dropConsoleFormatting :: Text -> Text+dropConsoleFormatting input =+ foldr (dropBetween . (Array.! 0)) input $ Regex.matchAll escRegex input++escRegex :: Regex+escRegex = Regex.makeRegex ("\x1b\\[[0-9;]*[mGKHF]" :: Text)++dropBetween :: (Int, Int) -> Text -> Text+dropBetween (offset, len) input = begining <> end+ where+ (begining, rest) = T.splitAt offset input+ (_, end) = T.splitAt len rest
library/Test/Hspec/JUnit/Schema.hs view
@@ -1,44 +1,201 @@+-- | The structure of a JUnit XML file+--+-- This intends to be a complete and accurate representation of+-- <https://github.com/testmoapp/junitxml#complete-junit-xml-example>, though we+-- don't (and sometimes can't) exercise all of it. module Test.Hspec.JUnit.Schema- ( Suites (..)- , Suite (..)- , TestCase (..)- , Location (..)- , Result (..)+ ( Testsuites (..)+ , Testsuite (..)+ , TestsuiteChild (..)+ , Testcase (..)+ , TestcaseChild (..)+ , Skipped (..)+ , Failure (..)+ , Error (..)+ , Properties (..)+ , Property (..)+ , SystemOut (..)+ , SystemErr (..)++ -- * Tagged XML types+ , Attr (..)+ , Content (..)++ -- * Other wrapper types+ , Seconds (..) ) where import Prelude +import Data.String (IsString) import Data.Text (Text) import Data.Time (UTCTime)-import Numeric.Natural+import Numeric.Natural (Natural)+import Test.Hspec.Core.Format (Seconds (..)) -data Suites = Suites- { name :: Text- , suites :: [Suite]+-- | @<testsuites>@+--+-- Usually the root element of a JUnit XML file. Some tools leave out the+-- @<testsuites>@ element if there is only a single top-level @<testsuite>@+-- element (which is then used as the root element).+data Testsuites = Testsuites+ { name :: Attr Text+ -- ^ Name of the entire test run+ , tests :: Attr Natural+ -- ^ Total number of tests in this file+ , failures :: Attr Natural+ -- ^ Total number of failed tests in this file+ , errors :: Attr Natural+ -- ^ Total number of errored tests in this file+ , skipped :: Attr Natural+ -- ^ Total number of skipped tests in this file+ , assertions :: Attr Natural+ -- ^ Total number of assertions for all tests in this file+ , time :: Attr Seconds+ -- ^ Aggregated time of all tests in this file in seconds+ , timestamp :: Attr UTCTime+ -- ^ Date and time of when the test run was executed (in ISO 8601 format)+ , children :: [Testsuite]+ -- ^ Only @<testsuite>@s can be descendents of this node }- deriving stock (Show) -data Suite = Suite- { name :: Text- , timestamp :: UTCTime- , cases :: [TestCase]+-- | @<testsuite>@+--+-- A test suite usually represents a class, folder or group of tests. There can+-- be many test suites in an XML file, and there can be test suites under other+-- test suites.+data Testsuite = Testsuite+ { name :: Attr Text+ -- ^ Name of the test suite (e.g. class name or folder name)+ , tests :: Attr Natural+ -- ^ Total number of tests in this suite+ , failures :: Attr Natural+ -- ^ Total number of failed tests in this suite+ , errors :: Attr Natural+ -- ^ Total number of errored tests in this suite+ , skipped :: Attr Natural+ -- ^ Total number of skipped tests in this suite+ , assertions :: Attr Natural+ -- ^ Total number of assertions for all tests in this suite+ , time :: Attr Seconds+ -- ^ Aggregated time of all tests in this file in seconds+ , timestamp :: Attr UTCTime+ -- ^ Date and time of when the test suite was executed (in ISO 8601 format)+ , file :: Maybe (Attr FilePath)+ -- ^ Source code file of this test suite+ , children :: [TestsuiteChild] }- deriving stock (Show) -data TestCase = TestCase- { location :: Maybe Location- , className :: Text- , name :: Text- , duration :: Double- , result :: Maybe Result+-- | @<testsuite>@ can contain nodes that are any of these+data TestsuiteChild+ = TestsuiteProperties Properties+ | TestsuiteSystemOut SystemOut+ | TestsuiteSystemErr SystemErr+ | TestsuiteTestcase Testcase+ | TestsuiteTestsuite Testsuite++-- | @<properties>@+--+-- Test suites can have additional properties such as environment variables or+-- version numbers. Some tools also support properties for test cases.+newtype Properties = Properties+ { unwrap :: [Property] }- deriving stock (Show) -data Location = Location- { file :: FilePath- , line :: Natural+-- | @<property>@+--+-- Each property has a name and value. Some tools also support properties with+-- text values instead of value attributes.+data Property = Property+ { name :: Attr Text+ , value :: Either (Attr Text) Content }- deriving stock (Show) -data Result = Failure Text Text | Skipped Text- deriving stock (Show)+-- | @<system-out>@+--+-- Optionally data written to standard out for the suite. Also supported on a+-- test case level, see below.+newtype SystemOut = SystemOut+ { unwrap :: Content+ }++-- | @<system-err>@+--+-- Optionally data written to standard error for the suite. Also supported on a+-- test case level, see below.+newtype SystemErr = SystemErr+ { unwrap :: Content+ }++-- | @<testcase>@+--+-- There are one or more test cases in a test suite. A test passed if there+-- isn't an additional result element (skipped, failure, error).+data Testcase = Testcase+ { name :: Attr Text+ -- ^ The name of this test case, often the method name+ , classname :: Attr Text+ -- ^ The name of the parent class/folder, often the same as the suite's name+ , assertions :: Attr Natural+ -- ^ Number of assertions checked during test case execution+ , time :: Attr Seconds+ -- ^ Execution time of the test in seconds+ , file :: Maybe (Attr FilePath)+ -- ^ Source code file of this test case+ , line :: Maybe (Attr Natural)+ -- ^ Source code line number of the start of this test case+ , properties :: Maybe Properties+ , systemStream :: [Either SystemOut SystemErr]+ -- ^ Stored as a combined list to represent ordering and interleaving+ , child :: TestcaseChild+ }++-- | @<testcase>@ will contain only one of these+data TestcaseChild+ = -- | Success case+ TestcaseEmpty+ | TestcaseSkipped Skipped+ | TestcaseFailure Failure+ | TestcaseError Error++-- | @<skipped>@+--+-- Indicates that the test was not executed. Can have an optional message+-- describing why the test was skipped.+newtype Skipped = Skipped+ { message :: Attr Text+ }++-- | @<failure>@+--+-- The test failed because one of the assertions/checks failed. Can have a+-- message and failure type, often the assertion type or class. The text content+-- of the element often includes the failure description or stack trace.+data Failure = Failure+ { message :: Attr Text+ , type_ :: Attr Text+ , content :: Content+ -- ^ Failure description or stack trace+ }++-- | @<error>@+--+-- The test had an unexpected error during execution. Can have a message and+-- error type, often the exception type or class. The text content of the+-- element often includes the error description or stack trace.+data Error = Error+ { message :: Attr Text+ , type_ :: Attr Text+ , content :: Content+ -- ^ Error description or stack trace+ }++newtype Attr a = Attr+ { unwrap :: a+ }+ deriving newtype (IsString, Num)++newtype Content = Content+ { unwrap :: Text+ }+ deriving newtype (IsString)
tests/Test/Hspec/JUnit/FormatterSpec.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} module Test.Hspec.JUnit.FormatterSpec ( spec@@ -7,95 +7,331 @@ import Prelude import Control.Monad (void)-import Data.Map.Strict qualified as Map-import Data.Text.Lazy qualified as LT+import Data.Fixed (Micro, Nano)+import Data.Maybe (isJust)+import Data.Text (Text, unpack)+import Data.Text qualified as T+import Data.Time.ISO8601 (parseISO8601) import Example qualified-import System.FilePath ((<.>), (</>))+import System.FilePath ((</>)) import System.IO.Temp (withSystemTempDirectory) import Test.Hspec-import Test.Hspec.Golden import Test.Hspec.JUnit.Config import Test.Hspec.JUnit.Formatter qualified as Formatter-import Test.Hspec.Runner-import Text.Pretty.Simple (pShowNoColor)+import Test.Hspec.Runner qualified as Hspec+import Text.Read (readMaybe) import Text.XML qualified as XML-import Text.XML.Stream.Render.Internal qualified as XML+import Text.XML.Cursor spec :: Spec spec = do- it "matches golden file" $ do- junitGolden "default" id+ context "ExampleSpec" $ do+ doc <- runIO $ fromDocument <$> renderJUnitXml testConfig Example.spec - it "matches golden file with prefixing" $ do- junitGolden "prefixed" $ setJUnitConfigSourcePathPrefix "lol/monorepo"+ context "time attributes" $ do+ it "sums correctly on testsuites and testsuite" $ do+ let+ -- Do the summation at Nano...+ readNano :: Text -> Nano+ readNano = maybe 0 realToFrac . readMaybe @Double . unpack --- | Run @Example.spec@ and compare XML to a golden file-junitGolden- :: String- -- ^ Unique name- -> (JUnitConfig -> JUnitConfig)- -- ^ Any modification to make to the 'JUnitConfig' before running- -> IO (Golden XML.Document)-junitGolden name modifyConfig = do- actual <- withSystemTempDirectory "" $ \tmp -> do- let junitConfig =- modifyConfig- $ setJUnitConfigPretty True- $ setJUnitConfigOutputDirectory tmp- $ setJUnitConfigOutputName "test.xml"- $ defaultJUnitConfig "hspec-junit-format"+ -- ...but truncate to Micro for comparison+ readTimes :: [[Text]] -> Micro+ readTimes = realToFrac . sum . concatMap (map readNano) - runSpec' $ Formatter.use junitConfig Example.spec- readNormalizedXML $ tmp </> "test.xml"+ suitesTime :: Micro+ suitesTime =+ readTimes+ $ doc+ $| element "testsuites"+ &| attribute "time" - pure- Golden- { output = actual- , encodePretty = LT.unpack . pShowNoColor- , writeToFile = XML.writeFile (XML.def {XML.rsPretty = True})- , readFromFile = readNormalizedXML- , goldenFile = "tests" </> "golden" </> name <> suffix <.> "xml"- , actualFile = Nothing- , failFirstTime = False- }+ suiteTimes :: Micro+ suiteTimes =+ readTimes+ $ doc+ $| element "testsuites"+ &/ element "testsuite"+ &| attribute "time" -runSpec' :: Spec -> IO ()-runSpec' x = do- (config, forest) <- evalSpec defaultConfig x- void $ runSpecForest forest config+ casesTimes :: Micro+ casesTimes =+ readTimes+ $ doc+ $| element "testsuites"+ &/ element "testsuite"+ &/ element "testcase"+ &| attribute "time" -readNormalizedXML :: FilePath -> IO XML.Document-readNormalizedXML = fmap normalizeDoc . XML.readFile XML.def+ suitesTime `shouldSatisfy` (> 0)+ suitesTime `shouldBe` suiteTimes+ suitesTime `shouldBe` casesTimes -normalizeDoc :: XML.Document -> XML.Document-normalizeDoc = removeTimeAttributes+ context "timestamp attributes" $ do+ it "has the same timestamp on testsuites and testsuite" $ do+ let+ [suitesTimestamp] =+ concatMap (map (parseISO8601 . unpack))+ $ doc+ $| element "testsuites"+ &| attribute "timestamp" --- | Remove volatile attributes so they don't invalidate comparison-removeTimeAttributes :: XML.Document -> XML.Document-removeTimeAttributes =- removeAttributesByName "time" . removeAttributesByName "timestamp"+ [suite1Timestamp, suite2Timestamp] =+ concatMap (map (parseISO8601 . unpack))+ $ doc+ $| element "testsuites"+ &/ element "testsuite"+ &| attribute "timestamp" -removeAttributesByName :: XML.Name -> XML.Document -> XML.Document-removeAttributesByName name doc =- doc- { XML.documentRoot = go $ XML.documentRoot doc- }- where- go el =- el- { XML.elementAttributes = Map.delete name $ XML.elementAttributes el- , XML.elementNodes = map (onNodeElement go) $ XML.elementNodes el- }+ suitesTimestamp `shouldSatisfy` isJust+ suite1Timestamp `shouldSatisfy` isJust+ suite2Timestamp `shouldSatisfy` isJust+ suite1Timestamp `shouldBe` suitesTimestamp+ suite2Timestamp `shouldBe` suitesTimestamp - onNodeElement f = \case- XML.NodeElement el -> XML.NodeElement $ f el- n -> n+ context "testsuites node" $ do+ it "produces one, with our package name" $ do+ ( doc+ $| element "testsuites"+ &| attribute "name"+ )+ `shouldBe` [["hspec-junit-format"]] --- Store a separate golden for newer base because throwIO's behavior changed--- such that different location data is present and so our output changes-suffix :: String-#if MIN_VERSION_base(4,21,0)-suffix = "-base-4.21"-#else-suffix = ""-#endif+ context "testsuite nodes" $ do+ it "produces two" $ do+ ( doc+ $| element "testsuites"+ &/ element "testsuite"+ )+ `shouldSatisfy` (== 2) . length++ it "has name" $ do+ ( doc+ $| element "testsuites"+ &/ element "testsuite"+ &| attribute "name"+ )+ `shouldBe` [ ["Some section"]+ , ["Some section/A grouped context"]+ ]++ context "testcase nodes" $ do+ it "has time" $ do+ ( doc+ $| element "testsuites"+ &/ element "testsuite"+ &/ element "testcase"+ &| attribute "time"+ )+ `shouldSatisfy` (== 6) . length++ it "has timestamp" $ do+ ( doc+ $| element "testsuites"+ &/ element "testsuite"+ &/ element "testcase"+ &| attribute "timestamp"+ )+ `shouldSatisfy` (== 6) . length++ it "has classname" $ do+ ( doc+ $| element "testsuites"+ &/ element "testsuite"+ &/ element "testcase"+ &| attribute "classname"+ )+ `shouldBe` ( replicate 2 ["Some section"]+ <> replicate 4 ["Some section/A grouped context"]+ )++ it "has file" $ do+ ( doc+ $| element "testsuites"+ &/ element "testsuite"+ &/ element "testcase"+ &| attribute "file"+ )+ `shouldBe` replicate 6 ["tests/Example.hs"]++ it "has name" $ do+ ( doc+ $| element "testsuites"+ &/ element "testsuite"+ &/ element "testcase"+ &| attribute "name"+ )+ `shouldBe` [ ["has an expectation"]+ , ["has a failure"]+ , ["happens in a group"]+ , ["also happens in a group"]+ , ["gets skipped"]+ , ["throws a colourful exception"]+ ]++ context "first testsuite" $ do+ let [testsuite, _] = doc $| element "testsuites" &/ element "testsuite"++ it "has correct counts" $ do+ (testsuite $| attribute "errors") `shouldBe` ["0"]+ (testsuite $| attribute "failures") `shouldBe` ["1"]+ (testsuite $| attribute "skipped") `shouldBe` ["0"]+ (testsuite $| attribute "tests") `shouldBe` ["2"]++ it "produces two testcase nodes" $ do+ (testsuite $/ element "testcase") `shouldSatisfy` (== 2) . length++ context "first testcase" $ do+ let [testcase, _] = testsuite $/ element "testcase"++ it "has line" $ do+ (testcase $| attribute "line") `shouldBe` ["16"]++ it "has name" $ do+ (testcase $| attribute "name") `shouldBe` ["has an expectation"]++ it "has no child nodes" $ do+ (testcase $| child &| node) `shouldBe` []++ context "second testcase" $ do+ let [_, testcase] = testsuite $/ element "testcase"++ it "has line" $ do+ (testcase $| attribute "line") `shouldBe` ["19"]++ it "has name" $ do+ (testcase $| attribute "name") `shouldBe` ["has a failure"]++ it "has a failure reported" $ do+ ( testcase+ $/ element "failure"+ &/ content+ )+ `shouldBe` [ T.unlines+ [ "Expected: \"False\""+ , " but got: \"True\""+ ]+ ]++ context "second testsuite" $ do+ let [_, testsuite] =+ doc+ $| element "testsuites"+ &/ element "testsuite"++ it "has correct counts" $ do+ (testsuite $| attribute "errors") `shouldBe` ["1"]+ (testsuite $| attribute "failures") `shouldBe` ["0"]+ (testsuite $| attribute "skipped") `shouldBe` ["1"]+ (testsuite $| attribute "tests") `shouldBe` ["4"]++ it "produces four testcase nodes" $ do+ (testsuite $/ element "testcase") `shouldSatisfy` (== 4) . length++ context "first testcase" $ do+ let [testcase, _, _, _] = testsuite $/ element "testcase"++ it "has line" $ do+ (testcase $| attribute "line") `shouldBe` ["22"]++ it "has name" $ do+ (testcase $| attribute "name") `shouldBe` ["happens in a group"]++ it "has no child nodes" $ do+ (testcase $| child &| node) `shouldBe` []++ context "second testcase" $ do+ let [_, testcase, _, _] = testsuite $/ element "testcase"++ it "has line" $ do+ (testcase $| attribute "line") `shouldBe` ["24"]++ it "has name" $ do+ (testcase $| attribute "name") `shouldBe` ["also happens in a group"]++ it "has no child nodes" $ do+ (testcase $| child &| node) `shouldBe` []++ context "third testcase" $ do+ let [_, _, testcase, _] = testsuite $/ element "testcase"++ it "has line" $ do+ (testcase $| attribute "line") `shouldBe` ["27"]++ it "has name" $ do+ (testcase $| attribute "name") `shouldBe` ["gets skipped"]++ it "has a skipped node" $ do+ ( testcase+ $/ element "skipped"+ &| attribute "message"+ )+ `shouldBe` [["some reason"]]++ context "fourth testcase" $ do+ let [_, _, _, testcase] = testsuite $/ element "testcase"++ it "has line" $ do+ pendingWith "Newer base returns line 29"+ (testcase $| attribute "line") `shouldBe` ["28"]++ it "has name" $ do+ (testcase $| attribute "name") `shouldBe` ["throws a colourful exception"]++ context "error content" $ do+ let [el] = testcase $/ element "error"++ it "strips escapes from a message attribute" $ do+ -- Annoying, but Hspec has tied our hands here+ (el $| attribute "type") `shouldBe` ["SomeException"]+ (el $| attribute "message") `shouldBe` ["ColourfulException"]++ it "does not strip escapes in content" $ do+ let [c] = el $/ content++ take 1 (T.lines c) `shouldBe` ["\ESC[32mColour\ESC[31mful\ESC[0mException"]++ context "ExampleSpec with prefixing" $ do+ let testConfig' = setJUnitConfigSourcePathPrefix "lol/monorepo" testConfig+ doc <- runIO $ fromDocument <$> renderJUnitXml testConfig' Example.spec++ it "prefixes testcase file attributes" $ do+ ( doc+ $| element "testsuites"+ &/ element "testsuite"+ &/ element "testcase"+ &| attribute "file"+ )+ `shouldBe` replicate 6 ["lol/monorepo/tests/Example.hs"]++ context "ExampleSpec with dropConsoleFormatting" $ do+ let testConfig' = setJUnitConfigDropConsoleFormatting True testConfig+ doc <- runIO $ fromDocument <$> renderJUnitXml testConfig' Example.spec++ it "drops console formatting in text nodes" $ do+ let [c] =+ doc+ $| element "testsuites"+ &/ element "testsuite"+ &/ element "testcase"+ &/ element "error"+ &/ content++ take 1 (T.lines c) `shouldBe` ["ColourfulException"]++testConfig :: JUnitConfig+testConfig = defaultJUnitConfig "hspec-junit-format"++renderJUnitXml :: JUnitConfig -> Spec -> IO XML.Document+renderJUnitXml baseConfig x = do+ withSystemTempDirectory "" $ \tmp -> do+ let junitConfig =+ setJUnitConfigOutputDirectory tmp+ $ setJUnitConfigOutputName "test.xml" baseConfig++ (config, forest) <-+ Hspec.evalSpec Hspec.defaultConfig $ Formatter.use junitConfig x++ void $ Hspec.runSpecForest forest config++ XML.readFile XML.def $ tmp </> "test.xml"
− tests/golden/default-base-4.21.xml
@@ -1,67 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<testsuites name="hspec-junit-format">- <testsuite- errors="0"- failures="1"- hostname="localhost"- id="0"- name="Some section"- package="Some section"- skipped="0"- tests="2">- <properties/>- <testcase- classname="Some section"- file="tests/Example.hs"- line="19"- name="has a failure">- <failure type="error">- tests/Example.hs:19:12 expected: "False" but got: "True"- </failure>- </testcase>- <testcase- classname="Some section"- file="tests/Example.hs"- line="16"- name="has an expectation"/>- </testsuite>- <testsuite- errors="0"- failures="1"- hostname="localhost"- id="1"- name="Some section/A grouped context"- package="Some section/A grouped context"- skipped="1"- tests="4">- <properties/>- <testcase- classname="Some section/A grouped context"- file="tests/Example.hs"- line="29"- name="throws a colourful exception">- <failure type="error">- tests/Example.hs:29:9 ColourfulException- </failure>- </testcase>- <testcase- classname="Some section/A grouped context"- file="tests/Example.hs"- line="27"- name="gets skipped">- <skipped>- tests/Example.hs:27:9 some reason- </skipped>- </testcase>- <testcase- classname="Some section/A grouped context"- file="tests/Example.hs"- line="24"- name="also happens in a group"/>- <testcase- classname="Some section/A grouped context"- file="tests/Example.hs"- line="22"- name="happens in a group"/>- </testsuite>-</testsuites>
− tests/golden/default.xml
@@ -1,67 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<testsuites name="hspec-junit-format">- <testsuite- errors="0"- failures="1"- hostname="localhost"- id="0"- name="Some section"- package="Some section"- skipped="0"- tests="2">- <properties/>- <testcase- classname="Some section"- file="tests/Example.hs"- line="19"- name="has a failure">- <failure type="error">- tests/Example.hs:19:12 expected: "False" but got: "True"- </failure>- </testcase>- <testcase- classname="Some section"- file="tests/Example.hs"- line="16"- name="has an expectation"/>- </testsuite>- <testsuite- errors="0"- failures="1"- hostname="localhost"- id="1"- name="Some section/A grouped context"- package="Some section/A grouped context"- skipped="1"- tests="4">- <properties/>- <testcase- classname="Some section/A grouped context"- file="tests/Example.hs"- line="28"- name="throws a colourful exception">- <failure type="error">- ColourfulException- </failure>- </testcase>- <testcase- classname="Some section/A grouped context"- file="tests/Example.hs"- line="27"- name="gets skipped">- <skipped>- tests/Example.hs:27:9 some reason- </skipped>- </testcase>- <testcase- classname="Some section/A grouped context"- file="tests/Example.hs"- line="24"- name="also happens in a group"/>- <testcase- classname="Some section/A grouped context"- file="tests/Example.hs"- line="22"- name="happens in a group"/>- </testsuite>-</testsuites>
− tests/golden/prefixed-base-4.21.xml
@@ -1,67 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<testsuites name="hspec-junit-format">- <testsuite- errors="0"- failures="1"- hostname="localhost"- id="0"- name="Some section"- package="Some section"- skipped="0"- tests="2">- <properties/>- <testcase- classname="Some section"- file="lol/monorepo/tests/Example.hs"- line="19"- name="has a failure">- <failure type="error">- lol/monorepo/tests/Example.hs:19:12 expected: "False" but got: "True"- </failure>- </testcase>- <testcase- classname="Some section"- file="lol/monorepo/tests/Example.hs"- line="16"- name="has an expectation"/>- </testsuite>- <testsuite- errors="0"- failures="1"- hostname="localhost"- id="1"- name="Some section/A grouped context"- package="Some section/A grouped context"- skipped="1"- tests="4">- <properties/>- <testcase- classname="Some section/A grouped context"- file="lol/monorepo/tests/Example.hs"- line="29"- name="throws a colourful exception">- <failure type="error">- lol/monorepo/tests/Example.hs:29:9 ColourfulException- </failure>- </testcase>- <testcase- classname="Some section/A grouped context"- file="lol/monorepo/tests/Example.hs"- line="27"- name="gets skipped">- <skipped>- lol/monorepo/tests/Example.hs:27:9 some reason- </skipped>- </testcase>- <testcase- classname="Some section/A grouped context"- file="lol/monorepo/tests/Example.hs"- line="24"- name="also happens in a group"/>- <testcase- classname="Some section/A grouped context"- file="lol/monorepo/tests/Example.hs"- line="22"- name="happens in a group"/>- </testsuite>-</testsuites>
− tests/golden/prefixed.xml
@@ -1,67 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<testsuites name="hspec-junit-format">- <testsuite- errors="0"- failures="1"- hostname="localhost"- id="0"- name="Some section"- package="Some section"- skipped="0"- tests="2">- <properties/>- <testcase- classname="Some section"- file="lol/monorepo/tests/Example.hs"- line="19"- name="has a failure">- <failure type="error">- lol/monorepo/tests/Example.hs:19:12 expected: "False" but got: "True"- </failure>- </testcase>- <testcase- classname="Some section"- file="lol/monorepo/tests/Example.hs"- line="16"- name="has an expectation"/>- </testsuite>- <testsuite- errors="0"- failures="1"- hostname="localhost"- id="1"- name="Some section/A grouped context"- package="Some section/A grouped context"- skipped="1"- tests="4">- <properties/>- <testcase- classname="Some section/A grouped context"- file="lol/monorepo/tests/Example.hs"- line="28"- name="throws a colourful exception">- <failure type="error">- ColourfulException- </failure>- </testcase>- <testcase- classname="Some section/A grouped context"- file="lol/monorepo/tests/Example.hs"- line="27"- name="gets skipped">- <skipped>- lol/monorepo/tests/Example.hs:27:9 some reason- </skipped>- </testcase>- <testcase- classname="Some section/A grouped context"- file="lol/monorepo/tests/Example.hs"- line="24"- name="also happens in a group"/>- <testcase- classname="Some section/A grouped context"- file="lol/monorepo/tests/Example.hs"- line="22"- name="happens in a group"/>- </testsuite>-</testsuites>