packages feed

hspec-junit-formatter (empty) → 1.0.0.0

raw patch · 8 files changed

+366/−0 lines, 8 filesdep +basedep +conduitdep +directory

Dependencies added: base, conduit, directory, exceptions, hashable, hspec, hspec-core, resourcet, temporary, text, xml-conduit, xml-types

Files

+ CHANGELOG.md view
@@ -0,0 +1,7 @@+## [_Unreleased_](https://github.com/freckle/hspec-junit-formatter/compare/v1.0.0.0...main)++None++## [v1.0.0.0](https://github.com/freckle/hspec-junit-formatter/tree/v1.0.0.0)++Initial release.
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2020 Renaissance Learning Inc++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,10 @@+# hspec-junit-formatter++A `JUnit` XML runner/formatter for [`hspec`](http://hspec.github.io/).++```hs+main :: IO ()+main = do+  config <- readConfig defaultConfig =<< getArgs+  spec `runJUnitSpec` ("output-dir", "my-tests-title") $ config+```
+ hspec-junit-formatter.cabal view
@@ -0,0 +1,56 @@+cabal-version:      1.12+name:               hspec-junit-formatter+version:            1.0.0.0+license:            MIT+license-file:       LICENSE+copyright:          2021 Renaissance Learning Inc+maintainer:         engineering@freckle.com+author:             Freckle R&D+homepage:           https://github.com/freckle/hspec-junit-formatter#readme+bug-reports:        https://github.com/freckle/hspec-junit-formatter/issues+synopsis:           A JUnit XML runner/formatter for hspec+description:+    Allows hspec tests to write JUnit XML output for parsing in various tools.++category:           Testing+build-type:         Simple+extra-source-files:+    README.md+    CHANGELOG.md++source-repository head+    type:     git+    location: https://github.com/freckle/hspec-junit-formatter++library+    exposed-modules:+        Test.HSpec.JUnit+        Test.HSpec.JUnit.Parse+        Test.HSpec.JUnit.Render+        Test.HSpec.JUnit.Schema++    hs-source-dirs:     library+    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++    build-depends:+        base >=4.14.1.0 && <4.15,+        conduit >=1.3.4.1 && <1.4,+        directory >=1.3.6.0 && <1.4,+        exceptions >=0.10.4 && <0.11,+        hashable >=1.3.0.0 && <1.4,+        hspec >=2.7.8 && <2.8,+        hspec-core >=2.7.8 && <2.8,+        resourcet >=1.2.4.2 && <1.3,+        temporary ==1.3.*,+        text >=1.2.4.1 && <1.3,+        xml-conduit >=1.9.1.0 && <1.10,+        xml-types >=0.3.8 && <0.4
+ library/Test/HSpec/JUnit.hs view
@@ -0,0 +1,115 @@+module Test.HSpec.JUnit+  ( runJUnitSpec+  , configWith+  ) where++import Prelude++import Control.Monad.Trans.Resource (runResourceT)+import Data.Conduit (runConduit, (.|))+import Data.Conduit.Combinators (sinkFile)+import Data.Foldable (traverse_)+import Data.Text (Text)+import qualified Data.Text as T+import System.Directory (createDirectoryIfMissing)+import System.IO.Temp (emptySystemTempFile)+import Test.HSpec.JUnit.Parse (denormalize, parseJUnit)+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 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++configWith :: FilePath -> String -> Config -> Config+configWith filePath name config = config+  { configFormatter = Just $ junitFormatter name+  , configOutputFile = Right filePath+  }++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 ()+  , 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>"+  }++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+  , ">"+  ]++testCaseClose :: FormatM ()+testCaseClose = writeLine "</testcase>"++fixBrackets :: Text -> Text+fixBrackets =+  T.replace "\"" "&quot;"+    . T.replace "<" "&lt;"+    . T.replace ">" "&gt;"+    . T.replace "&" "&amp;"++fixReason :: String -> String+fixReason = T.unpack . fixBrackets . T.pack++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
+ library/Test/HSpec/JUnit/Parse.hs view
@@ -0,0 +1,60 @@+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
@@ -0,0 +1,68 @@+module Test.HSpec.JUnit.Render+  ( renderJUnit+  ) where++import Prelude++import Control.Monad.Catch (MonadThrow)+import Data.Conduit (ConduitT, awaitForever, yield, (.|))+import qualified Data.Conduit.List as CL+import Data.Foldable (traverse_)+import Data.Text (Text, pack)+import Data.XML.Types (Event)+import Test.HSpec.JUnit.Schema (Result(..), TestCase(..), Suite(..), Suites(..))+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++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+ 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"+      <> attr "hostname" "localhost"+      <> attr "tests" (tshow $ length cases)+      <> attr+           "failures"+           (tshow $ length+             [ () | Right (TestCase _ _ (Just (Failure _ _))) <- cases ]+           )+      <> attr "errors" "0"+      <> attr+           "skipped"+           (tshow $ length+             [ () | Right (TestCase _ _ (Just (Skipped _))) <- cases ]+           )++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+ where+  -- TODO these need to be made real values+  attributes className name =+    attr "name" name <> attr "classname" className <> attr "time" "0"++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
+ library/Test/HSpec/JUnit/Schema.hs view
@@ -0,0 +1,29 @@+module Test.HSpec.JUnit.Schema+  ( Suites(..)+  , Suite(..)+  , TestCase(..)+  , Result(..)+  ) where++import Prelude++import Data.Text (Text)++data Suites = Suites Text [Suite]+  deriving (Show)++data Suite = Suite+  { suiteName :: Text+  , suiteCases :: [Either Suite TestCase]+  }+  deriving (Show)++data TestCase = TestCase+  { testCaseClassName :: Text+  , testCaseName :: Text+  , testCaseResult :: Maybe Result+  }+  deriving (Show)++data Result = Failure Text Text | Skipped Text+  deriving (Show)