hspec-junit-formatter 1.1.0.2 → 1.1.1.0
raw patch · 21 files changed
+1099/−405 lines, 21 filesdep +arraydep +hspec-apidep +hspec-goldendep ~basedep ~conduitdep ~containersPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: array, hspec-api, hspec-golden, regex-base, regex-tdfa
Dependency ranges changed: base, conduit, containers, directory, exceptions, filepath, hspec, hspec-core, markdown-unlit, text, time, xml-conduit, xml-types
API changes (from Hackage documentation)
- Test.Hspec.Core.Runner.Ext: configAddAvailableFormatter :: String -> (FormatConfig -> IO Format) -> Config -> Config
+ Test.Hspec.JUnit.Config: getJUnitConfigDropConsoleFormatting :: JUnitConfig -> Bool
+ Test.Hspec.JUnit.Config: setJUnitConfigDropConsoleFormatting :: Bool -> JUnitConfig -> JUnitConfig
+ Test.Hspec.JUnit.Format: junit :: JUnitConfig -> FormatConfig -> IO Format
+ Test.Hspec.JUnit.Formatter: add :: JUnitConfig -> SpecWith a -> SpecWith a
+ Test.Hspec.JUnit.Formatter: formatter :: JUnitConfig -> (String, FormatConfig -> IO Format)
+ Test.Hspec.JUnit.Formatter: register :: JUnitConfig -> SpecWith a -> SpecWith a
+ Test.Hspec.JUnit.Formatter: use :: JUnitConfig -> SpecWith a -> SpecWith a
+ Test.Hspec.JUnit.Formatter.Env: add :: SpecWith a -> SpecWith a
+ Test.Hspec.JUnit.Formatter.Env: formatter :: IO (String, FormatConfig -> IO Format)
+ Test.Hspec.JUnit.Formatter.Env: register :: SpecWith a -> SpecWith a
+ Test.Hspec.JUnit.Formatter.Env: use :: SpecWith a -> SpecWith a
+ Test.Hspec.JUnit.Formatter.Env: whenEnabled :: (SpecWith a -> SpecWith a) -> SpecWith a -> SpecWith a
- Test.Hspec.JUnit.Render: renderJUnit :: MonadThrow m => ConduitT Suites Event m ()
+ Test.Hspec.JUnit.Render: renderJUnit :: MonadThrow m => Bool -> ConduitT Suites Event m ()
Files
- CHANGELOG.md +5/−2
- README.lhs +98/−10
- README.md +98/−10
- hspec-junit-formatter.cabal +88/−29
- library/Test/Hspec/Core/Runner/Ext.hs +0/−27
- library/Test/Hspec/JUnit.hs +102/−75
- library/Test/Hspec/JUnit/Config.hs +36/−23
- library/Test/Hspec/JUnit/Config/Env.hs +15/−12
- library/Test/Hspec/JUnit/Format.hs +152/−0
- library/Test/Hspec/JUnit/Formatter.hs +93/−0
- library/Test/Hspec/JUnit/Formatter/Env.hs +56/−0
- library/Test/Hspec/JUnit/Render.hs +58/−29
- library/Test/Hspec/JUnit/Schema.hs +10/−10
- tests/ExampleSpec.hs +10/−1
- tests/Main.hs +65/−55
- tests/golden-prefixed.xml +0/−61
- tests/golden.xml +0/−61
- tests/golden/default-ghc-8.xml +69/−0
- tests/golden/default-ghc-9.xml +6/−0
- tests/golden/prefixed-ghc-8.xml +69/−0
- tests/golden/prefixed-ghc-9.xml +69/−0
CHANGELOG.md view
@@ -1,6 +1,9 @@-## [_Unreleased_](https://github.com/freckle/hspec-junit-formatter/compare/v1.1.0.2...main)+## [_Unreleased_](https://github.com/freckle/hspec-junit-formatter/compare/v1.1.1.0...main) -None+## [v1.1.1.0](https://github.com/freckle/hspec-junit-formatter/compare/v1.1.0.2...v1.1.1.0)++- Add `Test.Hspec.JUnit.Formatter{,Env}`, for use as a [spec hook](https://hspec.github.io/hspec-discover.html#spec-hooks)+- Drop support for `hspec < 0.10` ## [v1.1.0.2](https://github.com/freckle/hspec-junit-formatter/compare/v1.1.0.1...v1.1.0.2)
README.lhs view
@@ -1,36 +1,124 @@ # hspec-junit-formatter +[](https://hackage.haskell.org/package/hspec-junit-formatter)+[](http://stackage.org/nightly/package/hspec-junit-formatter)+[](http://stackage.org/lts/package/hspec-junit-formatter)+[](https://github.com/freckle/hspec-junit-formatter/actions/workflows/ci.yml)+ A `JUnit` XML runner/formatter for [`hspec`](http://hspec.github.io/). <!-- ```haskell+{-# OPTIONS_GHC -Wno-unused-top-binds #-}+ module Main (main) where import Prelude import Text.Markdown.Unlit ()++-- Used in a later example+import qualified Test.Hspec.JUnit.Formatter.Env as FormatterEnv ``` --> -## Usage+## Usage (with `hspec-discover`) +Place the following in `test/SpecHook.hs`:+ ```haskell import Test.Hspec-import Test.Hspec.JUnit-import System.Environment (setEnv)+import Test.Hspec.JUnit.Config+import qualified Test.Hspec.JUnit.Formatter as Formatter -main :: IO ()-main = do- -- Most likely done in your CI setup- setEnv "JUNIT_ENABLED" "1"- setEnv "JUNIT_OUTPUT_DIRECTORY" "/tmp"- setEnv "JUNIT_SUITE_NAME" "my-tests"+hook :: Spec -> Spec+hook = Formatter.use $ defaultJUnitConfig "test-suite"+``` - hspecJUnit spec+This _replaces_ the usual formatter, so only a JUnit report is generated and no+other output is visible. +### Registering instead of using++To make the JUnit formatter available for use with `--format`, but not used by+default, use `register`:++```haskell+hook2 :: Spec -> Spec+hook2 = Formatter.register $ defaultJUnitConfig "test-suite"+```+++### Adding a JUnit report++To produce a JUnit report _in addition to normal output_, use `add`:++```haskell+hook3 :: Spec -> Spec+hook3 = Formatter.add $ defaultJUnitConfig "test-suite"+```++### Environment Configuration++To configure things via @JUNIT_@-prefixed environment variables, import+`Formatter.Env` instead. It exports all the same functions:++```hs+import qualified Test.Hspec.JUnit.Formatter.Env as FormatterEnv+```++And set the necessary variables,++```+JUNIT_OUTPUT_DIRECTORY=/tmp+JUNIT_SUITE_NAME=my-tests+```++```haskell+hook4 :: Spec -> Spec+hook4 = FormatterEnv.add+```++### Environment Enabling++To only apply a hook if `JUNIT_ENABLED=1`, wrap it in `whenEnabled`:++```+JUNIT_ENABLED=1+```++```haskell+hook5 :: Spec -> Spec+hook5 = FormatterEnv.whenEnabled FormatterEnv.add+```++### Without `hspec-discover`++Hooks are just functions of type `Spec -> Spec`, so you can apply them right+before calling `hspec` in `main`:++```haskell+main :: IO ()+main = hspec $ FormatterEnv.whenEnabled FormatterEnv.add spec+ spec :: Spec spec = describe "Addition" $ do it "adds" $ do 2 + 2 `shouldBe` (4 :: Int) ```++## Golden Testing++This project's test suite uses [hspec-golden][] to generate an XML report for+[`ExampleSpec.hs`](./tests/ExampleSpec.hs) and then compare that with golden XML+files checked into the repository. If your work changes things in a+functionally-correct way, but that diverges from the golden XML files, you need+to regenerate them.++1. Run `rm tests/golden*.xml`+2. Run the specs again++We maintain specific golden XML files for GHC 8.x vs 9.x, so you will need to+re-run the test suite with at least one of each series to regenerate all the+necessary files. ---
README.md view
@@ -1,36 +1,124 @@ # hspec-junit-formatter +[](https://hackage.haskell.org/package/hspec-junit-formatter)+[](http://stackage.org/nightly/package/hspec-junit-formatter)+[](http://stackage.org/lts/package/hspec-junit-formatter)+[](https://github.com/freckle/hspec-junit-formatter/actions/workflows/ci.yml)+ A `JUnit` XML runner/formatter for [`hspec`](http://hspec.github.io/). <!-- ```haskell+{-# OPTIONS_GHC -Wno-unused-top-binds #-}+ module Main (main) where import Prelude import Text.Markdown.Unlit ()++-- Used in a later example+import qualified Test.Hspec.JUnit.Formatter.Env as FormatterEnv ``` --> -## Usage+## Usage (with `hspec-discover`) +Place the following in `test/SpecHook.hs`:+ ```haskell import Test.Hspec-import Test.Hspec.JUnit-import System.Environment (setEnv)+import Test.Hspec.JUnit.Config+import qualified Test.Hspec.JUnit.Formatter as Formatter -main :: IO ()-main = do- -- Most likely done in your CI setup- setEnv "JUNIT_ENABLED" "1"- setEnv "JUNIT_OUTPUT_DIRECTORY" "/tmp"- setEnv "JUNIT_SUITE_NAME" "my-tests"+hook :: Spec -> Spec+hook = Formatter.use $ defaultJUnitConfig "test-suite"+``` - hspecJUnit spec+This _replaces_ the usual formatter, so only a JUnit report is generated and no+other output is visible. +### Registering instead of using++To make the JUnit formatter available for use with `--format`, but not used by+default, use `register`:++```haskell+hook2 :: Spec -> Spec+hook2 = Formatter.register $ defaultJUnitConfig "test-suite"+```+++### Adding a JUnit report++To produce a JUnit report _in addition to normal output_, use `add`:++```haskell+hook3 :: Spec -> Spec+hook3 = Formatter.add $ defaultJUnitConfig "test-suite"+```++### Environment Configuration++To configure things via @JUNIT_@-prefixed environment variables, import+`Formatter.Env` instead. It exports all the same functions:++```hs+import qualified Test.Hspec.JUnit.Formatter.Env as FormatterEnv+```++And set the necessary variables,++```+JUNIT_OUTPUT_DIRECTORY=/tmp+JUNIT_SUITE_NAME=my-tests+```++```haskell+hook4 :: Spec -> Spec+hook4 = FormatterEnv.add+```++### Environment Enabling++To only apply a hook if `JUNIT_ENABLED=1`, wrap it in `whenEnabled`:++```+JUNIT_ENABLED=1+```++```haskell+hook5 :: Spec -> Spec+hook5 = FormatterEnv.whenEnabled FormatterEnv.add+```++### Without `hspec-discover`++Hooks are just functions of type `Spec -> Spec`, so you can apply them right+before calling `hspec` in `main`:++```haskell+main :: IO ()+main = hspec $ FormatterEnv.whenEnabled FormatterEnv.add spec+ spec :: Spec spec = describe "Addition" $ do it "adds" $ do 2 + 2 `shouldBe` (4 :: Int) ```++## Golden Testing++This project's test suite uses [hspec-golden][] to generate an XML report for+[`ExampleSpec.hs`](./tests/ExampleSpec.hs) and then compare that with golden XML+files checked into the repository. If your work changes things in a+functionally-correct way, but that diverges from the golden XML files, you need+to regenerate them.++1. Run `rm tests/golden*.xml`+2. Run the specs again++We maintain specific golden XML files for GHC 8.x vs 9.x, so you will need to+re-run the test suite with at least one of each series to regenerate all the+necessary files. ---
hspec-junit-formatter.cabal view
@@ -1,6 +1,6 @@-cabal-version: 1.12+cabal-version: 1.18 name: hspec-junit-formatter-version: 1.1.0.2+version: 1.1.1.0 license: MIT license-file: LICENSE copyright: 2021 Renaissance Learning Inc@@ -15,10 +15,14 @@ category: Testing build-type: Simple extra-source-files:+ tests/golden/default-ghc-8.xml+ tests/golden/default-ghc-9.xml+ tests/golden/prefixed-ghc-8.xml+ tests/golden/prefixed-ghc-9.xml++extra-doc-files: README.md CHANGELOG.md- tests/golden.xml- tests/golden-prefixed.xml source-repository head type: git@@ -26,10 +30,12 @@ library exposed-modules:- Test.Hspec.Core.Runner.Ext Test.Hspec.JUnit Test.Hspec.JUnit.Config Test.Hspec.JUnit.Config.Env+ Test.Hspec.JUnit.Format+ Test.Hspec.JUnit.Formatter+ Test.Hspec.JUnit.Formatter.Env Test.Hspec.JUnit.Render Test.Hspec.JUnit.Schema @@ -45,20 +51,40 @@ RecordWildCards ScopedTypeVariables StandaloneDeriving TypeApplications TypeFamilies + ghc-options:+ -fignore-optim-changes -Weverything -Wno-all-missed-specialisations+ -Wno-missed-specialisations -Wno-missing-exported-signatures+ -Wno-missing-import-lists -Wno-missing-local-signatures+ -Wno-monomorphism-restriction -Wno-safe -Wno-unsafe+ build-depends:- base >=4.11.1.0 && <5,- conduit >=1.3.1,- containers >=0.5.11.0,- directory >=1.3.1.5,- exceptions >=0.10.0,- filepath >=1.4.2,- hspec-core >=2.8.1,+ 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,- text >=1.2.3.1,- time >=1.8.0.2,- xml-conduit >=1.8.0.1,- xml-types >=0.3.6+ regex-base >=0.94.0.2,+ regex-tdfa >=1.3.2.1,+ text >=1.2.5.0,+ time >=1.11.1.1,+ xml-conduit >=1.9.1.2,+ xml-types >=0.3.8 + if impl(ghc >=9.2)+ ghc-options: -Wno-missing-kind-signatures++ if impl(ghc >=8.10)+ ghc-options:+ -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module++ if impl(ghc >=8.8)+ ghc-options: -fwrite-ide-info+ test-suite readme type: exitcode-stdio-1.0 main-is: README.lhs@@ -73,13 +99,29 @@ RecordWildCards ScopedTypeVariables StandaloneDeriving TypeApplications TypeFamilies - ghc-options: -pgmL markdown-unlit+ ghc-options:+ -fignore-optim-changes -Weverything -Wno-all-missed-specialisations+ -Wno-missed-specialisations -Wno-missing-exported-signatures+ -Wno-missing-import-lists -Wno-missing-local-signatures+ -Wno-monomorphism-restriction -Wno-safe -Wno-unsafe -pgmL+ markdown-unlit+ build-depends:- base >=4.11.1.0 && <5,- hspec >=2.8.1,- hspec-junit-formatter -any,- markdown-unlit >=0.5.0+ base >=4.16.4.0 && <5,+ hspec >=2.10.0,+ hspec-junit-formatter,+ markdown-unlit >=0.5.1 + if impl(ghc >=9.2)+ ghc-options: -Wno-missing-kind-signatures++ if impl(ghc >=8.10)+ ghc-options:+ -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module++ if impl(ghc >=8.8)+ ghc-options: -fwrite-ide-info+ test-suite spec type: exitcode-stdio-1.0 main-is: Main.hs@@ -98,13 +140,30 @@ RecordWildCards ScopedTypeVariables StandaloneDeriving TypeApplications TypeFamilies - ghc-options: -threaded -rtsopts -O0 -with-rtsopts=-N+ ghc-options:+ -fignore-optim-changes -Weverything -Wno-all-missed-specialisations+ -Wno-missed-specialisations -Wno-missing-exported-signatures+ -Wno-missing-import-lists -Wno-missing-local-signatures+ -Wno-monomorphism-restriction -Wno-safe -Wno-unsafe -threaded+ -rtsopts -O0 -with-rtsopts=-N+ build-depends:- base >=4.11.1.0 && <5,- containers >=0.5.11.0,- filepath >=1.4.2,- hspec >=2.8.1,- hspec-junit-formatter -any,+ 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, temporary >=1.3,- text >=1.2.3.1,- xml-conduit >=1.8.0.1+ text >=1.2.5.0,+ xml-conduit >=1.9.1.2++ if impl(ghc >=9.2)+ ghc-options: -Wno-missing-kind-signatures++ if impl(ghc >=8.10)+ ghc-options:+ -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module++ if impl(ghc >=8.8)+ ghc-options: -fwrite-ide-info
− library/Test/Hspec/Core/Runner/Ext.hs
@@ -1,27 +0,0 @@-{-# LANGUAGE CPP #-}---- | Compatibility module for 'configAvailableFormatters'------ This feature is only available in hspec >= 2.9. Note that this module doesn't--- do anything to backport the feature; it just supplies a function that will--- use it when possible and safely no-op when not.----module Test.Hspec.Core.Runner.Ext- ( configAddAvailableFormatter- ) where--import Prelude--import Test.Hspec.Core.Format (Format, FormatConfig)-import Test.Hspec.Core.Runner (Config(..))--configAddAvailableFormatter- :: String -> (FormatConfig -> IO Format) -> Config -> Config-#if MIN_VERSION_hspec_core(2,9,0)-configAddAvailableFormatter name format config = config- { configAvailableFormatters =- configAvailableFormatters config <> [(name, format)]- }-#else-configAddAvailableFormatter _ _ = id-#endif
library/Test/Hspec/JUnit.hs view
@@ -1,17 +1,19 @@+{-# LANGUAGE CPP #-}+ module Test.Hspec.JUnit- (- -- * Runners+ {-# DEPRECATED "Use Test.Hspec.JUnit.Formatter" #-}+ ( -- * Runners hspecJUnit , hspecJUnitWith - -- * Directly modifying 'Config'+ -- * Directly modifying 'Config' , configWithJUnit , configWithJUnitAvailable - -- * Actual format function+ -- * Actual format function , junitFormat - -- * Configuration+ -- * Configuration , module Test.Hspec.JUnit.Config ) where @@ -30,8 +32,17 @@ import System.Directory (createDirectoryIfMissing) import System.FilePath (splitFileName) import Test.Hspec.Core.Format-import Test.Hspec.Core.Runner-import Test.Hspec.Core.Runner.Ext+ ( Event (..)+ , FailureReason (..)+ , Format+ , FormatConfig+ , Item (..)+ , Location (..)+ , Path+ , Result (..)+ , Seconds (..)+ )+import Test.Hspec.Core.Runner (Config (..), defaultConfig, hspecWith) import Test.Hspec.Core.Spec (Spec) import Test.Hspec.JUnit.Config import Test.Hspec.JUnit.Config.Env@@ -44,13 +55,11 @@ -- To actually /use/ the JUnit format, you must set @JUNIT_ENABLED=1@ in the -- environment; by default, this function just behaves like 'hspec'. ----- (If using hspec >= 2.9, running tests with @--test-arguments="-f junit"@ also--- works.)+-- Running tests with @--test-arguments="-f junit"@ also works. -- -- All configuration of the JUnit report occurs through environment variables. -- -- See "Test.Hspec.JUnit.Config" and "Test.Hspec.JUnit.Config.Env".--- hspecJUnit :: Spec -> IO () hspecJUnit = hspecJUnitWith defaultConfig @@ -69,16 +78,17 @@ -- | Modify an Hspec 'Config' to use 'junitFormat' configWithJUnit :: JUnitConfig -> Config -> Config configWithJUnit junitConfig config =- config { configFormat = Just $ junitFormat junitConfig }+ config {configFormat = Just $ junitFormat junitConfig} -- | Modify an Hspec 'Config' to have the 'junitFormat' /available/ -- -- Adds @junit@ to the list of available options for @-f, --format@.------ __NOTE__: This only works with hspec >= 2.9, otherwise it is a no-op.--- configWithJUnitAvailable :: JUnitConfig -> Config -> Config-configWithJUnitAvailable = configAddAvailableFormatter "junit" . junitFormat+configWithJUnitAvailable junitConfig config =+ config+ { configAvailableFormatters =+ configAvailableFormatters config <> [("junit", junitFormat junitConfig)]+ } -- | Hspec 'configFormat' that generates a JUnit report junitFormat :: JUnitConfig -> FormatConfig -> IO Format@@ -97,27 +107,30 @@ let groups = groupItems paths- output = Schema.Suites- { suitesName = suiteName- , suitesSuites = groups <&> \(group, items) -> do- let- suite xs = Schema.Suite- { suiteName = group- , suiteTimestamp = time- , suiteCases = xs- }- suite $ uncurry (itemToTestCase applyPrefix group) <$> items- }+ output =+ Schema.Suites+ { suitesName = suiteName+ , suitesSuites =+ groups <&> \(group, items) -> do+ let suite xs =+ Schema.Suite+ { suiteName = group+ , suiteTimestamp = time+ , suiteCases = xs+ }+ suite $ uncurry (itemToTestCase applyPrefix group) <$> items+ } - runConduitRes- $ sourceList [output]- .| renderJUnit- .| renderBytes def- .| sinkFile file+ runConduitRes $+ sourceList [output]+ .| renderJUnit dropConsoleFormatting+ .| renderBytes def+ .| sinkFile file where file = getJUnitConfigOutputFile junitConfig suiteName = getJUnitConfigSuiteName junitConfig applyPrefix = getJUnitPrefixSourcePath junitConfig+ dropConsoleFormatting = getJUnitConfigDropConsoleFormatting junitConfig groupItems :: [(Path, Item)] -> [(Text, [(Text, Item)])] groupItems = Map.toList . Map.fromListWith (<>) . fmap group@@ -127,50 +140,44 @@ itemToTestCase :: (FilePath -> FilePath) -> Text -> Text -> Item -> Schema.TestCase-itemToTestCase applyPrefix group name item = Schema.TestCase- { testCaseLocation =- toSchemaLocation applyPrefix- <$> (itemResultLocation item <|> itemLocation item)- , 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- ""- pack- mMessage- Failure mLocation reason ->- Just- $ Schema.Failure "error"- $ prefixLocation mLocation- $ prefixInfo- $ case reason of- Error _ err -> pack $ show err- NoReason -> "no reason"- Reason err -> pack err- ExpectedButGot preface expected actual ->- prefixInfo- $ T.unlines- $ pack- <$> fromMaybe "" preface- : (foundLines "expected" expected- <> foundLines " but got" actual- )- }+itemToTestCase applyPrefix group name item =+ Schema.TestCase+ { testCaseLocation =+ toSchemaLocation applyPrefix+ <$> (itemResultLocation item <|> itemLocation item)+ , 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+ ""+ pack+ mMessage+ Failure mLocation reason ->+ Just $+ Schema.Failure "error" $+ prefixLocation mLocation $+ prefixInfo $+ reasonToText reason+ } where prefixLocation mLocation str = case mLocation of Nothing -> str Just Location {..} -> mconcat- [ pack $ applyPrefix locationFile- , ":"- , pack $ show locationLine- , ":"- , pack $ show locationColumn- , "\n"- ]+ [ pack $ applyPrefix locationFile+ , ":"+ , pack $ show locationLine+ , ":"+ , pack $ show locationColumn+ , "\n"+ ] <> str prefixInfo str | T.null $ T.strip $ pack $ itemInfo item = str@@ -183,10 +190,11 @@ Failure mLocation _ -> mLocation toSchemaLocation :: (FilePath -> FilePath) -> Location -> Schema.Location-toSchemaLocation applyPrefix Location {..} = Schema.Location- { Schema.locationFile = applyPrefix locationFile- , Schema.locationLine = fromIntegral $ max 0 locationLine- }+toSchemaLocation applyPrefix Location {..} =+ Schema.Location+ { Schema.locationFile = applyPrefix locationFile+ , Schema.locationLine = fromIntegral $ max 0 locationLine+ } unSeconds :: Seconds -> Double unSeconds (Seconds x) = x@@ -196,4 +204,23 @@ [] -> [] first : rest -> unpack (msg <> ": " <> first) : (unpack . (T.replicate 9 " " <>) <$> rest)- where lines' = T.lines . pack $ show found+ where+ lines' = T.lines . pack $ show found++{- FOURMOLU_DISABLE -}+reasonToText :: FailureReason -> Text+reasonToText = \case+ Error _ err -> pack $ show err+ NoReason -> "no reason"+ Reason err -> pack err+#if MIN_VERSION_hspec_core(2,11,0)+ ColorizedReason err -> pack err+#endif+ ExpectedButGot preface expected actual ->+ T.unlines+ $ pack+ <$> fromMaybe "" preface+ : (foundLines "expected" expected+ <> foundLines " but got" actual+ )+{- FOURMOLU_ENABLE -}
library/Test/Hspec/JUnit/Config.hs view
@@ -1,18 +1,20 @@ module Test.Hspec.JUnit.Config ( JUnitConfig - -- * Construction+ -- * Construction , defaultJUnitConfig , setJUnitConfigOutputDirectory , setJUnitConfigOutputName , setJUnitConfigOutputFile , setJUnitConfigSuiteName , setJUnitConfigSourcePathPrefix+ , setJUnitConfigDropConsoleFormatting - -- * Use+ -- * Use , getJUnitConfigOutputFile , getJUnitConfigSuiteName , getJUnitPrefixSourcePath+ , getJUnitConfigDropConsoleFormatting ) where import Prelude@@ -27,61 +29,68 @@ , junitConfigOutputFile :: Maybe FilePath , junitConfigSuiteName :: Text , junitConfigSourcePathPrefix :: Maybe FilePath+ , junitConfigDropConsoleFormatting :: Bool } -- | Construct a 'JUnitConfig' given a suite name -- -- See individual set functions for defaults.--- defaultJUnitConfig :: Text -> JUnitConfig-defaultJUnitConfig name = JUnitConfig- { junitConfigOutputDirectory = "."- , junitConfigOutputName = "junit.xml"- , junitConfigOutputFile = Nothing- , junitConfigSuiteName = name- , junitConfigSourcePathPrefix = Nothing- }+defaultJUnitConfig name =+ JUnitConfig+ { junitConfigOutputDirectory = "."+ , junitConfigOutputName = "junit.xml"+ , junitConfigOutputFile = Nothing+ , junitConfigSuiteName = name+ , junitConfigSourcePathPrefix = Nothing+ , junitConfigDropConsoleFormatting = False+ } -- | Set the directory within which to generate the report -- -- Default is current working directory.--- setJUnitConfigOutputDirectory :: FilePath -> JUnitConfig -> JUnitConfig setJUnitConfigOutputDirectory x config =- config { junitConfigOutputDirectory = x }+ config {junitConfigOutputDirectory = x} -- | Set the name for the generated report -- -- Default is @junit.xml@.--- setJUnitConfigOutputName :: FilePath -> JUnitConfig -> JUnitConfig-setJUnitConfigOutputName x config = config { junitConfigOutputName = x }+setJUnitConfigOutputName x config = config {junitConfigOutputName = x} -- | Set the full path to the generated report -- -- If given, the directory and name configurations are ignored.--- setJUnitConfigOutputFile :: FilePath -> JUnitConfig -> JUnitConfig-setJUnitConfigOutputFile x config = config { junitConfigOutputFile = Just x }+setJUnitConfigOutputFile x config = config {junitConfigOutputFile = Just x} setJUnitConfigSuiteName :: Text -> JUnitConfig -> JUnitConfig-setJUnitConfigSuiteName x config = config { junitConfigSuiteName = x }+setJUnitConfigSuiteName x config = config {junitConfigSuiteName = x} -- | Set a prefix to apply to source paths in the report -- -- Default is none. This can be required if you run specs from a sub-directory -- in a monorepository, and you need reported paths to be from the repository -- root.--- setJUnitConfigSourcePathPrefix :: FilePath -> JUnitConfig -> JUnitConfig setJUnitConfigSourcePathPrefix x config =- config { junitConfigSourcePathPrefix = Just x }+ config {junitConfigSourcePathPrefix = Just x} +-- | Set whether console formatting characters should be dropped from failure+-- reports.+--+-- Default is False. Most XML processors will fail to parse the XML if it+-- contains the ANSI control characters used by console formatting.+setJUnitConfigDropConsoleFormatting :: Bool -> JUnitConfig -> JUnitConfig+setJUnitConfigDropConsoleFormatting x config = config {junitConfigDropConsoleFormatting = x}+ -- | Retrieve the full path to the generated report getJUnitConfigOutputFile :: JUnitConfig -> FilePath-getJUnitConfigOutputFile JUnitConfig {..} = fromMaybe- (junitConfigOutputDirectory </> junitConfigOutputName)- junitConfigOutputFile+getJUnitConfigOutputFile JUnitConfig {..} =+ fromMaybe+ (junitConfigOutputDirectory </> junitConfigOutputName)+ junitConfigOutputFile -- | Retrieve the suite name given on construction getJUnitConfigSuiteName :: JUnitConfig -> Text@@ -90,7 +99,11 @@ -- | Retrieve the function to apply to reported source paths -- -- Will be 'id' if no prefix configured.--- getJUnitPrefixSourcePath :: JUnitConfig -> FilePath -> FilePath getJUnitPrefixSourcePath JUnitConfig {..} = maybe id (</>) junitConfigSourcePathPrefix++-- | Retrieve whether console formatting characters should be dropped from+-- failure reports.+getJUnitConfigDropConsoleFormatting :: JUnitConfig -> Bool+getJUnitConfigDropConsoleFormatting JUnitConfig {..} = junitConfigDropConsoleFormatting
library/Test/Hspec/JUnit/Config/Env.hs view
@@ -1,12 +1,12 @@ -- | Load a 'JUnitConfig' using environment variables module Test.Hspec.JUnit.Config.Env- ( envJUnitEnabled- , envJUnitConfig- ) where+ ( envJUnitEnabled+ , envJUnitConfig+ ) where import Prelude -import Data.Semigroup (Endo(..))+import Data.Semigroup (Endo (..)) import Data.Text (pack) import System.Directory (getCurrentDirectory) import System.Environment (lookupEnv)@@ -24,16 +24,19 @@ -- * @JUNIT_OUTPUT_DIRECTORY@ 'setJUnitConfigOutputDirectory' -- * @JUNIT_OUTPUT_NAME@ 'setJUnitConfigOutputName -- * and so on--- envJUnitConfig :: IO JUnitConfig envJUnitConfig = do- modify <- appEndo . foldMap Endo <$> sequence- [ lookupEnvOverride "OUTPUT_DIRECTORY" setJUnitConfigOutputDirectory- , lookupEnvOverride "OUTPUT_NAME" setJUnitConfigOutputName- , lookupEnvOverride "OUTPUT_FILE" setJUnitConfigOutputFile- , lookupEnvOverride "SUITE_NAME" $ setJUnitConfigSuiteName . pack- , lookupEnvOverride "SOURCE_PATH_PREFIX" setJUnitConfigSourcePathPrefix- ]+ modify <-+ appEndo . foldMap Endo+ <$> sequence+ [ lookupEnvOverride "OUTPUT_DIRECTORY" setJUnitConfigOutputDirectory+ , lookupEnvOverride "OUTPUT_NAME" setJUnitConfigOutputName+ , lookupEnvOverride "OUTPUT_FILE" setJUnitConfigOutputFile+ , lookupEnvOverride "SUITE_NAME" $ setJUnitConfigSuiteName . pack+ , lookupEnvOverride "SOURCE_PATH_PREFIX" setJUnitConfigSourcePathPrefix+ , lookupEnvOverride "DROP_CONSOLE_FORMATTING" $+ setJUnitConfigDropConsoleFormatting . (== "1")+ ] modify . defaultJUnitConfig . pack . takeBaseName <$> getCurrentDirectory
+ library/Test/Hspec/JUnit/Format.hs view
@@ -0,0 +1,152 @@+module Test.Hspec.JUnit.Format+ ( junit+ ) where++import Prelude++import Control.Applicative ((<|>))+import Data.Conduit (runConduitRes, (.|))+import Data.Conduit.Combinators (sinkFile)+import Data.Conduit.List (sourceList)+import Data.Functor ((<&>))+import qualified Data.Map.Strict as Map+import Data.Maybe (fromMaybe)+import Data.Text (Text, pack, unpack)+import qualified Data.Text as T+import Data.Time (getCurrentTime)+import System.Directory (createDirectoryIfMissing)+import System.FilePath (splitFileName)+import Test.Hspec.Api.Format.V1+import Test.Hspec.JUnit.Config as Config+import Test.Hspec.JUnit.Render (renderJUnit)+import qualified Test.Hspec.JUnit.Schema as Schema+import Text.XML.Stream.Render (def, renderBytes)++junit :: JUnitConfig -> FormatConfig -> IO Format+junit junitConfig _config = pure $ \case+ Started -> pure ()+ GroupStarted _ -> pure ()+ GroupDone _ -> pure ()+ 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+ { suitesName = suiteName+ , suitesSuites =+ groups <&> \(group, items) -> do+ let suite xs =+ Schema.Suite+ { suiteName = group+ , suiteTimestamp = time+ , suiteCases = xs+ }+ suite $ uncurry (itemToTestCase applyPrefix group) <$> items+ }++ runConduitRes $+ sourceList [output]+ .| renderJUnit dropConsoleFormatting+ .| renderBytes def+ .| sinkFile file+ where+ file = getJUnitConfigOutputFile junitConfig+ suiteName = getJUnitConfigSuiteName junitConfig+ applyPrefix = getJUnitPrefixSourcePath junitConfig+ dropConsoleFormatting = getJUnitConfigDropConsoleFormatting junitConfig++groupItems :: [(Path, Item)] -> [(Text, [(Text, Item)])]+groupItems = Map.toList . Map.fromListWith (<>) . fmap group+ where+ group ((path, name), item) =+ (T.intercalate "/" $ pack <$> path, [(pack name, item)])++itemToTestCase+ :: (FilePath -> FilePath) -> Text -> Text -> Item -> Schema.TestCase+itemToTestCase applyPrefix group name item =+ Schema.TestCase+ { testCaseLocation =+ toSchemaLocation applyPrefix+ <$> (itemResultLocation item <|> itemLocation item)+ , 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+ ""+ pack+ mMessage+ Failure mLocation reason ->+ Just $+ Schema.Failure "error" $+ prefixLocation mLocation $+ prefixInfo $+ reasonToText reason+ }+ where+ prefixLocation mLocation str = case mLocation of+ Nothing -> str+ Just Location {..} ->+ mconcat+ [ pack $ applyPrefix locationFile+ , ":"+ , pack $ show locationLine+ , ":"+ , pack $ show locationColumn+ , "\n"+ ]+ <> str+ prefixInfo str+ | T.null $ T.strip $ pack $ itemInfo item = str+ | otherwise = pack (itemInfo item) <> "\n\n" <> str++itemResultLocation :: Item -> Maybe Location+itemResultLocation item = case itemResult item of+ Success -> Nothing+ Pending mLocation _ -> mLocation+ Failure mLocation _ -> mLocation++toSchemaLocation :: (FilePath -> FilePath) -> Location -> Schema.Location+toSchemaLocation applyPrefix Location {..} =+ Schema.Location+ { Schema.locationFile = applyPrefix locationFile+ , Schema.locationLine = fromIntegral $ max 0 locationLine+ }++unSeconds :: Seconds -> Double+unSeconds (Seconds x) = x++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+ )++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
+ library/Test/Hspec/JUnit/Formatter.hs view
@@ -0,0 +1,93 @@+-- | An Hspec formatter that produces a JUnit XML file of results+--+-- @+-- -- file test/SpecHook.hs+-- module SpecHook where+--+-- import Test.Hspec+-- import Test.Hspec.JUnit.Config+-- import Test.Hspec.JUnit.Formatter qualified as Formatter+--+-- -- | To only produce a JUnit file, silencing other output+-- hook :: Spec -> Spec+-- hook = Formatter.use defaultJUnitConfig+--+-- -- | To produce a JUnit file /in addition/ to the normal output+-- hook :: Spec -> Spec+-- hook = Formatter.add defaultJUnitConfig+--+-- -- | To only produce, but only when @--format=junit@ is used+-- hook :: Spec -> Spec+-- hook = Formatter.register defaultJUnitConfig+-- @+--+-- See also,+--+-- - https://hspec.github.io/hspec-discover.html#spec-hooks+-- - https://hspec.github.io/extending-hspec-formatter.html#packaging-a-formatter-for-distribution-and-reuse+--+-- For a version that reads configuration from @JUNIT_@ environment variables,+-- see "Test.Hspec.JUnit.Formatter.Env".+module Test.Hspec.JUnit.Formatter+ ( use+ , add+ , register+ , formatter+ , module Test.Hspec.JUnit.Config+ , module Api+ ) where++import Prelude++import Data.Maybe (fromMaybe)++import Test.Hspec.Api.Format.V1 as Api+import qualified Test.Hspec.Core.Format as Core+import qualified Test.Hspec.Core.Formatters.V2 as V2+import Test.Hspec.Core.Runner as Core (Config (..))+import Test.Hspec.JUnit.Config+import Test.Hspec.JUnit.Format++-- | Register 'junit' as an available formatter and use it by default+use :: JUnitConfig -> SpecWith a -> SpecWith a+use config = (modifyConfig (useFormatter $ formatter config) >>)++-- | Register 'junit', and use it /in addition/ to the default+add :: JUnitConfig -> SpecWith a -> SpecWith a+add config = (modifyConfig (addFormatter $ formatter config) >>)++-- | Register 'junit', but do not change the default+register :: JUnitConfig -> SpecWith a -> SpecWith a+register config = (modifyConfig (registerFormatter $ formatter config) >>)++formatter :: JUnitConfig -> (String, FormatConfig -> IO Format)+formatter config = ("junit", junit config)++addFormatter :: (String, FormatConfig -> IO Format) -> Config -> Config+addFormatter f = go . registerFormatter f+ where+ go config =+ config+ { configFormat =+ Just+ . (`addFormat` format)+ . fromMaybe defaultFormat+ $ configFormat config+ }++ format = snd $ liftFormatter f++defaultFormat :: Core.FormatConfig -> IO Core.Format+defaultFormat = V2.formatterToFormat V2.checks++addFormat+ :: (Core.FormatConfig -> IO Core.Format)+ -> (Core.FormatConfig -> IO Core.Format)+ -> Core.FormatConfig+ -> IO Core.Format+addFormat f1 f2 fc = do+ formatEvent1 <- f1 fc+ formatEvent2 <- f2 fc+ pure $ \event -> do+ formatEvent1 event+ formatEvent2 event
+ library/Test/Hspec/JUnit/Formatter/Env.hs view
@@ -0,0 +1,56 @@+-- | Version of "Test.Hspec.JUnit.Formatter" that reads config from ENV+--+-- @+-- -- file test/SpecHook.hs+-- module SpecHook where+--+-- import Test.Hspec+-- import Test.Hspec.JUnit.Formatter.Env qualified as Formatter+--+-- -- | To always produce a JUnit file, taking all config from the environment+-- hook :: Spec -> Spec+-- hook = Formatter.add+--+-- -- | Same, but only if @JUNIT_ENABLED=1@+-- hook :: Spec -> Spec+-- hook = Formatter.whenEnabled Formatter.add+-- @+module Test.Hspec.JUnit.Formatter.Env+ ( whenEnabled+ , use+ , add+ , register+ , formatter+ , module Api+ ) where++import Prelude++import Test.Hspec.Api.Format.V1 as Api+import Test.Hspec.Core.Spec (runIO)+import Test.Hspec.JUnit.Config+import Test.Hspec.JUnit.Config.Env+import qualified Test.Hspec.JUnit.Formatter as JUnit++whenEnabled :: (SpecWith a -> SpecWith a) -> SpecWith a -> SpecWith a+whenEnabled hook spec = do+ enabled <- runIO envJUnitEnabled+ if enabled then hook spec else spec++withConfig+ :: (JUnitConfig -> SpecWith a -> SpecWith a) -> SpecWith a -> SpecWith a+withConfig toHook spec = do+ config <- runIO envJUnitConfig+ toHook config spec++use :: SpecWith a -> SpecWith a+use = withConfig JUnit.use++add :: SpecWith a -> SpecWith a+add = withConfig JUnit.add++register :: SpecWith a -> SpecWith a+register = withConfig JUnit.register++formatter :: IO (String, FormatConfig -> IO Format)+formatter = JUnit.formatter <$> envJUnitConfig
library/Test/Hspec/JUnit/Render.hs view
@@ -5,31 +5,41 @@ import Prelude import Control.Monad.Catch (MonadThrow)+import qualified Data.Array as Array import Data.Conduit (ConduitT, awaitForever, mergeSource, yield, (.|)) import qualified Data.Conduit.List as CL import Data.Foldable (traverse_) import Data.Text (Text, pack)+import qualified Data.Text as Text import Data.Time.ISO8601 (formatISO8601) import Data.XML.Types (Event) import Test.Hspec.JUnit.Schema- (Location(..), Result(..), Suite(..), Suites(..), TestCase(..))+ ( Location (..)+ , Result (..)+ , Suite (..)+ , Suites (..)+ , TestCase (..)+ ) import Text.Printf+import qualified Text.Regex.Base as Regex+import qualified Text.Regex.TDFA.Text as Regex import Text.XML.Stream.Render (attr, content, tag) -renderJUnit :: MonadThrow m => ConduitT Suites Event m ()-renderJUnit = awaitForever $ \Suites {..} ->- tag "testsuites" (attr "name" suitesName)- $ CL.sourceList suitesSuites- .| mergeSource idStream- .| suite- where idStream = CL.iterate (+ 1) 0+renderJUnit :: MonadThrow m => Bool -> ConduitT Suites Event m ()+renderJUnit shouldDropConsoleFormatting = awaitForever $ \Suites {..} ->+ tag "testsuites" (attr "name" suitesName) $+ CL.sourceList suitesSuites+ .| mergeSource idStream+ .| suite shouldDropConsoleFormatting+ where+ idStream = CL.iterate (+ 1) 0 -suite :: MonadThrow m => ConduitT (Int, Suite) Event m ()-suite = awaitForever $ \(i, theSuite@Suite {..}) ->+suite :: MonadThrow m => Bool -> ConduitT (Int, Suite) Event m ()+suite shouldDropConsoleFormatting = awaitForever $ \(i, theSuite@Suite {..}) -> tag "testsuite" (attributes i theSuite) $ do tag "properties" mempty mempty CL.sourceList suiteCases .| do- awaitForever $ \x -> yield x .| testCase+ awaitForever $ \x -> yield x .| testCase shouldDropConsoleFormatting where -- TODO these need to be made real values attributes i Suite {..} =@@ -41,26 +51,26 @@ <> attr "hostname" "localhost" <> attr "tests" (tshow $ length suiteCases) <> attr- "failures"- (tshow- $ length [ () | Just Failure{} <- testCaseResult <$> suiteCases ]- )+ "failures"+ ( tshow $+ length [() | Just Failure {} <- testCaseResult <$> suiteCases]+ ) <> attr "errors" "0" <> attr- "skipped"- (tshow- $ length [ () | Just Skipped{} <- testCaseResult <$> suiteCases ]- )+ "skipped"+ ( tshow $+ length [() | Just Skipped {} <- testCaseResult <$> suiteCases]+ ) tshow :: Show a => a -> Text tshow = pack . show -testCase :: MonadThrow m => ConduitT TestCase Event m ()-testCase =+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+ tag "testcase" (attributes mLocation className name duration) $+ traverse_ yield mResult+ .| result shouldDropConsoleFormatting where attributes mLocation className name duration = maybe mempty (attr "file" . pack . locationFile) mLocation@@ -69,15 +79,34 @@ <> attr "classname" className <> attr "time" (roundToStr duration) -result :: MonadThrow m => ConduitT Result Event m ()-result = awaitForever go+result :: MonadThrow m => Bool -> ConduitT Result Event m ()+result shouldDropConsoleFormatting = awaitForever go where go (Failure fType contents) =- tag "failure" (attr "type" fType) $ content contents- go (Skipped contents) = tag "skipped" mempty $ content contents+ tag "failure" (attr "type" fType) $ content $ dropConsoleFormatting contents+ go (Skipped contents) = tag "skipped" mempty $ content $ dropConsoleFormatting contents + -- 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+ sumDurations :: [TestCase] -> Double sumDurations cases = sum $ testCaseDuration <$> cases -roundToStr :: (PrintfArg a) => a -> Text+roundToStr :: PrintfArg a => a -> Text roundToStr = pack . printf "%0.9f"
library/Test/Hspec/JUnit/Schema.hs view
@@ -1,9 +1,9 @@ module Test.Hspec.JUnit.Schema- ( Suites(..)- , Suite(..)- , TestCase(..)- , Location(..)- , Result(..)+ ( Suites (..)+ , Suite (..)+ , TestCase (..)+ , Location (..)+ , Result (..) ) where import Prelude@@ -16,14 +16,14 @@ { suitesName :: Text , suitesSuites :: [Suite] }- deriving stock Show+ deriving stock (Show) data Suite = Suite { suiteName :: Text , suiteTimestamp :: UTCTime , suiteCases :: [TestCase] }- deriving stock Show+ deriving stock (Show) data TestCase = TestCase { testCaseLocation :: Maybe Location@@ -32,13 +32,13 @@ , testCaseDuration :: Double , testCaseResult :: Maybe Result }- deriving stock Show+ deriving stock (Show) data Location = Location { locationFile :: FilePath , locationLine :: Natural }- deriving stock Show+ deriving stock (Show) data Result = Failure Text Text | Skipped Text- deriving stock Show+ deriving stock (Show)
tests/ExampleSpec.hs view
@@ -2,9 +2,10 @@ -- -- The path name and line numbers of this file are part of the golden report -- being tested with. So if this file changes, they will need to be regenerated.---+-- In fact, this sentence was added to retain them across a formatting change. module ExampleSpec (spec) where +import Control.Exception import Prelude import Test.Hspec@@ -24,3 +25,11 @@ True `shouldBe` True it "gets skipped" $ do pendingWith "some reason"+ it "throws a colourful exception" $ do+ throwIO ColourfulException :: IO ()++data ColourfulException = ColourfulException+ deriving stock (Show)++instance Exception ColourfulException where+ displayException _ = "\x1b[32mColour\x1b[31mful\x1b[0mException"
tests/Main.hs view
@@ -12,56 +12,74 @@ import qualified Data.Map.Strict as Map import qualified Data.Text as T import qualified ExampleSpec-import System.FilePath ((</>))+import System.FilePath ((<.>), (</>)) import System.IO.Temp (withSystemTempDirectory) import Test.Hspec-import Test.Hspec.JUnit+import Test.Hspec.Golden+import Test.Hspec.JUnit.Config+import qualified Test.Hspec.JUnit.Formatter as Formatter import Test.Hspec.Runner import qualified Text.XML as XML main :: IO () main = hspec $ do describe "XML output" $ do- it "matches golden file" $ do- withJUnitReport ExampleSpec.spec $ \doc -> do- golden <- XML.readFile XML.def goldenPath- normalizeDoc doc `shouldBe` normalizeDoc golden+ it "matches golden file" $+ junitGolden "default" id - it "matches golden file with prefixing" $ do- let modify = setJUnitConfigSourcePathPrefix "lol/monorepo"+ it "matches golden file with prefixing" $+ junitGolden "prefixed" $+ setJUnitConfigSourcePathPrefix "lol/monorepo" - withJUnitReportConfig modify ExampleSpec.spec $ \doc -> do- golden <- XML.readFile XML.def goldenPrefixedPath- normalizeDoc doc `shouldBe` normalizeDoc golden+-- | Run @ExampleSpec.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 $+ setJUnitConfigOutputDirectory tmp $+ setJUnitConfigOutputName "test.xml" $+ defaultJUnitConfig "hspec-junit-format" -withJUnitReport :: Spec -> (XML.Document -> IO ()) -> IO ()-withJUnitReport = withJUnitReportConfig id+ void $ runSpec' $ Formatter.use junitConfig ExampleSpec.spec+ readNormalizedXML $ tmp </> "test.xml" -withJUnitReportConfig- :: (JUnitConfig -> JUnitConfig) -> Spec -> (XML.Document -> IO ()) -> IO ()-withJUnitReportConfig modifyConfig spec f =- withSystemTempDirectory "" $ \tmp -> do- let- path = tmp </> "test.xml"- junitConfig =- modifyConfig- $ setJUnitConfigOutputDirectory tmp- $ setJUnitConfigOutputName "test.xml"- $ defaultJUnitConfig "hspec-junit-format"- hspecConfig = configWithJUnit junitConfig defaultConfig- void $ runSpec spec hspecConfig- f =<< XML.readFile XML.def path+ pure+ Golden+ { output = actual+ , encodePretty = show+ , writeToFile = XML.writeFile XML.def+ , readFromFile = readNormalizedXML+ , goldenFile =+ "tests" </> "golden" </> name <> "-" <> ghcSuffix <.> "xml"+ , actualFile = Nothing+ , failFirstTime = False+ } +runSpec' :: Spec -> IO ()+runSpec' spec = do+ (config, forest) <- evalSpec defaultConfig spec+ void $ runSpecForest forest config++readNormalizedXML :: FilePath -> IO XML.Document+readNormalizedXML = fmap normalizeDoc . XML.readFile XML.def+ normalizeDoc :: XML.Document -> XML.Document normalizeDoc = removeWhitespaceNodes . removeTimeAttributes removeWhitespaceNodes :: XML.Document -> XML.Document-removeWhitespaceNodes doc = doc- { XML.documentRoot = go $ XML.documentRoot doc- }+removeWhitespaceNodes doc =+ doc+ { XML.documentRoot = go $ XML.documentRoot doc+ } where go el =- el { XML.elementNodes = concatMap filterWhitespace $ XML.elementNodes el }+ el {XML.elementNodes = concatMap filterWhitespace $ XML.elementNodes el} filterWhitespace :: XML.Node -> [XML.Node] filterWhitespace = \case@@ -75,36 +93,28 @@ removeAttributesByName "time" . removeAttributesByName "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+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+ } onNodeElement f = \case XML.NodeElement el -> XML.NodeElement $ f el n -> n --- GHC 9 changes the bounds of the SrcLoc from HasCallStack, which changes the--- line numbers reported by Hspec. Fun.------ True `shouldBe` False--- ^ -- Before GHC 9 reports from here (18:7 in golden.xml)------ True `shouldBe` False--- ^-- GHC 9 reports from here (18:12 in golden-ghc-9.xml)------ We should really re-consider the golden testing approach. If we were instead--- asserting on parsed XML, we'd have a lot more options here.----goldenPath, goldenPrefixedPath :: FilePath+-- GHC can change certain aspects, mainly about source-location, so we can+-- incorpate that by tracking separate Golden files as necessary+ghcSuffix :: String #if __GLASGOW_HASKELL__ >= 900-goldenPath = "tests/golden-ghc-9.xml"-goldenPrefixedPath = "tests/golden-prefixed-ghc-9.xml"+ghcSuffix = "ghc-9"+#elif __GLASGOW_HASKELL__ >= 800+ghcSuffix = "ghc-8" #else-goldenPath = "tests/golden.xml"-goldenPrefixedPath = "tests/golden-prefixed.xml"+-- Fail to compile on other GHCs #endif
− tests/golden-prefixed.xml
@@ -1,61 +0,0 @@-<testsuites name="hspec-junit-format">- <testsuite- name="Some section"- package="Some section"- id="0"- hostname="localhost"- time="0.000032355"- timestamp="2021-05-17T15:36:10.205608409Z"- tests="2" failures="1" errors="0" skipped="0">- <properties/>- <testcase- file="lol/monorepo/tests/ExampleSpec.hs"- line="18"- name="has a failure"- classname="Some section"- time="0.000015537">- <failure type="error">lol/monorepo/tests/ExampleSpec.hs:18:7--expected: "False"- but got: "True"-</failure>- </testcase>- <testcase- file="lol/monorepo/tests/ExampleSpec.hs"- line="15"- name="has an expectation"- classname="Some section"- time="0.000016818"/>- </testsuite>- <testsuite- name="Some section/A grouped context"- package="Some section/A grouped context"- id="1"- time="0.000021009"- timestamp="2021-05-17T15:36:10.205608409Z"- hostname="localhost"- tests="3" failures="0" errors="0" skipped="1">- <properties/>- <testcase- file="lol/monorepo/tests/ExampleSpec.hs"- line="26"- name="gets skipped"- classname="Some section/A grouped context"- time="0.000006765">- <skipped>lol/monorepo/tests/ExampleSpec.hs:26:9-some reason</skipped>- </testcase>- <testcase- file="lol/monorepo/tests/ExampleSpec.hs"- line="23"- name="also happens in a group"- classname="Some section/A grouped context"- time="0.000007421"/>- <testcase- file="lol/monorepo/tests/ExampleSpec.hs"- line="21"- name="happens in a group"- classname="Some section/A grouped context"- time="0.000006823"/>- </testsuite>-</testsuites>
− tests/golden.xml
@@ -1,61 +0,0 @@-<testsuites name="hspec-junit-format">- <testsuite- name="Some section"- package="Some section"- id="0"- hostname="localhost"- time="0.000032355"- timestamp="2021-05-17T15:36:10.205608409Z"- tests="2" failures="1" errors="0" skipped="0">- <properties/>- <testcase- file="tests/ExampleSpec.hs"- line="18"- name="has a failure"- classname="Some section"- time="0.000015537">- <failure type="error">tests/ExampleSpec.hs:18:7--expected: "False"- but got: "True"-</failure>- </testcase>- <testcase- file="tests/ExampleSpec.hs"- line="15"- name="has an expectation"- classname="Some section"- time="0.000016818"/>- </testsuite>- <testsuite- name="Some section/A grouped context"- package="Some section/A grouped context"- id="1"- time="0.000021009"- timestamp="2021-05-17T15:36:10.205608409Z"- hostname="localhost"- tests="3" failures="0" errors="0" skipped="1">- <properties/>- <testcase- file="tests/ExampleSpec.hs"- line="26"- name="gets skipped"- classname="Some section/A grouped context"- time="0.000006765">- <skipped>tests/ExampleSpec.hs:26:9-some reason</skipped>- </testcase>- <testcase- file="tests/ExampleSpec.hs"- line="23"- name="also happens in a group"- classname="Some section/A grouped context"- time="0.000007421"/>- <testcase- file="tests/ExampleSpec.hs"- line="21"- name="happens in a group"- classname="Some section/A grouped context"- time="0.000006823"/>- </testsuite>-</testsuites>
+ tests/golden/default-ghc-8.xml view
@@ -0,0 +1,69 @@+<testsuites name="hspec-junit-format">+ <testsuite+ name="Some section"+ package="Some section"+ id="0"+ hostname="localhost"+ time="0.000032355"+ timestamp="2021-05-17T15:36:10.205608409Z"+ tests="2" failures="1" errors="0" skipped="0">+ <properties/>+ <testcase+ file="tests/ExampleSpec.hs"+ line="19"+ name="has a failure"+ classname="Some section"+ time="0.000015537">+ <failure type="error">tests/ExampleSpec.hs:19:7++expected: "False"+ but got: "True"+</failure>+ </testcase>+ <testcase+ file="tests/ExampleSpec.hs"+ line="16"+ name="has an expectation"+ classname="Some section"+ time="0.000016818"/>+ </testsuite>+ <testsuite+ name="Some section/A grouped context"+ package="Some section/A grouped context"+ id="1"+ time="0.000021009"+ timestamp="2021-05-17T15:36:10.205608409Z"+ hostname="localhost"+ tests="4" failures="1" errors="0" skipped="1">+ <properties/>+ <testcase+ file="tests/ExampleSpec.hs"+ line="28"+ name="throws a colourful exception"+ classname="Some section/A grouped context"+ time="0.000012194">+ <failure type="error">ColourfulException</failure>+ </testcase>+ <testcase+ file="tests/ExampleSpec.hs"+ line="27"+ name="gets skipped"+ classname="Some section/A grouped context"+ time="0.000006765">+ <skipped>tests/ExampleSpec.hs:27:9+some reason</skipped>+ </testcase>+ <testcase+ file="tests/ExampleSpec.hs"+ line="24"+ name="also happens in a group"+ classname="Some section/A grouped context"+ time="0.000007421"/>+ <testcase+ file="tests/ExampleSpec.hs"+ line="22"+ name="happens in a group"+ classname="Some section/A grouped context"+ time="0.000006823"/>+ </testsuite>+</testsuites>
+ tests/golden/default-ghc-9.xml view
@@ -0,0 +1,6 @@+<?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/ExampleSpec.hs" line="19" name="has a failure"><failure type="error">tests/ExampleSpec.hs:19:12++expected: "False"+ but got: "True"+</failure></testcase><testcase classname="Some section" file="tests/ExampleSpec.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/ExampleSpec.hs" line="28" name="throws a colourful exception"><failure type="error">ColourfulException</failure></testcase><testcase classname="Some section/A grouped context" file="tests/ExampleSpec.hs" line="27" name="gets skipped"><skipped>tests/ExampleSpec.hs:27:9+some reason</skipped></testcase><testcase classname="Some section/A grouped context" file="tests/ExampleSpec.hs" line="24" name="also happens in a group"/><testcase classname="Some section/A grouped context" file="tests/ExampleSpec.hs" line="22" name="happens in a group"/></testsuite></testsuites>
+ tests/golden/prefixed-ghc-8.xml view
@@ -0,0 +1,69 @@+<testsuites name="hspec-junit-format">+ <testsuite+ name="Some section"+ package="Some section"+ id="0"+ hostname="localhost"+ time="0.000032355"+ timestamp="2021-05-17T15:36:10.205608409Z"+ tests="2" failures="1" errors="0" skipped="0">+ <properties/>+ <testcase+ file="lol/monorepo/tests/ExampleSpec.hs"+ line="19"+ name="has a failure"+ classname="Some section"+ time="0.000015537">+ <failure type="error">lol/monorepo/tests/ExampleSpec.hs:19:7++expected: "False"+ but got: "True"+</failure>+ </testcase>+ <testcase+ file="lol/monorepo/tests/ExampleSpec.hs"+ line="16"+ name="has an expectation"+ classname="Some section"+ time="0.000016818"/>+ </testsuite>+ <testsuite+ name="Some section/A grouped context"+ package="Some section/A grouped context"+ id="1"+ time="0.000021009"+ timestamp="2021-05-17T15:36:10.205608409Z"+ hostname="localhost"+ tests="4" failures="1" errors="0" skipped="1">+ <properties/>+ <testcase+ file="lol/monorepo/tests/ExampleSpec.hs"+ line="28"+ name="throws a colourful exception"+ classname="Some section/A grouped context"+ time="0.000012194">+ <failure type="error">ColourfulException</failure>+ </testcase>+ <testcase+ file="lol/monorepo/tests/ExampleSpec.hs"+ line="27"+ name="gets skipped"+ classname="Some section/A grouped context"+ time="0.000006765">+ <skipped>lol/monorepo/tests/ExampleSpec.hs:27:9+some reason</skipped>+ </testcase>+ <testcase+ file="lol/monorepo/tests/ExampleSpec.hs"+ line="24"+ name="also happens in a group"+ classname="Some section/A grouped context"+ time="0.000007421"/>+ <testcase+ file="lol/monorepo/tests/ExampleSpec.hs"+ line="22"+ name="happens in a group"+ classname="Some section/A grouped context"+ time="0.000006823"/>+ </testsuite>+</testsuites>
+ tests/golden/prefixed-ghc-9.xml view
@@ -0,0 +1,69 @@+<testsuites name="hspec-junit-format">+ <testsuite+ name="Some section"+ package="Some section"+ id="0"+ hostname="localhost"+ time="0.000032355"+ timestamp="2021-05-17T15:36:10.205608409Z"+ tests="2" failures="1" errors="0" skipped="0">+ <properties/>+ <testcase+ file="lol/monorepo/tests/ExampleSpec.hs"+ line="19"+ name="has a failure"+ classname="Some section"+ time="0.000015537">+ <failure type="error">lol/monorepo/tests/ExampleSpec.hs:19:12++expected: "False"+ but got: "True"+</failure>+ </testcase>+ <testcase+ file="lol/monorepo/tests/ExampleSpec.hs"+ line="16"+ name="has an expectation"+ classname="Some section"+ time="0.000016818"/>+ </testsuite>+ <testsuite+ name="Some section/A grouped context"+ package="Some section/A grouped context"+ id="1"+ time="0.000021009"+ timestamp="2021-05-17T15:36:10.205608409Z"+ hostname="localhost"+ tests="4" failures="1" errors="0" skipped="1">+ <properties/>+ <testcase+ file="lol/monorepo/tests/ExampleSpec.hs"+ line="28"+ name="throws a colourful exception"+ classname="Some section/A grouped context"+ time="0.000012194">+ <failure type="error">ColourfulException</failure>+ </testcase>+ <testcase+ file="lol/monorepo/tests/ExampleSpec.hs"+ line="27"+ name="gets skipped"+ classname="Some section/A grouped context"+ time="0.000006765">+ <skipped>lol/monorepo/tests/ExampleSpec.hs:27:9+some reason</skipped>+ </testcase>+ <testcase+ file="lol/monorepo/tests/ExampleSpec.hs"+ line="24"+ name="also happens in a group"+ classname="Some section/A grouped context"+ time="0.000007421"/>+ <testcase+ file="lol/monorepo/tests/ExampleSpec.hs"+ line="22"+ name="happens in a group"+ classname="Some section/A grouped context"+ time="0.000006823"/>+ </testsuite>+</testsuites>