diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,3 @@ +# 0.1.0.0 + +- Initial implementation. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,29 @@ +BSD 3-Clause License + +Copyright (c) 2020, Christoph Hermann +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +3. Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,23 @@ +# tasty-test-reporter + +An ingredient for tasty that prints a summary and outputs junit xml that works with jenkins. + +![output from reporter](./output.png) + +## Setting up this ingredient for tasty. + +```hs +import Test.Tasty +import Test.Tasty.HUnit +import qualified Test.Tasty.Runners.Reporter as Reporter + +main = defaultMainWithIngredients [Reporter.ingredient] tests + +tests :: TestTree +``` + +## Running tests with cabal + +```bash +$ cabal test --test-show-details=always --test-options "--xml=report.xml" +``` diff --git a/src/Test/Console/Color.hs b/src/Test/Console/Color.hs new file mode 100644 --- /dev/null +++ b/src/Test/Console/Color.hs @@ -0,0 +1,62 @@ +module Test.Console.Color + ( red, + magenta, + black, + blue, + yellow, + green, + grey, + underlined, + Colored (Colors, NoColors), + Style, + styled, + maybeStyled, + ) +where + +import qualified Data.Text +import Data.Text (Text) +import qualified System.Console.ANSI as Console + +type Style = [Console.SGR] + +code :: Style -> Text +code = Data.Text.pack . Console.setSGRCode + +styled :: Style -> Text -> Text +styled col t = code col <> t <> code [reset] + +maybeStyled :: Colored -> Style -> Text -> Text +maybeStyled colored styles text = + case colored of + Colors -> styled styles text + NoColors -> text + +data Colored = Colors | NoColors + +reset :: Console.SGR +reset = Console.Reset + +red :: Console.SGR +red = Console.SetColor Console.Foreground Console.Dull Console.Red + +magenta :: Console.SGR +magenta = Console.SetColor Console.Foreground Console.Dull Console.Magenta + +blue :: Console.SGR +blue = Console.SetColor Console.Foreground Console.Dull Console.Blue + +yellow :: Console.SGR +yellow = Console.SetColor Console.Foreground Console.Dull Console.Yellow + +green :: Console.SGR +green = Console.SetColor Console.Foreground Console.Dull Console.Green + +grey :: Console.SGR +grey = Console.SetColor Console.Foreground Console.Vivid Console.Black + +black :: Console.SGR +black = Console.SetColor Console.Foreground Console.Dull Console.White + +underlined :: Console.SGR +underlined = Console.SetUnderlining Console.SingleUnderline diff --git a/src/Test/Tasty/Runners/Reporter.hs b/src/Test/Tasty/Runners/Reporter.hs new file mode 100644 --- /dev/null +++ b/src/Test/Tasty/Runners/Reporter.hs @@ -0,0 +1,422 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- An ingredient for tasty that prints a summary and outputs junit xml that works with jenkins. +-- +-- Usage: +-- +-- @ +-- import Test.Tasty +-- import Test.Tasty.HUnit +-- import qualified Test.Tasty.Runners.Reporter as Reporter +-- +-- main = defaultMainWithIngredients [Reporter.ingredient] tests +-- +-- tests :: TestTree +-- @ +-- +-- Example output: +-- +-- @ +-- +-- λ cabal test --test-show-details=always +-- ... +-- Test suite spec: RUNNING... +-- ↓ Unit tests +-- ✗ List comparison (smaller length) +-- +-- test/Main.hs:19: +-- expected: LT +-- but got: GT +-- +-- +-- ↓ Unit tests +-- ↓ sub group +-- ✗ foo +-- +-- Test threw an exception +-- user error (asdf) +-- +-- +-- +-- TEST RUN FAILED +-- ^^^^^^^^^^^^^^^ +-- +-- Duration: 0.000s +-- Passed: 1 +-- Failed: 2 +-- @ +module Test.Tasty.Runners.Reporter + ( ingredient, + + -- * Support for skipping tests (example usage coming soon) + SkippingTests (TestSkipped, TestOnly), + + -- * Support for running only one test (example usage coming soon) + OnlyTestResult (OnlyTestPassed, OnlyTestFailed), + ) +where + +import qualified Control.Concurrent.STM as STM +import qualified Control.Exception.Safe as Exception +import Control.Exception.Safe (displayException) +import Control.Monad (Monad) +import Control.Monad.IO.Class (liftIO) +import qualified Control.Monad.State as State +import Data.Function ((&)) +import qualified Data.IntMap as IntMap +import Data.Maybe (fromMaybe) +import Data.Monoid (Monoid (mappend, mempty), Sum (getSum)) +import Data.Proxy (Proxy (Proxy)) +import Data.Semigroup +import Data.Tagged (Tagged (Tagged)) +import qualified Data.Text as Text +import Data.Text (Text) +import Data.Typeable (Typeable) +import Numeric (showFFloat) +import System.Console.Concurrent (outputConcurrent, withConcurrentOutput) +import System.Directory (canonicalizePath, createDirectoryIfMissing) +import System.FilePath (FilePath, takeDirectory) +import Test.Console.Color (Style, black, green, grey, red, styled, underlined, yellow) +import qualified Test.Tasty as Tasty +import qualified Test.Tasty.Options as Tasty +import qualified Test.Tasty.Runners as Tasty +import qualified Text.XML.JUnit as JUnit + +-- | Ingredient for `Tasty.defaultMainWithIngredients` +-- Runs all tests and outputs a summary as well as the failing tests. +-- Optionally takes `--xml=report.xml` and outputs junit xml. +ingredient :: Tasty.Ingredient +ingredient = + Tasty.TestReporter optionDescription $ \options testTree -> + Tasty.lookupOption options + & runner options testTree + & Just + +-- | Types for skipping tests. (example coming soon) +data SkippingTests = TestSkipped | TestOnly OnlyTestResult deriving (Show) + +instance Exception.Exception SkippingTests + +-- | Types for running only one test. (example coming soon) +data OnlyTestResult + = OnlyTestPassed String + | OnlyTestFailed String + deriving (Show) + +newtype JunitXMLPath = JunitXMLPath FilePath + deriving (Typeable) + +instance Tasty.IsOption (Maybe JunitXMLPath) where + + defaultValue = Nothing + + parseValue = Just . Just . JunitXMLPath + + optionName = Tagged "xml" + + optionHelp = Tagged "A file path to store the test results in JUnit-compatible XML" + +data Summary + = Summary + { failures :: Sum Int, + errors :: Sum Int, + successes :: Sum Int, + skipped :: Sum Int, + hasOnly :: Bool, + testSuites :: [JUnit.TestSuite] + } + +instance Monoid Summary where + mempty = + Summary + { failures = mempty, + errors = mempty, + successes = mempty, + skipped = mempty, + hasOnly = False, + testSuites = mempty + } + +instance Semigroup Summary where + a <> b = + Summary + { failures = failures a <> failures b, + errors = errors a <> errors b, + successes = successes a <> successes b, + skipped = skipped a <> skipped b, + hasOnly = hasOnly a || hasOnly b, + testSuites = testSuites a <> testSuites b + } + +-- TraversalT is a newtype that allows us to have a monoid instance for a monad. +newtype TraversalT m a = TraversalT {appTraversalT :: m a} + +instance (Monad m, Monoid a) => Monoid (TraversalT m a) where + mempty = TraversalT (pure mempty) + +instance (Monad m, Semigroup a) => Semigroup (TraversalT m a) where + TraversalT f1 <> TraversalT f2 = TraversalT $ do + a <- f1 + b <- f2 + pure (a <> b) + +type StateIO = State.StateT IntMap.Key IO + +newtype GroupNames = GroupNames [Text] + deriving (Monoid, Semigroup) + +optionDescription :: [Tasty.OptionDescription] +optionDescription = [Tasty.Option (Proxy :: Proxy (Maybe JunitXMLPath))] + +runner :: + Tasty.OptionSet -> + Tasty.TestTree -> + Maybe JunitXMLPath -> + IntMap.IntMap (STM.TVar Tasty.Status) -> + IO (Tasty.Time -> IO Bool) +runner options testTree path statusMap = withConcurrentOutput $ do + (summary, _) <- + Tasty.foldTestTree + Tasty.trivialFold + { Tasty.foldSingle = runTest statusMap, + Tasty.foldGroup = runGroup + } + options + testTree + & (\x -> x mempty) + & appTraversalT + & (\x -> State.runStateT x 0) + pure (createOutputs summary path) + +createOutputs :: Summary -> Maybe JunitXMLPath -> Tasty.Time -> IO Bool +createOutputs summary@Summary {errors, failures, testSuites, hasOnly} maybePath elapsedTime = do + printSummary summary elapsedTime + case maybePath of + Nothing -> pure () + Just (JunitXMLPath path) -> do + createPathDirIfMissing path + JUnit.writeXmlReport path testSuites + pure (getSum (failures `mappend` errors) == 0 && not hasOnly) + +runTest :: + IntMap.IntMap (STM.TVar Tasty.Status) -> + o -> + Tasty.TestName -> + t -> + GroupNames -> + TraversalT StateIO Summary +runTest statusMap _ testName_ _ groupNames = TraversalT $ do + let testName = Text.pack testName_ + index <- State.get + result <- liftIO $ STM.atomically $ do + status <- + IntMap.lookup index statusMap + & fromMaybe (error "Attempted to lookup test by index outside bounds") + & STM.readTVar + case status of + Tasty.Done result -> pure result + _ -> STM.retry + _ <- State.modify (+ 1) + liftIO (resultToSummary groupNames testName result) + +resultToSummary :: GroupNames -> Text -> Tasty.Result -> IO Summary +resultToSummary groupNames testName Tasty.Result {Tasty.resultOutcome, Tasty.resultTime, Tasty.resultDescription} = + case resultOutcome of + Tasty.Success -> + mempty + { testSuites = + [ JUnit.passed testName + & JUnit.time resultTime + & inSuite groupNames + ], + successes = Sum 1 + } + & pure + Tasty.Failure (Tasty.TestThrewException err) -> + case Exception.fromException err of + Just TestSkipped -> do + printLines + [ prettyPath [red] testName groupNames_, + "Test was skipped", + "\n" + ] + mempty + { testSuites = + [ JUnit.skipped testName + & inSuite groupNames + ], + skipped = Sum 1 + } + & pure + Just (TestOnly (OnlyTestPassed _)) -> do + let errorMessage = + Text.unlines + [ "This test passed, but there is a `Test.only` in your test.", + "I failed the test, because it's easy to forget to remove `Test.only`." + ] + printLines + [ prettyPath [red] testName groupNames_, + errorMessage, + "\n" + ] + mempty + { testSuites = + [ JUnit.errored testName + & JUnit.time resultTime + & JUnit.errorMessage errorMessage + & inSuite groupNames + ], + hasOnly = True, + successes = Sum 1 + } + & pure + Just (TestOnly (OnlyTestFailed str)) -> do + printLines + [ prettyPath [red] testName groupNames_, + Text.pack resultDescription, + "\n" + ] + mempty + { testSuites = + [ JUnit.failed testName + & JUnit.failureMessage "This test failed and contains a `Test.only. `Test.only` will also fail your build even if the test passes." + & JUnit.stderr (Text.pack str) + & JUnit.time resultTime + & inSuite groupNames + ], + errors = Sum 1 + } + & pure + _ -> do + let errorMessage = "Test threw an exception" + printLines + [ prettyPath [red] testName groupNames_, + errorMessage, + Text.pack (displayException err), + "\n" + ] + mempty + { testSuites = + [ JUnit.errored testName + & JUnit.stderr (Text.pack (displayException err)) + & JUnit.errorMessage errorMessage + & JUnit.time resultTime + & inSuite groupNames + ], + errors = Sum 1 + } + & pure + Tasty.Failure (Tasty.TestTimedOut _) -> + mempty + { testSuites = + [ JUnit.errored testName + & JUnit.errorMessage "Test timed out" + & JUnit.time resultTime + & inSuite groupNames + ], + errors = Sum 1 + } + & pure + Tasty.Failure _ -> do + printLines + [ prettyPath [red] testName groupNames_, + Text.pack resultDescription, + "\n" + ] + mempty + { testSuites = + [ JUnit.failed testName + & JUnit.stderr (Text.pack resultDescription) + & JUnit.time resultTime + & inSuite groupNames + ], + failures = Sum 1 + } + & pure + where + (GroupNames groupNames_) = groupNames + +runGroup :: + String -> + (GroupNames -> TraversalT StateIO Summary) -> + GroupNames -> + TraversalT StateIO Summary +runGroup groupName children (GroupNames groupNames) = + Text.pack groupName : groupNames + & GroupNames + & children + & appTraversalT + & TraversalT + +printSummary :: Summary -> Tasty.Time -> IO () +printSummary Summary {failures, errors, successes, skipped, hasOnly} duration = + [ -- Title "TEST RUN ..." + if hasOnly + then + styled [yellow, underlined] "TEST RUN INCOMPLETE" + <> styled [yellow] " because there is an `only` in your tests." + else + if failedTestsTotal > 0 + then styled [red, underlined] "TEST RUN FAILED" + else + if skippedTestsTotal > 0 + then + styled [yellow, underlined] "TEST RUN INCOMPLETE" + <> if skippedTestsTotal == 1 + then styled [yellow] (" because there was " <> fromInt skippedTestsTotal <> " test skipped.") + else styled [yellow] (" because there were " <> fromInt skippedTestsTotal <> " tests skipped.") + else styled [green, underlined] "TEST RUN PASSED", + "\n\n", + -- Infos + -- Duration: 0.001s + -- Passed: 23 + -- Skipped: 1 + -- Failed: 0 + styled [black] ("Duration: " <> showTime duration <> "s"), + "\n", + styled [black] ("Passed: " <> fromInt (getSum successes)), + "\n", + if skippedTestsTotal > 0 + then styled [black] ("Skipped: " <> fromInt skippedTestsTotal <> "\n") + else "", + styled [black] ("Failed: " <> fromInt failedTestsTotal), + "\n\n" + ] + & outputConcurrent . mconcat + where + failedTestsTotal = getSum (failures <> errors) + skippedTestsTotal = getSum skipped + +prettyPath :: Style -> Text -> [Text] -> Text +prettyPath style name path = + mconcat + [ reverse path + & map (styled [grey] . (<>) "↓ ") + & Text.unlines, + styled style ("✗ " <> name) <> "\n" + ] + +inSuite :: GroupNames -> JUnit.TestReport outcome -> JUnit.TestSuite +inSuite (GroupNames groupNames) = JUnit.inSuite (Text.intercalate "." groupNames) + +printLines :: [Text] -> IO () +printLines = outputConcurrent . Text.unlines + +timeDigits :: Num p => p +timeDigits = 3 + +showTime :: Tasty.Time -> Text +showTime time = Text.pack (showFFloat (Just timeDigits) time "") + +fromInt :: Int -> Text +fromInt = Text.pack . Prelude.show + +createPathDirIfMissing :: FilePath -> IO () +createPathDirIfMissing path = do + dirPath <- fmap takeDirectory (canonicalizePath path) + createDirectoryIfMissing True dirPath diff --git a/tasty-test-reporter.cabal b/tasty-test-reporter.cabal new file mode 100644 --- /dev/null +++ b/tasty-test-reporter.cabal @@ -0,0 +1,66 @@ +cabal-version: 1.18 + +-- This file has been generated from package.yaml by hpack version 0.33.0. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 906ddcbab3e7eeb141dfa9072be537219c861b9378474ff09546cf4a39d5041c + +name: tasty-test-reporter +version: 0.1.0.0 +synopsis: Producing JUnit-style XML test reports. +description: Please see the README at . +category: Testing +homepage: https://github.com/stoeffel/tasty-test-reporter#readme +bug-reports: https://github.com/stoeffel/tasty-test-reporter/issues +author: Christoph Hermann +maintainer: schtoeffel@gmail.com +copyright: 2020 Christoph Hermann +license: BSD3 +license-file: LICENSE +build-type: Simple +extra-doc-files: + README.md + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/stoeffel/tasty-test-reporter + +library + exposed-modules: + Test.Tasty.Runners.Reporter + other-modules: + Test.Console.Color + Paths_tasty_test_reporter + hs-source-dirs: + src + build-depends: + ansi-terminal >=0.10 && <0.11 + , base >=4.10.1.0 && <5 + , concurrent-output >=1.10 && <1.11 + , containers >=0.6 && <0.7 + , directory >=1.3 && <1.4 + , filepath >=1.4 && <1.5 + , junit-xml >=0.1 && <0.2 + , mtl >=2.2 && <2.3 + , safe-exceptions >=0.1 && <0.2 + , stm >=2.5 && <2.6 + , tagged >=0.8 && <0.9 + , tasty >=0.1 && <1.3 + , text >=1.2 && <1.3 + default-language: Haskell2010 + +test-suite spec + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: + Paths_tasty_test_reporter + hs-source-dirs: + test + build-depends: + base + , tasty >=1.1 && <1.3 + , tasty-hunit + , tasty-test-reporter + default-language: Haskell2010 diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main + ( main, + ) +where + +import Test.Tasty +import Test.Tasty.HUnit +import qualified Test.Tasty.Runners.Reporter as Reporter + +main = defaultMainWithIngredients [Reporter.ingredient] tests + +tests :: TestTree +tests = + testGroup + "Unit tests" + [ testCase "List comparison (smaller length)" $ + [1, 2, 3] `compare` [1, 2] @?= LT, + testCase "List comparison (longer length)" $ + [1, 2] `compare` [1, 2, 3] @?= GT, + testCase "List comparison (EQ length)" $ + [1, 2, 3] `compare` [1, 2, 3] @?= EQ, + testGroup + "sub group" + [testCase "foo" $ fail "asdf"] + ]