module Test.Tasty.Runners.JenkinsXML
( CompatAntXMLPath(..)
, ExitSuccess(..)
, addCompatOpt
, addExitOpt
, jenkinsXMLRunner
)
where
import Control.Applicative (pure)
import Data.Bool (Bool(True, False), (||))
import Data.Function ((.), ($), flip)
import Data.Functor (Functor(fmap))
import Data.Maybe (Maybe(Nothing, Just))
import Data.Monoid (mempty)
import Data.Proxy (Proxy(Proxy))
import Data.Typeable (Typeable)
import System.IO (FilePath)
import Test.Tasty.Ingredients (Ingredient(TestReporter), composeReporters)
import Test.Tasty.Ingredients.Basic (consoleTestReporter)
import Test.Tasty.Options
( IsOption(defaultValue, parseValue, optionName, optionHelp, optionCLParser)
, OptionDescription(Option)
, lookupOption
, mkFlagCLParser
, safeRead
, setOption
)
import Test.Tasty.Runners.AntXML (antXMLRunner, AntXMLPath(AntXMLPath))
newtype CompatAntXMLPath = CompatAntXMLPath FilePath deriving Typeable
instance IsOption (Maybe CompatAntXMLPath) where
defaultValue = Nothing
parseValue = Just . Just . CompatAntXMLPath
optionName = pure "jxml"
optionHelp = pure "An alias for --xml"
newtype ExitSuccess = ExitSuccess { isExitSuccess :: Bool } deriving Typeable
instance IsOption ExitSuccess where
defaultValue = ExitSuccess False
parseValue = fmap ExitSuccess . safeRead
optionName = pure "exit-success"
optionHelp = pure "Exit with status 0 even if some tests failed"
optionCLParser = mkFlagCLParser mempty (ExitSuccess True)
addCompatOpt :: Ingredient -> Ingredient
addCompatOpt reporter =
TestReporter (compatOpt : optDesc) (runner . applyCompatOpt)
where
TestReporter optDesc runner = reporter
compatOpt = Option (Proxy :: Proxy (Maybe CompatAntXMLPath))
applyCompatOpt opts = case lookupOption opts of
Nothing -> opts
Just (CompatAntXMLPath path) ->
setOption (Just (AntXMLPath path)) opts
addExitOpt :: Ingredient -> Ingredient
addExitOpt reporter =
TestReporter (exitOpt : optDesc) (mapExit exit runner)
where
TestReporter optDesc runner = reporter
exitOpt = Option (Proxy :: Proxy ExitSuccess)
exit opts retVal = retVal || isExitSuccess (lookupOption opts)
mapExit f run o tt = run o tt <&> \rf s -> rf s <&> \r t -> r t <&> f o
(<&>) :: Functor f => f a -> (a -> b) -> f b
(<&>) = flip fmap
jenkinsXMLRunner :: Ingredient
jenkinsXMLRunner = addExitOpt . addCompatOpt
$ antXMLRunner `composeReporters` consoleTestReporter