{-# LANGUAGE RecordWildCards #-}
module Distribution.Client.CmdTest (
testCommand,
testAction,
isSubComponentProblem,
notTestProblem,
noTestsProblem,
selectPackageTargets,
selectComponentTarget
) where
import Distribution.Client.Compat.Prelude
import Prelude ()
import Distribution.Client.ProjectOrchestration
import Distribution.Client.CmdErrorMessages
( renderTargetSelector, showTargetSelector, targetSelectorFilter, plural,
renderTargetProblem,
renderTargetProblemNoTargets, targetSelectorPluralPkgs )
import Distribution.Client.TargetProblem
( TargetProblem (..) )
import Distribution.Client.NixStyleOptions
( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags )
import Distribution.Client.Setup
( GlobalFlags(..), ConfigFlags(..) )
import Distribution.Simple.Setup
( TestFlags(..), fromFlagOrDefault )
import Distribution.Simple.Command
( CommandUI(..), usageAlternatives )
import Distribution.Simple.Flag
( Flag(..) )
import Distribution.Verbosity
( normal )
import Distribution.Simple.Utils
( notice, wrapText, die' )
import qualified System.Exit (exitSuccess)
testCommand :: CommandUI (NixStyleFlags ())
testCommand :: CommandUI (NixStyleFlags ())
testCommand = CommandUI :: forall flags.
String
-> String
-> (String -> String)
-> Maybe (String -> String)
-> Maybe (String -> String)
-> flags
-> (ShowOrParseArgs -> [OptionField flags])
-> CommandUI flags
CommandUI
{ commandName :: String
commandName = String
"v2-test"
, commandSynopsis :: String
commandSynopsis = String
"Run test-suites."
, commandUsage :: String -> String
commandUsage = String -> [String] -> String -> String
usageAlternatives String
"v2-test" [ String
"[TARGETS] [FLAGS]" ]
, commandDescription :: Maybe (String -> String)
commandDescription = (String -> String) -> Maybe (String -> String)
forall a. a -> Maybe a
Just ((String -> String) -> Maybe (String -> String))
-> (String -> String) -> Maybe (String -> String)
forall a b. (a -> b) -> a -> b
$ \String
_ -> String -> String
wrapText (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
String
"Runs the specified test-suites, first ensuring they are up to "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"date.\n\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Any test-suite in any package in the project can be specified. "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"A package can be specified in which case all the test-suites in the "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"package are run. The default is to run all the test-suites in the "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"package in the current directory.\n\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Dependencies are built or rebuilt as necessary. Additional "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"configuration flags can be specified on the command line and these "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"extend the project configuration from the 'cabal.project', "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'cabal.project.local' and other files.\n\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"To pass command-line arguments to a test suite, see the "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"v2-run command."
, commandNotes :: Maybe (String -> String)
commandNotes = (String -> String) -> Maybe (String -> String)
forall a. a -> Maybe a
Just ((String -> String) -> Maybe (String -> String))
-> (String -> String) -> Maybe (String -> String)
forall a b. (a -> b) -> a -> b
$ \String
pname ->
String
"Examples:\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" v2-test\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" Run all the test-suites in the package in the current directory\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" v2-test pkgname\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" Run all the test-suites in the package named pkgname\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" v2-test cname\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" Run the test-suite named cname\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" v2-test cname --enable-coverage\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" Run the test-suite built with code coverage (including local libs used)\n"
, commandDefaultFlags :: NixStyleFlags ()
commandDefaultFlags = () -> NixStyleFlags ()
forall a. a -> NixStyleFlags a
defaultNixStyleFlags ()
, commandOptions :: ShowOrParseArgs -> [OptionField (NixStyleFlags ())]
commandOptions = (ShowOrParseArgs -> [OptionField ()])
-> ShowOrParseArgs -> [OptionField (NixStyleFlags ())]
forall a.
(ShowOrParseArgs -> [OptionField a])
-> ShowOrParseArgs -> [OptionField (NixStyleFlags a)]
nixStyleOptions ([OptionField ()] -> ShowOrParseArgs -> [OptionField ()]
forall a b. a -> b -> a
const [])
}
testAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO ()
testAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO ()
testAction flags :: NixStyleFlags ()
flags@NixStyleFlags {()
ConfigFlags
HaddockFlags
TestFlags
BenchmarkFlags
ProjectFlags
InstallFlags
ConfigExFlags
extraFlags :: forall a. NixStyleFlags a -> a
projectFlags :: forall a. NixStyleFlags a -> ProjectFlags
benchmarkFlags :: forall a. NixStyleFlags a -> BenchmarkFlags
testFlags :: forall a. NixStyleFlags a -> TestFlags
haddockFlags :: forall a. NixStyleFlags a -> HaddockFlags
installFlags :: forall a. NixStyleFlags a -> InstallFlags
configExFlags :: forall a. NixStyleFlags a -> ConfigExFlags
configFlags :: forall a. NixStyleFlags a -> ConfigFlags
extraFlags :: ()
projectFlags :: ProjectFlags
benchmarkFlags :: BenchmarkFlags
testFlags :: TestFlags
haddockFlags :: HaddockFlags
installFlags :: InstallFlags
configExFlags :: ConfigExFlags
configFlags :: ConfigFlags
..} [String]
targetStrings GlobalFlags
globalFlags = do
ProjectBaseContext
baseCtx <- Verbosity
-> ProjectConfig -> CurrentCommand -> IO ProjectBaseContext
establishProjectBaseContext Verbosity
verbosity ProjectConfig
cliConfig CurrentCommand
OtherCommand
[TargetSelector]
targetSelectors <- ([TargetSelectorProblem] -> IO [TargetSelector])
-> ([TargetSelector] -> IO [TargetSelector])
-> Either [TargetSelectorProblem] [TargetSelector]
-> IO [TargetSelector]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Verbosity -> [TargetSelectorProblem] -> IO [TargetSelector]
forall a. Verbosity -> [TargetSelectorProblem] -> IO a
reportTargetSelectorProblems Verbosity
verbosity) [TargetSelector] -> IO [TargetSelector]
forall (m :: * -> *) a. Monad m => a -> m a
return
(Either [TargetSelectorProblem] [TargetSelector]
-> IO [TargetSelector])
-> IO (Either [TargetSelectorProblem] [TargetSelector])
-> IO [TargetSelector]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [PackageSpecifier (SourcePackage (PackageLocation (Maybe String)))]
-> Maybe ComponentKindFilter
-> [String]
-> IO (Either [TargetSelectorProblem] [TargetSelector])
forall a.
[PackageSpecifier (SourcePackage (PackageLocation a))]
-> Maybe ComponentKindFilter
-> [String]
-> IO (Either [TargetSelectorProblem] [TargetSelector])
readTargetSelectors (ProjectBaseContext
-> [PackageSpecifier
(SourcePackage (PackageLocation (Maybe String)))]
localPackages ProjectBaseContext
baseCtx) (ComponentKindFilter -> Maybe ComponentKindFilter
forall a. a -> Maybe a
Just ComponentKindFilter
TestKind) [String]
targetStrings
ProjectBuildContext
buildCtx <-
Verbosity
-> ProjectBaseContext
-> (ElaboratedInstallPlan
-> IO (ElaboratedInstallPlan, TargetsMap))
-> IO ProjectBuildContext
runProjectPreBuildPhase Verbosity
verbosity ProjectBaseContext
baseCtx ((ElaboratedInstallPlan -> IO (ElaboratedInstallPlan, TargetsMap))
-> IO ProjectBuildContext)
-> (ElaboratedInstallPlan
-> IO (ElaboratedInstallPlan, TargetsMap))
-> IO ProjectBuildContext
forall a b. (a -> b) -> a -> b
$ \ElaboratedInstallPlan
elaboratedPlan -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BuildTimeSettings -> Bool
buildSettingOnlyDeps (ProjectBaseContext -> BuildTimeSettings
buildSettings ProjectBaseContext
baseCtx)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"The test command does not support '--only-dependencies'. "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"You may wish to use 'build --only-dependencies' and then "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"use 'test'."
TargetsMap
targets <- ([TestTargetProblem] -> IO TargetsMap)
-> (TargetsMap -> IO TargetsMap)
-> Either [TestTargetProblem] TargetsMap
-> IO TargetsMap
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Verbosity -> Flag Bool -> [TestTargetProblem] -> IO TargetsMap
forall a. Verbosity -> Flag Bool -> [TestTargetProblem] -> IO a
reportTargetProblems Verbosity
verbosity Flag Bool
failWhenNoTestSuites) TargetsMap -> IO TargetsMap
forall (m :: * -> *) a. Monad m => a -> m a
return
(Either [TestTargetProblem] TargetsMap -> IO TargetsMap)
-> Either [TestTargetProblem] TargetsMap -> IO TargetsMap
forall a b. (a -> b) -> a -> b
$ (forall k.
TargetSelector
-> [AvailableTarget k] -> Either TestTargetProblem [k])
-> (forall k.
SubComponentTarget
-> AvailableTarget k -> Either TestTargetProblem k)
-> ElaboratedInstallPlan
-> Maybe SourcePackageDb
-> [TargetSelector]
-> Either [TestTargetProblem] TargetsMap
forall err.
(forall k.
TargetSelector
-> [AvailableTarget k] -> Either (TargetProblem err) [k])
-> (forall k.
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem err) k)
-> ElaboratedInstallPlan
-> Maybe SourcePackageDb
-> [TargetSelector]
-> Either [TargetProblem err] TargetsMap
resolveTargets
forall k.
TargetSelector
-> [AvailableTarget k] -> Either TestTargetProblem [k]
selectPackageTargets
forall k.
SubComponentTarget
-> AvailableTarget k -> Either TestTargetProblem k
selectComponentTarget
ElaboratedInstallPlan
elaboratedPlan
Maybe SourcePackageDb
forall a. Maybe a
Nothing
[TargetSelector]
targetSelectors
let elaboratedPlan' :: ElaboratedInstallPlan
elaboratedPlan' = TargetAction
-> TargetsMap -> ElaboratedInstallPlan -> ElaboratedInstallPlan
pruneInstallPlanToTargets
TargetAction
TargetActionTest
TargetsMap
targets
ElaboratedInstallPlan
elaboratedPlan
(ElaboratedInstallPlan, TargetsMap)
-> IO (ElaboratedInstallPlan, TargetsMap)
forall (m :: * -> *) a. Monad m => a -> m a
return (ElaboratedInstallPlan
elaboratedPlan', TargetsMap
targets)
Verbosity -> ProjectBaseContext -> ProjectBuildContext -> IO ()
printPlan Verbosity
verbosity ProjectBaseContext
baseCtx ProjectBuildContext
buildCtx
BuildOutcomes
buildOutcomes <- Verbosity
-> ProjectBaseContext -> ProjectBuildContext -> IO BuildOutcomes
runProjectBuildPhase Verbosity
verbosity ProjectBaseContext
baseCtx ProjectBuildContext
buildCtx
Verbosity
-> ProjectBaseContext
-> ProjectBuildContext
-> BuildOutcomes
-> IO ()
runProjectPostBuildPhase Verbosity
verbosity ProjectBaseContext
baseCtx ProjectBuildContext
buildCtx BuildOutcomes
buildOutcomes
where
failWhenNoTestSuites :: Flag Bool
failWhenNoTestSuites = TestFlags -> Flag Bool
testFailWhenNoTestSuites TestFlags
testFlags
verbosity :: Verbosity
verbosity = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (ConfigFlags -> Flag Verbosity
configVerbosity ConfigFlags
configFlags)
cliConfig :: ProjectConfig
cliConfig = GlobalFlags
-> NixStyleFlags () -> ClientInstallFlags -> ProjectConfig
forall a.
GlobalFlags
-> NixStyleFlags a -> ClientInstallFlags -> ProjectConfig
commandLineFlagsToProjectConfig GlobalFlags
globalFlags NixStyleFlags ()
flags ClientInstallFlags
forall a. Monoid a => a
mempty
selectPackageTargets :: TargetSelector
-> [AvailableTarget k] -> Either TestTargetProblem [k]
selectPackageTargets :: TargetSelector
-> [AvailableTarget k] -> Either TestTargetProblem [k]
selectPackageTargets TargetSelector
targetSelector [AvailableTarget k]
targets
| Bool -> Bool
not ([k] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [k]
targetsTestsBuildable)
= [k] -> Either TestTargetProblem [k]
forall a b. b -> Either a b
Right [k]
targetsTestsBuildable
| Bool -> Bool
not ([AvailableTarget ()] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AvailableTarget ()]
targetsTests)
= TestTargetProblem -> Either TestTargetProblem [k]
forall a b. a -> Either a b
Left (TargetSelector -> [AvailableTarget ()] -> TestTargetProblem
forall a. TargetSelector -> [AvailableTarget ()] -> TargetProblem a
TargetProblemNoneEnabled TargetSelector
targetSelector [AvailableTarget ()]
targetsTests)
| Bool -> Bool
not ([AvailableTarget k] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AvailableTarget k]
targets)
= TestTargetProblem -> Either TestTargetProblem [k]
forall a b. a -> Either a b
Left (TargetSelector -> TestTargetProblem
noTestsProblem TargetSelector
targetSelector)
| Bool
otherwise
= TestTargetProblem -> Either TestTargetProblem [k]
forall a b. a -> Either a b
Left (TargetSelector -> TestTargetProblem
forall a. TargetSelector -> TargetProblem a
TargetProblemNoTargets TargetSelector
targetSelector)
where
targetsTestsBuildable :: [k]
targetsTestsBuildable = [AvailableTarget k] -> [k]
forall k. [AvailableTarget k] -> [k]
selectBuildableTargets
([AvailableTarget k] -> [k])
-> ([AvailableTarget k] -> [AvailableTarget k])
-> [AvailableTarget k]
-> [k]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComponentKindFilter -> [AvailableTarget k] -> [AvailableTarget k]
forall k.
ComponentKindFilter -> [AvailableTarget k] -> [AvailableTarget k]
filterTargetsKind ComponentKindFilter
TestKind
([AvailableTarget k] -> [k]) -> [AvailableTarget k] -> [k]
forall a b. (a -> b) -> a -> b
$ [AvailableTarget k]
targets
targetsTests :: [AvailableTarget ()]
targetsTests = [AvailableTarget k] -> [AvailableTarget ()]
forall k. [AvailableTarget k] -> [AvailableTarget ()]
forgetTargetsDetail
([AvailableTarget k] -> [AvailableTarget ()])
-> ([AvailableTarget k] -> [AvailableTarget k])
-> [AvailableTarget k]
-> [AvailableTarget ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComponentKindFilter -> [AvailableTarget k] -> [AvailableTarget k]
forall k.
ComponentKindFilter -> [AvailableTarget k] -> [AvailableTarget k]
filterTargetsKind ComponentKindFilter
TestKind
([AvailableTarget k] -> [AvailableTarget ()])
-> [AvailableTarget k] -> [AvailableTarget ()]
forall a b. (a -> b) -> a -> b
$ [AvailableTarget k]
targets
selectComponentTarget :: SubComponentTarget
-> AvailableTarget k -> Either TestTargetProblem k
selectComponentTarget :: SubComponentTarget
-> AvailableTarget k -> Either TestTargetProblem k
selectComponentTarget subtarget :: SubComponentTarget
subtarget@SubComponentTarget
WholeComponent AvailableTarget k
t
| CTestName UnqualComponentName
_ <- AvailableTarget k -> ComponentName
forall k. AvailableTarget k -> ComponentName
availableTargetComponentName AvailableTarget k
t
= (TestTargetProblem -> Either TestTargetProblem k)
-> (k -> Either TestTargetProblem k)
-> Either TestTargetProblem k
-> Either TestTargetProblem k
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TestTargetProblem -> Either TestTargetProblem k
forall a b. a -> Either a b
Left k -> Either TestTargetProblem k
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TestTargetProblem k -> Either TestTargetProblem k)
-> Either TestTargetProblem k -> Either TestTargetProblem k
forall a b. (a -> b) -> a -> b
$
SubComponentTarget
-> AvailableTarget k -> Either TestTargetProblem k
forall k a.
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem a) k
selectComponentTargetBasic SubComponentTarget
subtarget AvailableTarget k
t
| Bool
otherwise
= TestTargetProblem -> Either TestTargetProblem k
forall a b. a -> Either a b
Left (PackageId -> ComponentName -> TestTargetProblem
notTestProblem
(AvailableTarget k -> PackageId
forall k. AvailableTarget k -> PackageId
availableTargetPackageId AvailableTarget k
t)
(AvailableTarget k -> ComponentName
forall k. AvailableTarget k -> ComponentName
availableTargetComponentName AvailableTarget k
t))
selectComponentTarget SubComponentTarget
subtarget AvailableTarget k
t
= TestTargetProblem -> Either TestTargetProblem k
forall a b. a -> Either a b
Left (PackageId
-> ComponentName -> SubComponentTarget -> TestTargetProblem
isSubComponentProblem
(AvailableTarget k -> PackageId
forall k. AvailableTarget k -> PackageId
availableTargetPackageId AvailableTarget k
t)
(AvailableTarget k -> ComponentName
forall k. AvailableTarget k -> ComponentName
availableTargetComponentName AvailableTarget k
t)
SubComponentTarget
subtarget)
data TestProblem =
TargetProblemNoTests TargetSelector
| TargetProblemComponentNotTest PackageId ComponentName
| TargetProblemIsSubComponent PackageId ComponentName SubComponentTarget
deriving (TestProblem -> TestProblem -> Bool
(TestProblem -> TestProblem -> Bool)
-> (TestProblem -> TestProblem -> Bool) -> Eq TestProblem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestProblem -> TestProblem -> Bool
$c/= :: TestProblem -> TestProblem -> Bool
== :: TestProblem -> TestProblem -> Bool
$c== :: TestProblem -> TestProblem -> Bool
Eq, Int -> TestProblem -> String -> String
[TestProblem] -> String -> String
TestProblem -> String
(Int -> TestProblem -> String -> String)
-> (TestProblem -> String)
-> ([TestProblem] -> String -> String)
-> Show TestProblem
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TestProblem] -> String -> String
$cshowList :: [TestProblem] -> String -> String
show :: TestProblem -> String
$cshow :: TestProblem -> String
showsPrec :: Int -> TestProblem -> String -> String
$cshowsPrec :: Int -> TestProblem -> String -> String
Show)
type TestTargetProblem = TargetProblem TestProblem
noTestsProblem :: TargetSelector -> TargetProblem TestProblem
noTestsProblem :: TargetSelector -> TestTargetProblem
noTestsProblem = TestProblem -> TestTargetProblem
forall a. a -> TargetProblem a
CustomTargetProblem (TestProblem -> TestTargetProblem)
-> (TargetSelector -> TestProblem)
-> TargetSelector
-> TestTargetProblem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TargetSelector -> TestProblem
TargetProblemNoTests
notTestProblem :: PackageId -> ComponentName -> TargetProblem TestProblem
notTestProblem :: PackageId -> ComponentName -> TestTargetProblem
notTestProblem PackageId
pkgid ComponentName
name = TestProblem -> TestTargetProblem
forall a. a -> TargetProblem a
CustomTargetProblem (TestProblem -> TestTargetProblem)
-> TestProblem -> TestTargetProblem
forall a b. (a -> b) -> a -> b
$ PackageId -> ComponentName -> TestProblem
TargetProblemComponentNotTest PackageId
pkgid ComponentName
name
isSubComponentProblem
:: PackageId
-> ComponentName
-> SubComponentTarget
-> TargetProblem TestProblem
isSubComponentProblem :: PackageId
-> ComponentName -> SubComponentTarget -> TestTargetProblem
isSubComponentProblem PackageId
pkgid ComponentName
name SubComponentTarget
subcomponent = TestProblem -> TestTargetProblem
forall a. a -> TargetProblem a
CustomTargetProblem (TestProblem -> TestTargetProblem)
-> TestProblem -> TestTargetProblem
forall a b. (a -> b) -> a -> b
$
PackageId -> ComponentName -> SubComponentTarget -> TestProblem
TargetProblemIsSubComponent PackageId
pkgid ComponentName
name SubComponentTarget
subcomponent
reportTargetProblems :: Verbosity -> Flag Bool -> [TestTargetProblem] -> IO a
reportTargetProblems :: Verbosity -> Flag Bool -> [TestTargetProblem] -> IO a
reportTargetProblems Verbosity
verbosity Flag Bool
failWhenNoTestSuites [TestTargetProblem]
problems =
case (Flag Bool
failWhenNoTestSuites, [TestTargetProblem]
problems) of
(Flag Bool
True, [CustomTargetProblem (TargetProblemNoTests TargetSelector
_)]) ->
Verbosity -> String -> IO a
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity String
problemsMessage
(Flag Bool
_, [CustomTargetProblem (TargetProblemNoTests TargetSelector
selector)]) -> do
Verbosity -> String -> IO ()
notice Verbosity
verbosity (TargetSelector -> String
renderAllowedNoTestsProblem TargetSelector
selector)
IO a
forall a. IO a
System.Exit.exitSuccess
(Flag Bool
_, [TestTargetProblem]
_) -> Verbosity -> String -> IO a
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity String
problemsMessage
where
problemsMessage :: String
problemsMessage = [String] -> String
unlines ([String] -> String)
-> ([TestTargetProblem] -> [String])
-> [TestTargetProblem]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TestTargetProblem -> String) -> [TestTargetProblem] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TestTargetProblem -> String
renderTestTargetProblem ([TestTargetProblem] -> String) -> [TestTargetProblem] -> String
forall a b. (a -> b) -> a -> b
$ [TestTargetProblem]
problems
renderAllowedNoTestsProblem :: TargetSelector -> String
renderAllowedNoTestsProblem :: TargetSelector -> String
renderAllowedNoTestsProblem TargetSelector
selector =
String
"No tests to run for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
renderTargetSelector TargetSelector
selector
renderTestTargetProblem :: TestTargetProblem -> String
renderTestTargetProblem :: TestTargetProblem -> String
renderTestTargetProblem (TargetProblemNoTargets TargetSelector
targetSelector) =
case TargetSelector -> Maybe ComponentKindFilter
targetSelectorFilter TargetSelector
targetSelector of
Just ComponentKindFilter
kind | ComponentKindFilter
kind ComponentKindFilter -> ComponentKindFilter -> Bool
forall a. Eq a => a -> a -> Bool
/= ComponentKindFilter
TestKind
-> String
"The test command is for running test suites, but the target '"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
showTargetSelector TargetSelector
targetSelector String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' refers to "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
renderTargetSelector TargetSelector
targetSelector String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
forall a. Show a => a -> String
show TargetSelector
targetSelector
Maybe ComponentKindFilter
_ -> String -> TargetSelector -> String
renderTargetProblemNoTargets String
"test" TargetSelector
targetSelector
renderTestTargetProblem TestTargetProblem
problem =
String -> (TestProblem -> String) -> TestTargetProblem -> String
forall a. String -> (a -> String) -> TargetProblem a -> String
renderTargetProblem String
"test" TestProblem -> String
renderTestProblem TestTargetProblem
problem
renderTestProblem :: TestProblem -> String
renderTestProblem :: TestProblem -> String
renderTestProblem (TargetProblemNoTests TargetSelector
targetSelector) =
String
"Cannot run tests for the target '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
showTargetSelector TargetSelector
targetSelector
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' which refers to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
renderTargetSelector TargetSelector
targetSelector
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" because "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Plural -> String -> String -> String
forall a. Plural -> a -> a -> a
plural (TargetSelector -> Plural
targetSelectorPluralPkgs TargetSelector
targetSelector) String
"it does" String
"they do"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not contain any test suites."
renderTestProblem (TargetProblemComponentNotTest PackageId
pkgid ComponentName
cname) =
String
"The test command is for running test suites, but the target '"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
showTargetSelector TargetSelector
targetSelector String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' refers to "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
renderTargetSelector TargetSelector
targetSelector String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" from the package "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ PackageId -> String
forall a. Pretty a => a -> String
prettyShow PackageId
pkgid String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
where
targetSelector :: TargetSelector
targetSelector = PackageId -> ComponentName -> SubComponentTarget -> TargetSelector
TargetComponent PackageId
pkgid ComponentName
cname SubComponentTarget
WholeComponent
renderTestProblem (TargetProblemIsSubComponent PackageId
pkgid ComponentName
cname SubComponentTarget
subtarget) =
String
"The test command can only run test suites as a whole, "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"not files or modules within them, but the target '"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
showTargetSelector TargetSelector
targetSelector String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' refers to "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
renderTargetSelector TargetSelector
targetSelector String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
where
targetSelector :: TargetSelector
targetSelector = PackageId -> ComponentName -> SubComponentTarget -> TargetSelector
TargetComponent PackageId
pkgid ComponentName
cname SubComponentTarget
subtarget