diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2017, Merijn Verstraaten + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * 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. + + * Neither the name of Merijn Verstraaten nor the names of other + 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 +OWNER 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,40 @@ +Tasty Travis: Fancy Travis CI output for tasty tests +==================================================== +[![BSD3](https://img.shields.io/badge/License-BSD-blue.svg)](https://en.wikipedia.org/wiki/BSD_License) +[![Hackage](https://img.shields.io/hackage/v/tasty-travis.svg)](https://hackage.haskell.org/package/tasty-travis) +[![Build Status](https://travis-ci.org/merijn/tasty-travis.svg)](https://travis-ci.org/merijn/tasty-travis) + +**Tasty Travis** provides fancy +[Tasty](https://hackage.haskell.org/package/tasty) test output on +[Travis CI](https://travis-ci.org/). + +It allows you get coloured test output, folding and collapsing groups of tests, +and hiding the output of successful tests. + +Example +------- + +Here's what an example `test.hs` might look: + +```haskell +import Test.Tasty +import Test.Tasty.Travis (travisTestReporter, defaultConfig, listingTests) +import Test.Tasty.HUnit + +import Data.List +import Data.Ord + +main = defaultMainWithIngredients ingredients tests + where + ingredients = [ listingTests, travisTestReporter defaultConfig ] + +tests :: TestTree +tests = testGroup "Unit tests" + [ testCase "List comparison (different length)" $ + [1, 2, 3] `compare` [1,2] @?= GT + + -- the following test does not hold + , testCase "List comparison (same length)" $ + [1, 2, 3] `compare` [1,2,2] @?= LT + ] +``` diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Test/Tasty/Travis.hs b/Test/Tasty/Travis.hs new file mode 100644 --- /dev/null +++ b/Test/Tasty/Travis.hs @@ -0,0 +1,237 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE Trustworthy #-} +------------------------------------------------------------------------------- +-- | +-- Module : Test.Tasty.Travis +-- Copyright : (C) 2017 Merijn Verstraaten +-- License : BSD-style (see the file LICENSE) +-- Maintainer : Merijn Verstraaten +-- Stability : experimental +-- Portability : haha +-- +-- support for +-- . +-- +-- This module provides a tasty 'Ingredient' which functions as a drop-in +-- replacement for the 'consoleTestReporter' from tasty. It detects whether the +-- \"TRAVIS\" environment variable is set to \"true\". If so, it produces +-- output as configured. If not, it falls back to the 'consoleTestReporter'. +------------------------------------------------------------------------------- +module Test.Tasty.Travis + ( travisTestReporter + , TravisConfig(..) + , defaultConfig + , FoldGroup(..) + , FoldWhen(..) + , SummaryWhen(..) + , listingTests + ) where + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative (Applicative(..), (<$>), (<$), (<*>)) +import Data.Monoid (Monoid(..)) +#endif +import Control.Monad (when) +import Data.Char (isSpace) +import Data.Monoid (Sum(..)) +import System.Environment (lookupEnv) +import System.Exit (exitFailure) +import System.IO + (BufferMode(LineBuffering), hPutStrLn, hSetBuffering, stderr, stdout) + +import Test.Tasty.Ingredients.ConsoleReporter +import Test.Tasty.Options (IsOption(..), OptionSet, setOption) +import Test.Tasty.Runners + +newtype WrapIO a = WrapIO { unwrapIO :: IO a } + deriving (Applicative, Functor, Monad) + +instance Monoid a => Monoid (WrapIO a) where + mempty = WrapIO $ return mempty + mappend x y = mappend <$> x <*> y + +-- | Configuration for the output generated on Travis CI. +data TravisConfig + = TravisConfig + { travisQuiet :: Bool + -- ^ Do not report individual tests, only overall pass/fail Statistics. + , travisHideSuccesses :: Bool + -- ^ If 'True', only report failures. + , travisUseColour :: Bool + -- ^ If 'True', generate coloured output + , travisFoldGroup :: FoldGroup + -- ^ How to group folds. + , travisFoldWhen :: FoldWhen + -- ^ When to fold. + , travisSummaryWhen :: SummaryWhen + -- ^ When to print a summary for a fold. + } + +-- | Default Travis configuration. Coloured output. Folds all successes away. +-- Adds summaries for folds with failures (which don't happen in this config). +defaultConfig :: TravisConfig +defaultConfig = TravisConfig + { travisQuiet = quiet + , travisHideSuccesses = hide + , travisUseColour = True + , travisFoldGroup = FoldAll + , travisFoldWhen = FoldSuccess + , travisSummaryWhen = SummaryFailures + } where + HideSuccesses hide = defaultValue + Quiet quiet = defaultValue + +-- | Control which parts of the test tree are folded away. +data FoldGroup + = FoldMoreThan Int + -- ^ Fold groups with more than N entries (groups or tests). + | FoldBelow Int + -- ^ Fold groups more than N levels from the root. + | FoldTop Int + -- ^ Fold groups N or less levels from the root. + | FoldAll + -- ^ Fold all groups. + deriving (Eq, Show) + +-- | Control when the tests/groups specified by 'FoldGroup' are folded. +data FoldWhen + = FoldNever -- ^ Never fold output. + | FoldSuccess -- ^ Fold all groups that have 0 failures. + | FoldAlways -- ^ Always fold groups. + deriving (Eq, Show) + +-- | Control when a summary is printed before a fold. +data SummaryWhen + = SummaryNever -- ^ Never print summaries. + | SummaryFailures -- ^ Print summaries before folds with failures. + | SummaryAlways -- ^ Always print summaries before folds. + deriving (Eq, Show) + +-- | Create a Tasty 'Ingredient' from a 'TravisConfig'. Defaults to the regular +-- console output when the TRAVIS environment variable is not set to \"true\". +-- +-- Usage: +-- +-- @'defaultMainWithIngredients' ['listingTests', 'travisTestReporter' yourConfig] yourTestTree@ +travisTestReporter :: TravisConfig -> Ingredient +travisTestReporter cfg@TravisConfig{..} = TestReporter baseOpts runTests + where + TestReporter baseOpts consoleReporter = consoleTestReporter + + runTests :: OptionSet -> TestTree + -> Maybe (StatusMap -> IO (Time -> IO Bool)) + runTests opts tree = Just $ \smap -> do + isTravis <- maybe False (=="true") <$> lookupEnv "TRAVIS" + if isTravis + then runTravisTestReporter cfg travisOptions tree smap + else runConsoleReporter smap + where + travisOptions :: OptionSet + travisOptions = setOption (Quiet travisQuiet) + . setOption (HideSuccesses travisHideSuccesses) + . setOption (if travisUseColour then Always else Auto) + $ opts + + errMsg :: String + errMsg = "Unexpected failure in Tasty's 'consoleTestReporter'!" + + runConsoleReporter :: StatusMap -> IO (Time -> IO Bool) + runConsoleReporter = case consoleReporter opts tree of + Just f -> f + Nothing -> const $ do + hPutStrLn stderr errMsg + exitFailure + +runTravisTestReporter + :: TravisConfig + -> OptionSet + -> TestTree + -> StatusMap + -> IO (Time -> IO Bool) +runTravisTestReporter cfg@TravisConfig{..} opts tree smap = do + let ?colors = travisUseColour + let testOutput = buildTestOutput opts tree + + hSetBuffering stdout LineBuffering + (output, stats) <- travisOutput cfg testOutput smap + when (not travisQuiet) $ unwrapIO $ output "" 0 + return $ \time -> + (statFailures stats == 0) <$ printStatistics stats time + +travisOutput + :: (?colors :: Bool) + => TravisConfig + -> TestOutput + -> StatusMap + -> IO (String -> Int -> WrapIO (), Statistics) +travisOutput TravisConfig{..} output smap = + fmap strip . unwrapIO $ foldTestOutput foldTest foldHeading output smap + where + strip (x,y,_) = (x,y) + foldTest + :: String + -> IO () + -> IO Result + -> (Result -> IO ()) + -> WrapIO (String -> Int -> WrapIO (), Statistics, Sum Int) + foldTest _name printName getResult printResult = WrapIO $ do + r <- getResult + return $ case resultOutcome r of + Success -> (success r, Statistics 1 0, Sum 1) + Failure{} -> (doPrint r, Statistics 1 1, Sum 1) + where + success r | travisHideSuccesses = \_ _ -> return () + | otherwise = doPrint r + + doPrint r _ _ = WrapIO $ printName >> printResult r + + foldHeading + :: String + -> IO () + -> WrapIO (String -> Int -> WrapIO (), Statistics, Sum Int) + -> WrapIO (String -> Int -> WrapIO (), Statistics, Sum Int) + foldHeading name printHeading foldBody = do + (printBody, stats@Statistics{..}, kids) <- foldBody + let act label n = WrapIO $ do + printHeading + when mustSummarise $ printStatisticsNoTime stats + when mustFold $ + putStrLn $ "travis_fold:start:" ++ foldMarker ++ "\\r" + + unwrapIO $ printBody (foldMarker ++ "/") (n+1) + + when mustFold $ + putStrLn $ "travis_fold:end:" ++ foldMarker ++ "\\r" + where + replace c | isSpace c = '_' + | otherwise = c + + foldMarker = label ++ map replace name + mustFold = doFold travisFoldWhen stats travisFoldGroup kids n + mustSummarise = and [ n /= 0, mustFold + , doSummary travisSummaryWhen stats] + + if statTotal == 0 || (statFailures == 0 && travisHideSuccesses) + then return (\_ _ -> return (), stats, Sum 0) + else return (act, stats, Sum 1) + +doFold :: FoldWhen -> Statistics -> FoldGroup -> Sum Int -> Int -> Bool +doFold FoldNever _ = \_ _ _ -> False +doFold FoldSuccess stats + | statFailures stats == 0 = doFoldGroup + | otherwise = \_ _ _ -> False +doFold FoldAlways _ = doFoldGroup + +doFoldGroup :: FoldGroup -> Sum Int -> Int -> Bool +doFoldGroup FoldAll _ _ = True +doFoldGroup (FoldBelow n) _ i = i > n +doFoldGroup (FoldTop n) _ i = i <= n +doFoldGroup (FoldMoreThan n) kids _ = getSum kids > n + +doSummary :: SummaryWhen -> Statistics -> Bool +doSummary SummaryNever _ = False +doSummary SummaryFailures stats = statFailures stats /= 0 +doSummary SummaryAlways _ = True diff --git a/tasty-travis.cabal b/tasty-travis.cabal new file mode 100644 --- /dev/null +++ b/tasty-travis.cabal @@ -0,0 +1,54 @@ +Name: tasty-travis +Version: 0.1.0 + +Homepage: https://github.com/merijn/tasty-travis +Bug-Reports: https://github.com/merijn/tasty-travis/issues + +Author: Merijn Verstraaten +Maintainer: Merijn Verstraaten +Copyright: Copyright © 2017 Merijn Verstraaten + +License: BSD3 +License-File: LICENSE + +Category: Testing +Cabal-Version: >= 1.10 +Build-Type: Simple +Tested-With: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, + GHC == 8.2.1, GHC == 8.3.* + +Extra-Source-Files: README.md + +Synopsis: Fancy Travis CI output for tasty tests. + +Description: + Fancy output for + tests. Features include: + . + * Folded output + . + * Coloured output + . + * Hiding successful tests + +Library + Default-Language: Haskell2010 + GHC-Options: -Wall -fno-warn-unused-do-bind + + Exposed-Modules: Test.Tasty.Travis + Other-Extensions: CPP + GeneralizedNewtypeDeriving + ImplicitParams + RecordWildCards + Trustworthy + + Build-Depends: base >= 4.6 && < 5 + , tasty == 0.12.* + +Source-Repository head + Type: git + Location: ssh://github.com:merijn/tasty-travis.git + +Source-Repository head + Type: mercurial + Location: https://bitbucket.org/merijnv/tasty-travis