hspec-junit-formatter 1.0.1.0 → 1.0.2.0
raw patch · 13 files changed
+508/−259 lines, 13 filesdep +markdown-unlitdep +temporary
Dependencies added: markdown-unlit, temporary
Files
- CHANGELOG.md +6/−1
- README.lhs +36/−0
- README.md +29/−3
- hspec-junit-formatter.cabal +36/−3
- library/Test/HSpec/JUnit.hs +15/−117
- library/Test/HSpec/JUnit/Render.hs +2/−75
- library/Test/HSpec/JUnit/Schema.hs +2/−28
- library/Test/Hspec/JUnit.hs +133/−0
- library/Test/Hspec/JUnit/Config.hs +70/−0
- library/Test/Hspec/JUnit/Render.hs +79/−0
- library/Test/Hspec/JUnit/Schema.hs +35/−0
- tests/ExampleSpec.hs +26/−0
- tests/Main.hs +39/−32
CHANGELOG.md view
@@ -1,6 +1,11 @@-## [_Unreleased_](https://github.com/freckle/hspec-junit-formatter/compare/v1.0.0.4...main)+## [_Unreleased_](https://github.com/freckle/hspec-junit-formatter/compare/v1.0.2.0...main) None++## [v1.0.2.0](https://github.com/freckle/hspec-junit-formatter/compare/v1.0.1.0...v1.0.2.0)++- Create `Test.Hspec` module-space and deprecate misspelled `Test.HSpec` modules+- Introduce `configWithJUnit` and `JUnitConfig` ## [v1.0.1.0](https://github.com/freckle/hspec-junit-formatter/compare/v1.0.0.4...v1.0.1.0)
+ README.lhs view
@@ -0,0 +1,36 @@+# hspec-junit-formatter++A `JUnit` XML runner/formatter for [`hspec`](http://hspec.github.io/).++<!--+```haskell+module Main (main) where+import Prelude+import Text.Markdown.Unlit ()+```+-->++## Usage++```haskell+import Test.Hspec+import Test.Hspec.Core.Runner (defaultConfig, hspecWith)+import Test.Hspec.JUnit++main :: IO ()+main = do+ let+ junitConfig = setJUnitConfigOutputDirectory "/tmp" $ defaultJUnitConfig "my-tests"+ hspecConfig = configWithJUnit junitConfig defaultConfig++ hspecWith hspecConfig spec++spec :: Spec+spec = describe "Addition" $ do+ it "adds" $ do+ 2 + 2 `shouldBe` (4 :: Int)+```++---++[LICENSE](./LICENSE)
README.md view
@@ -2,9 +2,35 @@ A `JUnit` XML runner/formatter for [`hspec`](http://hspec.github.io/). -```hs+<!--+```haskell+module Main (main) where+import Prelude+import Text.Markdown.Unlit ()+```+-->++## Usage++```haskell+import Test.Hspec+import Test.Hspec.Core.Runner (defaultConfig, hspecWith)+import Test.Hspec.JUnit+ main :: IO () main = do- config <- readConfig defaultConfig =<< getArgs- spec `runJUnitSpec` ("output-dir", "my-tests-title") $ config+ let+ junitConfig = setJUnitConfigOutputDirectory "/tmp" $ defaultJUnitConfig "my-tests"+ hspecConfig = configWithJUnit junitConfig defaultConfig++ hspecWith hspecConfig spec++spec :: Spec+spec = describe "Addition" $ do+ it "adds" $ do+ 2 + 2 `shouldBe` (4 :: Int) ```++---++[LICENSE](./LICENSE)
hspec-junit-formatter.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: hspec-junit-formatter-version: 1.0.1.0+version: 1.0.2.0 license: MIT license-file: LICENSE copyright: 2021 Renaissance Learning Inc@@ -25,8 +25,12 @@ library exposed-modules: Test.HSpec.JUnit+ Test.Hspec.JUnit+ Test.Hspec.JUnit.Config Test.HSpec.JUnit.Render+ Test.Hspec.JUnit.Render Test.HSpec.JUnit.Schema+ Test.Hspec.JUnit.Schema hs-source-dirs: library other-modules: Paths_hspec_junit_formatter@@ -53,11 +57,36 @@ xml-conduit >=1.9.1.1, xml-types >=0.3.8 +test-suite readme+ type: exitcode-stdio-1.0+ main-is: README.lhs+ 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: -pgmL markdown-unlit+ build-depends:+ base >=4.14.1.0 && <5,+ hspec >=2.8.1,+ hspec-core >=2.8.1,+ hspec-junit-formatter -any,+ markdown-unlit >=0.5.1+ test-suite spec type: exitcode-stdio-1.0 main-is: Main.hs hs-source-dirs: tests- other-modules: Paths_hspec_junit_formatter+ other-modules:+ ExampleSpec+ Paths_hspec_junit_formatter+ default-language: Haskell2010 default-extensions: BangPatterns DeriveAnyClass DeriveFoldable DeriveFunctor@@ -71,5 +100,9 @@ ghc-options: -threaded -rtsopts -O0 -with-rtsopts=-N build-depends: base >=4.14.1.0 && <5,+ containers >=0.6.2.1,+ filepath >=1.4.2.1, hspec >=2.8.1,- hspec-junit-formatter -any+ hspec-junit-formatter -any,+ temporary >=1.3,+ xml-conduit >=1.9.1.1
library/Test/HSpec/JUnit.hs view
@@ -1,4 +1,5 @@ module Test.HSpec.JUnit+ {-# DEPRECATED "Use Test.Hspec.JUnit instead" #-} ( junitFormat , runJUnitSpec , configWith@@ -6,23 +7,12 @@ import Prelude -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)-import qualified Data.Text as T-import Data.Time (getCurrentTime)-import System.Directory (createDirectoryIfMissing)-import System.FilePath (splitFileName)-import Test.HSpec.JUnit.Render (renderJUnit)-import qualified Test.HSpec.JUnit.Schema as Schema+import Data.Text (pack) import Test.Hspec.Core.Format import Test.Hspec.Core.Runner import Test.Hspec.Core.Spec (Spec)-import Text.XML.Stream.Render (def, renderBytes)+import Test.Hspec.JUnit hiding (junitFormat)+import qualified Test.Hspec.JUnit as JUnit runJUnitSpec :: Spec -> (FilePath, String) -> Config -> IO Summary runJUnitSpec spec (path, name) config =@@ -30,107 +20,15 @@ where filePath = path <> "/" <> name <> "/test_results.xml" configWith :: FilePath -> String -> Config -> Config-configWith filePath name config =- config { configFormat = Just $ junitFormat filePath name }---- | 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-- let (directory, _) = splitFileName file- createDirectoryIfMissing True directory-- 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--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)])--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--unSeconds :: Seconds -> Double-unSeconds (Seconds x) = x+configWith filePath =+ configWithJUnit+ . setJUnitConfigOutputFile filePath+ . defaultJUnitConfig+ . pack -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+junitFormat :: FilePath -> String -> FormatConfig -> IO Format+junitFormat filePath =+ JUnit.junitFormat+ . setJUnitConfigOutputFile filePath+ . defaultJUnitConfig+ . pack
library/Test/HSpec/JUnit/Render.hs view
@@ -1,79 +1,6 @@ module Test.HSpec.JUnit.Render+ {-# DEPRECATED "Use Test.Hspec.JUnit.Render instead" #-} ( renderJUnit ) where -import Prelude--import Control.Monad.Catch (MonadThrow)-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(..), Suite(..), Suites(..), TestCase(..))-import Text.Printf-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--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 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 suiteCases)- <> attr- "failures"- (tshow- $ length [ () | Just Failure{} <- testCaseResult <$> suiteCases ]- )- <> attr "errors" "0"- <> attr- "skipped"- (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 duration mResult) ->- tag "testcase" (attributes className name duration)- $ traverse_ yield mResult- .| result- where- attributes className name duration =- attr "name" name <> attr "classname" className <> attr- "time"- (roundToStr duration)--result :: MonadThrow m => ConduitT Result Event m ()-result = awaitForever go- where- 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"+import Test.Hspec.JUnit.Render
library/Test/HSpec/JUnit/Schema.hs view
@@ -1,35 +1,9 @@ module Test.HSpec.JUnit.Schema+ {-# DEPRECATED "Use Test.Hspec.JUnit.Schema instead" #-} ( Suites(..) , Suite(..) , TestCase(..) , Result(..) ) where -import Prelude--import Data.Text (Text)-import Data.Time (UTCTime)--data Suites = Suites- { suitesName :: Text- , suitesSuites :: [Suite]- }- deriving stock Show--data Suite = Suite- { suiteName :: Text- , suiteTimestamp :: UTCTime- , suiteCases :: [TestCase]- }- deriving stock Show--data TestCase = TestCase- { testCaseClassName :: Text- , testCaseName :: Text- , testCaseDuration :: Double- , testCaseResult :: Maybe Result- }- deriving stock Show--data Result = Failure Text Text | Skipped Text- deriving stock Show+import Test.Hspec.JUnit.Schema
+ library/Test/Hspec/JUnit.hs view
@@ -0,0 +1,133 @@+module Test.Hspec.JUnit+ ( configWithJUnit+ , junitFormat++ -- * Configuration+ , module Test.Hspec.JUnit.Config+ ) where++import Prelude++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.Core.Format+import Test.Hspec.Core.Runner+import Test.Hspec.JUnit.Config+import Test.Hspec.JUnit.Render (renderJUnit)+import qualified Test.Hspec.JUnit.Schema as Schema+import Text.XML.Stream.Render (def, renderBytes)++-- | Modify an Hspec 'Config' to use 'junitFormat'+configWithJUnit :: JUnitConfig -> Config -> Config+configWithJUnit junitConfig config =+ config { configFormat = Just $ junitFormat junitConfig }++-- | Hspec 'configFormat' that generates a JUnit report+junitFormat :: JUnitConfig -> FormatConfig -> IO Format+junitFormat 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 group) <$> items+ }++ runConduitRes+ $ sourceList [output]+ .| renderJUnit+ .| renderBytes def+ .| sinkFile file+ where+ file = getJUnitConfigOutputFile junitConfig+ suiteName = getJUnitConfigSuiteName 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 :: 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+ ""+ 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+ )+ }+ where+ prefixLocation mLocation str = case mLocation of+ Nothing -> str+ Just Location {..} ->+ mconcat+ [ pack 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++unSeconds :: Seconds -> Double+unSeconds (Seconds x) = x++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/Config.hs view
@@ -0,0 +1,70 @@+module Test.Hspec.JUnit.Config+ ( JUnitConfig++ -- * Construction+ , defaultJUnitConfig+ , setJUnitConfigOutputDirectory+ , setJUnitConfigOutputName+ , setJUnitConfigOutputFile++ -- * Use+ , getJUnitConfigOutputFile+ , getJUnitConfigSuiteName+ ) where++import Prelude++import Data.Maybe (fromMaybe)+import Data.Text (Text)+import System.FilePath ((</>))++data JUnitConfig = JUnitConfig+ { junitConfigOutputDirectory :: FilePath+ , junitConfigOutputName :: FilePath+ , junitConfigOutputFile :: Maybe FilePath+ , junitConfigSuiteName :: Text+ }++-- | 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+ }++-- | Set the directory within which to generate the report+--+-- Default is current working directory.+--+setJUnitConfigOutputDirectory :: FilePath -> JUnitConfig -> JUnitConfig+setJUnitConfigOutputDirectory x config =+ config { junitConfigOutputDirectory = x }++-- | Set the name for the generated report+--+-- Default is @junit.xml@.+--+setJUnitConfigOutputName :: FilePath -> JUnitConfig -> JUnitConfig+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 }++-- | Retrieve the full path to the generated report+getJUnitConfigOutputFile :: JUnitConfig -> FilePath+getJUnitConfigOutputFile JUnitConfig {..} = fromMaybe+ (junitConfigOutputDirectory </> junitConfigOutputName)+ junitConfigOutputFile++-- | Retrieve the suite name given on construction+getJUnitConfigSuiteName :: JUnitConfig -> Text+getJUnitConfigSuiteName = junitConfigSuiteName
+ library/Test/Hspec/JUnit/Render.hs view
@@ -0,0 +1,79 @@+module Test.Hspec.JUnit.Render+ ( renderJUnit+ ) where++import Prelude++import Control.Monad.Catch (MonadThrow)+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(..), Suite(..), Suites(..), TestCase(..))+import Text.Printf+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++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 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 suiteCases)+ <> attr+ "failures"+ (tshow+ $ length [ () | Just Failure{} <- testCaseResult <$> suiteCases ]+ )+ <> attr "errors" "0"+ <> attr+ "skipped"+ (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 duration mResult) ->+ tag "testcase" (attributes className name duration)+ $ traverse_ yield mResult+ .| result+ where+ attributes className name duration =+ attr "name" name <> attr "classname" className <> attr+ "time"+ (roundToStr duration)++result :: MonadThrow m => ConduitT Result Event m ()+result = awaitForever go+ where+ 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
@@ -0,0 +1,35 @@+module Test.Hspec.JUnit.Schema+ ( Suites(..)+ , Suite(..)+ , TestCase(..)+ , Result(..)+ ) where++import Prelude++import Data.Text (Text)+import Data.Time (UTCTime)++data Suites = Suites+ { suitesName :: Text+ , suitesSuites :: [Suite]+ }+ deriving stock Show++data Suite = Suite+ { suiteName :: Text+ , suiteTimestamp :: UTCTime+ , suiteCases :: [TestCase]+ }+ deriving stock Show++data TestCase = TestCase+ { testCaseClassName :: Text+ , testCaseName :: Text+ , testCaseDuration :: Double+ , testCaseResult :: Maybe Result+ }+ deriving stock Show++data Result = Failure Text Text | Skipped Text+ deriving stock Show
+ tests/ExampleSpec.hs view
@@ -0,0 +1,26 @@+-- | Example used by golden testing of XML reports+--+-- 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.+--+module ExampleSpec (spec) where++import Prelude++import Test.Hspec++spec :: Spec+spec = 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"
tests/Main.hs view
@@ -6,43 +6,50 @@ import Prelude import Control.Monad (void)-import Test.HSpec.JUnit (junitFormat)+import qualified Data.Map.Strict as Map+import qualified ExampleSpec+import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory) import Test.Hspec+import Test.Hspec.JUnit import Test.Hspec.Runner+import qualified Text.XML as XML 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+main = hspec $ do+ describe "XML output" $ do+ it "matches golden file" $ do+ withJUNitReport ExampleSpec.spec $ \doc -> do+ golden <- XML.readFile XML.def "tests/golden.xml"+ removeTimeAttributes doc `shouldBe` removeTimeAttributes golden -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+withJUNitReport :: Spec -> (XML.Document -> IO ()) -> IO ()+withJUNitReport spec f = withSystemTempDirectory "" $ \tmp -> do+ let+ path = tmp </> "test.xml"+ junitConfig =+ setJUnitConfigOutputDirectory tmp+ $ setJUnitConfigOutputName "test.xml"+ $ defaultJUnitConfig "hspec-junit-format"+ hspecConfig = configWithJUnit junitConfig defaultConfig+ void $ runSpec spec hspecConfig+ f =<< XML.readFile XML.def path - 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"+-- | Remove volatile attributes so they don't invalidate comparison+removeTimeAttributes :: XML.Document -> XML.Document+removeTimeAttributes =+ removeAttributesByName "time" . removeAttributesByName "timestamp" -config :: Config-config = defaultConfig- { configFormat = Just $ junitFormat ".temp/test.xml" "hspec-junit-format"+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+ }++ onNodeElement f = \case+ XML.NodeElement el -> XML.NodeElement $ f el+ n -> n