diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -17,16 +17,35 @@ Here's what an example `test.hs` might look: ```haskell +import Data.List +import Data.Ord +import Data.Tagged (Tagged) +import Data.Typeable (Typeable) +import Options.Applicative (switch, long, help) + import Test.Tasty -import Test.Tasty.Travis (travisTestReporter, defaultConfig, listingTests) +import Test.Tasty.Options +import Test.Tasty.Travis (travisTestReporter, defaultConfig) import Test.Tasty.HUnit -import Data.List -import Data.Ord +newtype EnableTravis = EnableTravis Bool + deriving (Eq, Ord, Typeable) -main = defaultMainWithIngredients ingredients tests +instance IsOption EnableTravis where + defaultValue = EnableTravis False + parseValue = fmap EnableTravis . safeRead + optionName = return "enable-travis" + optionHelp = return "Run Travis tests." + optionCLParser = + fmap EnableTravis $ + switch + ( long (untag (optionName :: Tagged EnableTravis String)) + <> help (untag (optionHelp :: Tagged EnableTravis String)) + ) + +main = travisTestReporter cfg [] tests where - ingredients = [ listingTests, travisTestReporter defaultConfig ] + cfg = defaultConfig { travisTestOptions = setOption (EnableTravis True) } tests :: TestTree tests = testGroup "Unit tests" @@ -36,5 +55,10 @@ -- the following test does not hold , testCase "List comparison (same length)" $ [1, 2, 3] `compare` [1,2,2] @?= LT + , askOption $ \(EnableTravis enable) -> + if enable then travisTests else testGroup "" [] ] + +travisTests :: TestTree +travisTests = testGroup "Travis" [ {- Travis tests here -} ] ``` diff --git a/Test.hs b/Test.hs deleted file mode 100644 --- a/Test.hs +++ /dev/null @@ -1,30 +0,0 @@ -import Test.Tasty -import Test.Tasty.HUnit -import Test.Tasty.Travis - -main :: IO () -main = defaultMainWithIngredients ingredients . testGroup "tasty-travis" $ - [ testGroup "Group 1" - [ testCase "Test 1" $ return () - , testCase "Test 2" $ return () - , testCase "Test 3" $ return () - , testCase "Test 4" $ return () - ] - , testGroup "Group 2" [ testCase "Test 1" $ return () ] - , testGroup "Group 3" - [ testCase "Test 0" $ return () - , testGroup "Group 4" $ - [ testCase "Test 1" $ return () - , testCase "Test 2" $ return () - , testCase "Test 3" $ return () - , testCase "Test 4" $ return () - ] - ] - , testGroup "Group 4" [ testCase "Test 1" $ return ()] - ] - where - ingredients = [ listingTests , travisTestReporter travisConfig ] - travisConfig = defaultConfig - { travisFoldGroup = FoldMoreThan 2 - , travisSummaryWhen = SummaryAlways - } diff --git a/Test/Tasty/Travis.hs b/Test/Tasty/Travis.hs --- a/Test/Tasty/Travis.hs +++ b/Test/Tasty/Travis.hs @@ -15,9 +15,9 @@ -- 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 +-- This module provides a tasty test reporter which functions as a drop-in +-- replacement for 'defaultMainWithIngredients' 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 @@ -27,7 +27,6 @@ , FoldGroup(..) , FoldWhen(..) , SummaryWhen(..) - , listingTests ) where #if !MIN_VERSION_base(4,8,0) @@ -38,9 +37,7 @@ 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 System.IO (BufferMode(LineBuffering), hSetBuffering, stdout) import Test.Tasty.Ingredients.ConsoleReporter import Test.Tasty.Options (IsOption(..), OptionSet, setOption) @@ -68,6 +65,9 @@ -- ^ When to fold. , travisSummaryWhen :: SummaryWhen -- ^ When to print a summary for a fold. + , travisTestOptions :: OptionSet -> OptionSet + -- ^ Set/unset options when running on Travis. Functions like + -- 'PlusTestOptions' when running on Travis, does nothing otherwise. } -- | Default Travis configuration. Coloured output. Folds all successes away. @@ -80,6 +80,7 @@ , travisFoldGroup = FoldAll , travisFoldWhen = FoldSuccess , travisSummaryWhen = SummaryFailures + , travisTestOptions = id } where HideSuccesses hide = defaultValue Quiet quiet = defaultValue @@ -110,40 +111,40 @@ | 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\". +-- | A Tasty test runner whose output can be controlled with a 'TravisConfig'. +-- Defaults to the regular console reporting 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 +-- @'travisTestReporter' yourConfig [] yourTestTree@ +travisTestReporter :: TravisConfig -> [Ingredient] -> TestTree -> IO () +travisTestReporter cfg@TravisConfig{..} ingredients tests = do + isTravis <- maybe False (=="true") <$> lookupEnv "TRAVIS" + let finalIngredients + | isTravis = ingredients ++ [listingTests, travisReporter] + | otherwise = ingredients ++ [listingTests, consoleTestReporter] + + tree | isTravis = PlusTestOptions travisTestOptions tests + | otherwise = tests + + defaultMainWithIngredients finalIngredients tree where - TestReporter baseOpts consoleReporter = consoleTestReporter + TestReporter baseOpts _ = consoleTestReporter + travisReporter :: Ingredient + travisReporter = TestReporter baseOpts runTests + 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 + runTests opts tree = Just $ \smap -> + runTravisTestReporter cfg travisOptions tree 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 diff --git a/tasty-travis.cabal b/tasty-travis.cabal --- a/tasty-travis.cabal +++ b/tasty-travis.cabal @@ -1,5 +1,5 @@ Name: tasty-travis -Version: 0.1.2 +Version: 0.2.0 Homepage: https://github.com/merijn/tasty-travis Bug-Reports: https://github.com/merijn/tasty-travis/issues @@ -49,6 +49,7 @@ Default-Language: Haskell2010 Type: exitcode-stdio-1.0 Main-Is: Test.hs + Hs-Source-Dirs: tests GHC-Options: -Wall -fno-warn-unused-do-bind Build-Depends: base , tasty diff --git a/tests/Test.hs b/tests/Test.hs new file mode 100644 --- /dev/null +++ b/tests/Test.hs @@ -0,0 +1,29 @@ +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.Travis + +main :: IO () +main = travisTestReporter travisConfig [] . testGroup "tasty-travis" $ + [ testGroup "Group 1" + [ testCase "Test 1" $ return () + , testCase "Test 2" $ return () + , testCase "Test 3" $ return () + , testCase "Test 4" $ return () + ] + , testGroup "Group 2" [ testCase "Test 1" $ return () ] + , testGroup "Group 3" + [ testCase "Test 0" $ return () + , testGroup "Group 4" $ + [ testCase "Test 1" $ return () + , testCase "Test 2" $ return () + , testCase "Test 3" $ return () + , testCase "Test 4" $ return () + ] + ] + , testGroup "Group 4" [ testCase "Test 1" $ return ()] + ] + where + travisConfig = defaultConfig + { travisFoldGroup = FoldMoreThan 2 + , travisSummaryWhen = SummaryAlways + }