hspec-junit-formatter 1.0.0.5 → 1.0.1.0
raw patch · 7 files changed
+247/−200 lines, 7 filesdep +containersdep +filepathdep +hspec-junit-formatterdep −hashabledep −resourcetdep −temporarydep ~hspecdep ~hspec-core
Dependencies added: containers, filepath, hspec-junit-formatter, time
Dependencies removed: hashable, resourcet, temporary
Dependency ranges changed: hspec, hspec-core
Files
- CHANGELOG.md +6/−3
- hspec-junit-formatter.cabal +26/−7
- library/Test/HSpec/JUnit.hs +114/−94
- library/Test/HSpec/JUnit/Parse.hs +0/−60
- library/Test/HSpec/JUnit/Render.hs +41/−30
- library/Test/HSpec/JUnit/Schema.hs +12/−6
- tests/Main.hs +48/−0
CHANGELOG.md view
@@ -1,10 +1,13 @@-## [_Unreleased_](https://github.com/freckle/hspec-junit-formatter/compare/v1.0.0.5...main)+## [_Unreleased_](https://github.com/freckle/hspec-junit-formatter/compare/v1.0.0.4...main) None -## [v1.0.0.5](https://github.com/freckle/hspec-junit-formatter/compare/v1.0.0.4...v1.0.0.5)+## [v1.0.1.0](https://github.com/freckle/hspec-junit-formatter/compare/v1.0.0.4...v1.0.1.0) -- Fix for hspec-2.7 (add `exampleStarted`)+- Format function can be used directly without `withConfig` or `runJUnitSpec`.+- Test case duration is now supported.+- Failure locations are listed for some result types.+- Timestamps in the resulting XML now display the start time of formatting. ## [v1.0.0.4](https://github.com/freckle/hspec-junit-formatter/compare/v1.0.0.3...v1.0.0.4)
hspec-junit-formatter.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: hspec-junit-formatter-version: 1.0.0.5+version: 1.0.1.0 license: MIT license-file: LICENSE copyright: 2021 Renaissance Learning Inc@@ -25,7 +25,6 @@ library exposed-modules: Test.HSpec.JUnit- Test.HSpec.JUnit.Parse Test.HSpec.JUnit.Render Test.HSpec.JUnit.Schema @@ -44,13 +43,33 @@ build-depends: base >=4.14.1.0 && <5, conduit >=1.3.4.1,+ containers >=0.6.2.1, directory >=1.3.6.0, exceptions >=0.10.4,- hashable >=1.3.0.0,- hspec >=2.7.10,- hspec-core >=2.7.10,- resourcet >=1.2.4.2,- temporary >=1.3,+ filepath >=1.4.2.1,+ hspec-core >=2.8.1, text >=1.2.4.1,+ time >=1.9.3, xml-conduit >=1.9.1.1, xml-types >=0.3.8++test-suite spec+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: tests+ other-modules: Paths_hspec_junit_formatter+ default-language: Haskell2010+ default-extensions:+ BangPatterns DeriveAnyClass DeriveFoldable DeriveFunctor+ DeriveGeneric DeriveLift DeriveTraversable DerivingStrategies+ FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving+ LambdaCase MultiParamTypeClasses NoImplicitPrelude+ NoMonomorphismRestriction OverloadedStrings RankNTypes+ RecordWildCards ScopedTypeVariables StandaloneDeriving+ TypeApplications TypeFamilies++ ghc-options: -threaded -rtsopts -O0 -with-rtsopts=-N+ build-depends:+ base >=4.14.1.0 && <5,+ hspec >=2.8.1,+ hspec-junit-formatter -any
library/Test/HSpec/JUnit.hs view
@@ -1,116 +1,136 @@ module Test.HSpec.JUnit- ( runJUnitSpec+ ( junitFormat+ , runJUnitSpec , configWith ) where import Prelude -import Control.Monad.Trans.Resource (runResourceT)-import Data.Conduit (runConduit, (.|))+import Data.Conduit (runConduitRes, (.|)) import Data.Conduit.Combinators (sinkFile)-import Data.Foldable (traverse_)+import Data.Conduit.List (sourceList)+import Data.Functor ((<&>))+import qualified Data.Map.Strict as Map+import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T+import Data.Time (getCurrentTime) import System.Directory (createDirectoryIfMissing)-import System.IO.Temp (emptySystemTempFile)-import Test.HSpec.JUnit.Parse (denormalize, parseJUnit)+import System.FilePath (splitFileName) import Test.HSpec.JUnit.Render (renderJUnit)-import Test.Hspec (Spec)-import Test.Hspec.Formatters- (FailureReason(..), FormatM, Formatter(..), writeLine)-import Test.Hspec.Runner (Config(..), Summary, runSpec)-import Text.XML.Stream.Parse (parseFile)+import qualified Test.HSpec.JUnit.Schema as Schema+import Test.Hspec.Core.Format+import Test.Hspec.Core.Runner+import Test.Hspec.Core.Spec (Spec) import Text.XML.Stream.Render (def, renderBytes) runJUnitSpec :: Spec -> (FilePath, String) -> Config -> IO Summary-runJUnitSpec spec (path, name) config = do- tempFile <- emptySystemTempFile $ "hspec-junit-" <> name- summary <- spec `runSpec` configWith tempFile name config- createDirectoryIfMissing True dirPath- runResourceT- . runConduit- $ parseFile def tempFile- .| parseJUnit- -- HSpec's formatter cannot correctly output JUnit, so we must denormalize- -- nested <testsuite /> elements.- .| denormalize- .| renderJUnit- .| renderBytes def- .| sinkFile (dirPath <> "/test_results.xml")- pure summary- where dirPath = path <> "/" <> name+runJUnitSpec spec (path, name) config =+ spec `runSpec` configWith filePath name config+ where filePath = path <> "/" <> name <> "/test_results.xml" configWith :: FilePath -> String -> Config -> Config-configWith filePath name config = config- { configFormatter = Just $ junitFormatter name- , configOutputFile = Right filePath- }+configWith filePath name config =+ config { configFormat = Just $ junitFormat filePath name } -junitFormatter :: String -> Formatter-junitFormatter suiteName = Formatter- { headerFormatter = do- writeLine "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>"- writeLine $ "<testsuites name=" <> show suiteName <> ">"- -- TODO needs: package, id, timestamp, hostname, tests, failures, errors, time- , exampleGroupStarted = \_paths name ->- writeLine $ "<testsuite name=" <> show (fixBrackets (T.pack name)) <> ">"- , exampleGroupDone = writeLine "</testsuite>"- , exampleProgress = \_ _ -> pure ()- , exampleStarted = \_path -> pure ()- , exampleSucceeded = \path _info -> do- testCaseOpen path- testCaseClose- , exampleFailed = \path info reason -> do- testCaseOpen path- writeLine "<failure type=\"error\">"- traverse_ (writeLine . fixReason) $ lines info- case reason of- Error _ err -> writeLine . fixReason $ show err- NoReason -> writeLine "no reason"- Reason err -> traverse_ (writeLine . fixReason) $ lines err- ExpectedButGot preface expected actual -> do- traverse_ writeLine preface- writeFound "expected" expected- writeFound " but got" actual- writeLine "</failure>"- testCaseClose- , examplePending = \path info reason -> do- testCaseOpen path- writeLine "<skipped>"- traverse_ (writeLine . fixReason) $ lines info- writeLine $ maybe "No reason given" fixReason reason- writeLine "</skipped>"- testCaseClose- , failedFormatter = pure ()- , footerFormatter = writeLine "</testsuites>"- }+-- | Output `hspec` results as a `JUnit` `XML` file.+junitFormat+ :: FilePath -- ^ File path for resulting xml file. E.G. `my-dir/output.xml`+ -> String -- ^ Name of the test suite+ -> FormatConfig+ -> IO Format+junitFormat file suiteName _config = pure $ \case+ Started -> pure ()+ GroupStarted _ -> pure ()+ GroupDone _ -> pure ()+ Progress _ _ -> pure ()+ ItemStarted _ -> pure ()+ ItemDone _ _ -> pure ()+ Done paths -> do+ time <- getCurrentTime -testCaseOpen :: ([String], String) -> FormatM ()-testCaseOpen (parents, name) = writeLine $ mconcat- [ "<testcase name="- , show . fixBrackets $ T.pack name- , " classname="- , show . fixBrackets . T.intercalate "/" $ map T.pack parents- , ">"- ]+ let (directory, _) = splitFileName file+ createDirectoryIfMissing True directory -testCaseClose :: FormatM ()-testCaseClose = writeLine "</testcase>"+ let groups = groupItems paths+ let+ output = Schema.Suites+ { suitesName = T.pack suiteName+ , suitesSuites = groups <&> \(group, items) -> do+ let+ suite xs = Schema.Suite+ { suiteName = group+ , suiteTimestamp = time+ , suiteCases = xs+ }+ suite $ uncurry (itemToTestCase group) <$> items+ }+ runConduitRes+ $ sourceList [output]+ .| renderJUnit+ .| renderBytes def+ .| sinkFile file -fixBrackets :: Text -> Text-fixBrackets =- T.replace "\"" """- . T.replace "<" "<"- . T.replace ">" ">"- . T.replace "&" "&"+groupItems :: [(Path, Item)] -> [(Text, [(Text, Item)])]+groupItems = Map.toList . Map.fromListWith (<>) . fmap group+ where+ group ((path, name), item) =+ (T.intercalate "/" $ T.pack <$> path, [(T.pack name, item)]) -fixReason :: String -> String-fixReason = T.unpack . fixBrackets . T.pack+itemToTestCase :: Text -> Text -> Item -> Schema.TestCase+itemToTestCase group name item = Schema.TestCase+ { testCaseClassName = group+ , testCaseName = name+ , testCaseDuration = unSeconds $ itemDuration item+ , testCaseResult = case itemResult item of+ Success -> Nothing+ Pending mLocation mMessage ->+ Just $ Schema.Skipped $ prefixLocation mLocation $ prefixInfo $ maybe+ ""+ T.pack+ mMessage+ Failure mLocation reason ->+ Just+ $ Schema.Failure "error"+ $ prefixLocation mLocation+ $ prefixInfo+ $ case reason of+ Error _ err -> T.pack $ show err+ NoReason -> "no reason"+ Reason err -> T.pack err+ ExpectedButGot preface expected actual ->+ prefixInfo+ $ T.unlines+ $ T.pack+ <$> fromMaybe "" preface+ : (foundLines "expected" expected+ <> foundLines " but got" actual+ )+ }+ where+ prefixLocation mLocation str = case mLocation of+ Nothing -> str+ Just Location {..} ->+ T.concat+ [ T.pack locationFile+ , ":"+ , T.pack $ show locationLine+ , ":"+ , T.pack $ show locationColumn+ , "\n"+ ]+ <> str+ prefixInfo str+ | T.null $ T.strip $ T.pack $ itemInfo item = str+ | otherwise = T.pack (itemInfo item) <> "\n\n" <> str -writeFound :: Show a => Text -> a -> FormatM ()-writeFound msg found = case lines' of- [] -> pure ()- first : rest -> do- writeLine . T.unpack $ msg <> ": " <> first- traverse_ (writeLine . T.unpack . (T.replicate 9 " " <>)) rest- where lines' = map fixBrackets . T.lines . T.pack $ show found+unSeconds :: Seconds -> Double+unSeconds (Seconds x) = x++foundLines :: Show a => Text -> a -> [String]+foundLines msg found = case lines' of+ [] -> []+ first : rest ->+ T.unpack (msg <> ": " <> first)+ : (T.unpack . (T.replicate 9 " " <>) <$> rest)+ where lines' = T.lines . T.pack $ show found
− library/Test/HSpec/JUnit/Parse.hs
@@ -1,60 +0,0 @@-module Test.HSpec.JUnit.Parse- ( parseJUnit- , denormalize- ) where--import Prelude--import Control.Monad.Catch (MonadThrow)-import Data.Conduit (ConduitT, awaitForever, yield)-import Data.XML.Types (Event)-import Test.HSpec.JUnit.Schema-import Text.XML.Stream.Parse- (choose, content, many, requireAttr, tag', tagNoAttr)--denormalize' :: Suite -> [Suite]-denormalize' (Suite name xs) = collapse $ concatMap suiteOrCase xs- where- suiteOrCase = \case- Right x -> [Suite name [Right x]]- Left (Suite name' ys) -> denormalize' $ Suite (name <> "/" <> name') ys--collapse :: [Suite] -> [Suite]-collapse [] = []-collapse (x : y : xs)- | suiteName x == suiteName y- = collapse $ Suite (suiteName x) (suiteCases x <> suiteCases y) : xs- | otherwise- = x : collapse (y : xs)-collapse xs@(_ : _) = xs---- | Denormalize nested <testsuite /> elements------ HSpec's formatter cannot correctly output JUnit, so we must denormalize--- nested <testsuite /> elements. Nested elements have their names collapsed--- into `hspec` style paths.----denormalize :: MonadThrow m => ConduitT Suites Suites m ()-denormalize = awaitForever $ \(Suites name children) ->- yield . Suites name $ concatMap denormalize' children--parseJUnit :: MonadThrow m => ConduitT Event Suites m ()-parseJUnit = maybe (pure ()) yield =<< parseSuite- where- parseSuite =- tag' "testsuites" (requireAttr "name") $ \name -> Suites name <$> many suite--suite :: MonadThrow m => ConduitT Event o m (Maybe Suite)-suite = tag' "testsuite" (requireAttr "name") $ \name ->- Suite name <$> many (choose [fmap Right <$> testCase, fmap Left <$> suite])--testCase :: MonadThrow m => ConduitT Event o m (Maybe TestCase)-testCase =- tag' "testcase" ((,) <$> requireAttr "name" <*> requireAttr "classname")- $ \(name, className) -> TestCase className name <$> result--result :: MonadThrow m => ConduitT Event o m (Maybe Result)-result = choose- [ tag' "failure" (requireAttr "type") $ \fType -> Failure fType <$> content- , tagNoAttr "skipped" $ Skipped <$> content- ]
library/Test/HSpec/JUnit/Render.hs view
@@ -5,60 +5,65 @@ import Prelude import Control.Monad.Catch (MonadThrow)-import Data.Conduit (ConduitT, awaitForever, yield, (.|))+import Data.Conduit (ConduitT, awaitForever, mergeSource, yield, (.|)) import qualified Data.Conduit.List as CL import Data.Foldable (traverse_) import Data.Text (Text, pack)+import Data.Time.Format.ISO8601 (iso8601Show) import Data.XML.Types (Event)-import Test.HSpec.JUnit.Schema (Result(..), TestCase(..), Suite(..), Suites(..))+import Test.HSpec.JUnit.Schema (Result(..), Suite(..), Suites(..), TestCase(..))+import Text.Printf import Text.XML.Stream.Render (attr, content, tag)-import Data.Hashable (hash) renderJUnit :: MonadThrow m => ConduitT Suites Event m ()-renderJUnit = awaitForever $ \(Suites name suites) ->- tag "testsuites" (attr "name" name) $ CL.sourceList suites .| suite+renderJUnit = awaitForever $ \Suites {..} ->+ tag "testsuites" (attr "name" suitesName)+ $ CL.sourceList suitesSuites+ .| mergeSource idStream+ .| suite+ where idStream = CL.iterate (+ 1) 0 -suite :: MonadThrow m => ConduitT Suite Event m ()-suite =- awaitForever- $ \(Suite name cases) -> tag "testsuite" (attributes name cases) $ do- tag "properties" mempty mempty- CL.sourceList cases .| do- awaitForever $ \case- Left x -> yield x .| suite- Right x -> yield x .| testCase+suite :: MonadThrow m => ConduitT (Int, Suite) Event m ()+suite = awaitForever $ \(i, theSuite@Suite {..}) ->+ tag "testsuite" (attributes i theSuite) $ do+ tag "properties" mempty mempty+ CL.sourceList suiteCases .| do+ awaitForever $ \x -> yield x .| testCase where -- TODO these need to be made real values- attributes name cases =- attr "name" name- <> attr "package" name- <> attr "id" (tshow $ hash name)- <> attr "time" "0"- <> attr "timestamp" "1979-01-01T01:01:01"+ attributes i Suite {..} =+ attr "name" suiteName+ <> attr "package" suiteName+ <> attr "id" (tshow i)+ <> attr "time" (roundToStr $ sumDurations suiteCases)+ <> attr "timestamp" (pack $ iso8601Show suiteTimestamp) <> attr "hostname" "localhost"- <> attr "tests" (tshow $ length cases)+ <> attr "tests" (tshow $ length suiteCases) <> attr "failures"- (tshow $ length- [ () | Right (TestCase _ _ (Just (Failure _ _))) <- cases ]+ (tshow+ $ length [ () | Just Failure{} <- testCaseResult <$> suiteCases ] ) <> attr "errors" "0" <> attr "skipped"- (tshow $ length- [ () | Right (TestCase _ _ (Just (Skipped _))) <- cases ]+ (tshow+ $ length [ () | Just Skipped{} <- testCaseResult <$> suiteCases ] ) tshow :: Show a => a -> Text tshow = pack . show testCase :: MonadThrow m => ConduitT TestCase Event m ()-testCase = awaitForever $ \(TestCase className name mResult) ->- tag "testcase" (attributes className name) $ traverse_ yield mResult .| result+testCase = awaitForever $ \(TestCase className name duration mResult) ->+ tag "testcase" (attributes className name duration)+ $ traverse_ yield mResult+ .| result where- -- TODO these need to be made real values- attributes className name =- attr "name" name <> attr "classname" className <> attr "time" "0"+ attributes className name duration =+ attr "name" name <> attr "classname" className <> attr+ "time"+ (roundToStr duration) result :: MonadThrow m => ConduitT Result Event m () result = awaitForever go@@ -66,3 +71,9 @@ go (Failure fType contents) = tag "failure" (attr "type" fType) $ content contents go (Skipped contents) = tag "skipped" mempty $ content contents++sumDurations :: [TestCase] -> Double+sumDurations cases = sum $ testCaseDuration <$> cases++roundToStr :: (PrintfArg a) => a -> Text+roundToStr = pack . printf "%0.9f"
library/Test/HSpec/JUnit/Schema.hs view
@@ -8,22 +8,28 @@ import Prelude import Data.Text (Text)+import Data.Time (UTCTime) -data Suites = Suites Text [Suite]- deriving (Show)+data Suites = Suites+ { suitesName :: Text+ , suitesSuites :: [Suite]+ }+ deriving stock Show data Suite = Suite { suiteName :: Text- , suiteCases :: [Either Suite TestCase]+ , suiteTimestamp :: UTCTime+ , suiteCases :: [TestCase] }- deriving (Show)+ deriving stock Show data TestCase = TestCase { testCaseClassName :: Text , testCaseName :: Text+ , testCaseDuration :: Double , testCaseResult :: Maybe Result }- deriving (Show)+ deriving stock Show data Result = Failure Text Text | Skipped Text- deriving (Show)+ deriving stock Show
+ tests/Main.hs view
@@ -0,0 +1,48 @@+module Main+ ( main+ )+where++import Prelude++import Control.Monad (void)+import Test.HSpec.JUnit (junitFormat)+import Test.Hspec+import Test.Hspec.Runner++main :: IO ()+main = do+ summary <- flip runSpec defaultConfig $ do+ describe "XML output" $ do+ it "matches golen file" $ do+ pendingWith+ "Need to normalize time and timestamp values to match golden"+ makeJunitResults++ golden <- readFile "tests/golden.xml"+ test <- readFile ".temp/test.xml"++ test `shouldBe` golden++ evaluateSummary summary++makeJunitResults :: IO ()+makeJunitResults = void $ flip runSpec config $ do+ describe "Some section" $ do+ it "has an expectation" $ do+ True `shouldBe` True+ it "has a failure" $ do+ True `shouldBe` False++ context "A grouped context" $ do+ it "happens in a group" $ do+ True `shouldBe` True+ it "also happens in a group" $ do+ True `shouldBe` True+ it "gets skipped" $ do+ pendingWith "some reason"++config :: Config+config = defaultConfig+ { configFormat = Just $ junitFormat ".temp/test.xml" "hspec-junit-format"+ }