{-# LANGUAGE RecordWildCards #-}

-- | cabal-install CLI command: test
--
module Distribution.Client.CmdTest (
    -- * The @test@ CLI and action
    testCommand,
    testAction,

    -- * Internals exposed for testing
    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
  { 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  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ \String
_ -> String -> String
wrapText forall a b. (a -> b) -> a -> b
$
        String
"Runs the specified test-suites, first ensuring they are up to "
     forall a. [a] -> [a] -> [a]
++ String
"date.\n\n"

     forall a. [a] -> [a] -> [a]
++ String
"Any test-suite in any package in the project can be specified. "
     forall a. [a] -> [a] -> [a]
++ String
"A package can be specified in which case all the test-suites in the "
     forall a. [a] -> [a] -> [a]
++ String
"package are run. The default is to run all the test-suites in the "
     forall a. [a] -> [a] -> [a]
++ String
"package in the current directory.\n\n"

     forall a. [a] -> [a] -> [a]
++ String
"Dependencies are built or rebuilt as necessary. Additional "
     forall a. [a] -> [a] -> [a]
++ String
"configuration flags can be specified on the command line and these "
     forall a. [a] -> [a] -> [a]
++ String
"extend the project configuration from the 'cabal.project', "
     forall a. [a] -> [a] -> [a]
++ String
"'cabal.project.local' and other files.\n\n"

     forall a. [a] -> [a] -> [a]
++ String
"To pass command-line arguments to a test suite, see the "
     forall a. [a] -> [a] -> [a]
++ String
"v2-run command."
  , commandNotes :: Maybe (String -> String)
commandNotes        = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ \String
pname ->
        String
"Examples:\n"
     forall a. [a] -> [a] -> [a]
++ String
"  " forall a. [a] -> [a] -> [a]
++ String
pname forall a. [a] -> [a] -> [a]
++ String
" v2-test\n"
     forall a. [a] -> [a] -> [a]
++ String
"    Run all the test-suites in the package in the current directory\n"
     forall a. [a] -> [a] -> [a]
++ String
"  " forall a. [a] -> [a] -> [a]
++ String
pname forall a. [a] -> [a] -> [a]
++ String
" v2-test pkgname\n"
     forall a. [a] -> [a] -> [a]
++ String
"    Run all the test-suites in the package named pkgname\n"
     forall a. [a] -> [a] -> [a]
++ String
"  " forall a. [a] -> [a] -> [a]
++ String
pname forall a. [a] -> [a] -> [a]
++ String
" v2-test cname\n"
     forall a. [a] -> [a] -> [a]
++ String
"    Run the test-suite named cname\n"
     forall a. [a] -> [a] -> [a]
++ String
"  " forall a. [a] -> [a] -> [a]
++ String
pname forall a. [a] -> [a] -> [a]
++ String
" v2-test cname --enable-coverage\n"
     forall a. [a] -> [a] -> [a]
++ String
"    Run the test-suite built with code coverage (including local libs used)\n"

  , commandDefaultFlags :: NixStyleFlags ()
commandDefaultFlags = forall a. a -> NixStyleFlags a
defaultNixStyleFlags ()
  , commandOptions :: ShowOrParseArgs -> [OptionField (NixStyleFlags ())]
commandOptions      = forall a.
(ShowOrParseArgs -> [OptionField a])
-> ShowOrParseArgs -> [OptionField (NixStyleFlags a)]
nixStyleOptions (forall a b. a -> b -> a
const [])
  }



-- | The @test@ command is very much like @build@. It brings the install plan
-- up to date, selects that part of the plan needed by the given or implicit
-- test target(s) and then executes the plan.
--
-- Compared to @build@ the difference is that there's also test targets
-- which are ephemeral.
--
-- For more details on how this works, see the module
-- "Distribution.Client.ProjectOrchestration"
--
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 <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. Verbosity -> [TargetSelectorProblem] -> IO a
reportTargetSelectorProblems Verbosity
verbosity) forall (m :: * -> *) a. Monad m => a -> m a
return
                   forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a.
[PackageSpecifier (SourcePackage (PackageLocation a))]
-> Maybe ComponentKindFilter
-> [String]
-> IO (Either [TargetSelectorProblem] [TargetSelector])
readTargetSelectors (ProjectBaseContext -> [PackageSpecifier UnresolvedSourcePackage]
localPackages ProjectBaseContext
baseCtx) (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 forall a b. (a -> b) -> a -> b
$ \ElaboratedInstallPlan
elaboratedPlan -> do

            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BuildTimeSettings -> Bool
buildSettingOnlyDeps (ProjectBaseContext -> BuildTimeSettings
buildSettings ProjectBaseContext
baseCtx)) forall a b. (a -> b) -> a -> b
$
              forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
                  String
"The test command does not support '--only-dependencies'. "
               forall a. [a] -> [a] -> [a]
++ String
"You may wish to use 'build --only-dependencies' and then "
               forall a. [a] -> [a] -> [a]
++ String
"use 'test'."

            -- Interpret the targets on the command line as test targets
            -- (as opposed to say build or haddock targets).
            TargetsMap
targets <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. Verbosity -> Flag Bool -> [TestTargetProblem] -> IO a
reportTargetProblems Verbosity
verbosity Flag Bool
failWhenNoTestSuites) forall (m :: * -> *) a. Monad m => a -> m a
return
                     forall a b. (a -> b) -> a -> b
$ 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
                         forall a. Maybe a
Nothing
                         [TargetSelector]
targetSelectors

            let elaboratedPlan' :: ElaboratedInstallPlan
elaboratedPlan' = TargetAction
-> TargetsMap -> ElaboratedInstallPlan -> ElaboratedInstallPlan
pruneInstallPlanToTargets
                                    TargetAction
TargetActionTest
                                    TargetsMap
targets
                                    ElaboratedInstallPlan
elaboratedPlan
            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 = forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (ConfigFlags -> Flag Verbosity
configVerbosity ConfigFlags
configFlags)
    cliConfig :: ProjectConfig
cliConfig = forall a.
GlobalFlags
-> NixStyleFlags a -> ClientInstallFlags -> ProjectConfig
commandLineFlagsToProjectConfig GlobalFlags
globalFlags NixStyleFlags ()
flags forall a. Monoid a => a
mempty -- ClientInstallFlags

-- | This defines what a 'TargetSelector' means for the @test@ command.
-- It selects the 'AvailableTarget's that the 'TargetSelector' refers to,
-- or otherwise classifies the problem.
--
-- For the @test@ command we select all buildable test-suites,
-- or fail if there are no test-suites or no buildable test-suites.
--
selectPackageTargets  :: TargetSelector
                      -> [AvailableTarget k] -> Either TestTargetProblem [k]
selectPackageTargets :: forall k.
TargetSelector
-> [AvailableTarget k] -> Either TestTargetProblem [k]
selectPackageTargets TargetSelector
targetSelector [AvailableTarget k]
targets

    -- If there are any buildable test-suite targets then we select those
  | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [k]
targetsTestsBuildable)
  = forall a b. b -> Either a b
Right [k]
targetsTestsBuildable

    -- If there are test-suites but none are buildable then we report those
  | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AvailableTarget ()]
targetsTests)
  = forall a b. a -> Either a b
Left (forall a. TargetSelector -> [AvailableTarget ()] -> TargetProblem a
TargetProblemNoneEnabled TargetSelector
targetSelector [AvailableTarget ()]
targetsTests)

    -- If there are no test-suite but some other targets then we report that
  | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AvailableTarget k]
targets)
  = forall a b. a -> Either a b
Left (TargetSelector -> TestTargetProblem
noTestsProblem TargetSelector
targetSelector)

    -- If there are no targets at all then we report that
  | Bool
otherwise
  = forall a b. a -> Either a b
Left (forall a. TargetSelector -> TargetProblem a
TargetProblemNoTargets TargetSelector
targetSelector)
  where
    targetsTestsBuildable :: [k]
targetsTestsBuildable = forall k. [AvailableTarget k] -> [k]
selectBuildableTargets
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k.
ComponentKindFilter -> [AvailableTarget k] -> [AvailableTarget k]
filterTargetsKind ComponentKindFilter
TestKind
                          forall a b. (a -> b) -> a -> b
$ [AvailableTarget k]
targets

    targetsTests :: [AvailableTarget ()]
targetsTests          = forall k. [AvailableTarget k] -> [AvailableTarget ()]
forgetTargetsDetail
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k.
ComponentKindFilter -> [AvailableTarget k] -> [AvailableTarget k]
filterTargetsKind ComponentKindFilter
TestKind
                          forall a b. (a -> b) -> a -> b
$ [AvailableTarget k]
targets


-- | For a 'TargetComponent' 'TargetSelector', check if the component can be
-- selected.
--
-- For the @test@ command we just need to check it is a test-suite, in addition
-- to the basic checks on being buildable etc.
--
selectComponentTarget :: SubComponentTarget
                      -> AvailableTarget k -> Either TestTargetProblem k
selectComponentTarget :: forall k.
SubComponentTarget
-> AvailableTarget k -> Either TestTargetProblem k
selectComponentTarget subtarget :: SubComponentTarget
subtarget@SubComponentTarget
WholeComponent AvailableTarget k
t
  | CTestName UnqualComponentName
_ <- forall k. AvailableTarget k -> ComponentName
availableTargetComponentName AvailableTarget k
t
  = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
           forall k a.
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem a) k
selectComponentTargetBasic SubComponentTarget
subtarget AvailableTarget k
t
  | Bool
otherwise
  = forall a b. a -> Either a b
Left (PackageId -> ComponentName -> TestTargetProblem
notTestProblem
           (forall k. AvailableTarget k -> PackageId
availableTargetPackageId AvailableTarget k
t)
           (forall k. AvailableTarget k -> ComponentName
availableTargetComponentName AvailableTarget k
t))

selectComponentTarget SubComponentTarget
subtarget AvailableTarget k
t
  = forall a b. a -> Either a b
Left (PackageId
-> ComponentName -> SubComponentTarget -> TestTargetProblem
isSubComponentProblem
           (forall k. AvailableTarget k -> PackageId
availableTargetPackageId AvailableTarget k
t)
           (forall k. AvailableTarget k -> ComponentName
availableTargetComponentName AvailableTarget k
t)
           SubComponentTarget
subtarget)

-- | The various error conditions that can occur when matching a
-- 'TargetSelector' against 'AvailableTarget's for the @test@ command.
--
data TestProblem =
     -- | The 'TargetSelector' matches targets but no test-suites
     TargetProblemNoTests     TargetSelector

     -- | The 'TargetSelector' refers to a component that is not a test-suite
   | TargetProblemComponentNotTest PackageId ComponentName

     -- | Asking to test an individual file or module is not supported
   | TargetProblemIsSubComponent   PackageId ComponentName SubComponentTarget
  deriving (TestProblem -> TestProblem -> Bool
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
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 = forall a. a -> TargetProblem a
CustomTargetProblem 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 = forall a. a -> TargetProblem a
CustomTargetProblem 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 = forall a. a -> TargetProblem a
CustomTargetProblem 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 :: forall a. 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
_)]) ->
      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)
      forall a. IO a
System.Exit.exitSuccess
    (Flag Bool
_, [TestTargetProblem]
_) -> forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity String
problemsMessage
    where
      problemsMessage :: String
problemsMessage = [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map TestTargetProblem -> String
renderTestTargetProblem forall a b. (a -> b) -> a -> b
$ [TestTargetProblem]
problems

-- | Unless @--test-fail-when-no-test-suites@ flag is passed, we don't
--   @die@ when the target problem is 'TargetProblemNoTests'.
--   Instead, we display a notice saying that no tests have run and
--   indicate how this behaviour was enabled.
renderAllowedNoTestsProblem :: TargetSelector -> String
renderAllowedNoTestsProblem :: TargetSelector -> String
renderAllowedNoTestsProblem TargetSelector
selector =
    String
"No tests to run for " 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 forall a. Eq a => a -> a -> Bool
/= ComponentKindFilter
TestKind
        -> String
"The test command is for running test suites, but the target '"
           forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
showTargetSelector TargetSelector
targetSelector forall a. [a] -> [a] -> [a]
++ String
"' refers to "
           forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
renderTargetSelector TargetSelector
targetSelector forall a. [a] -> [a] -> [a]
++ String
"."
           forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TargetSelector
targetSelector

      Maybe ComponentKindFilter
_ -> String -> TargetSelector -> String
renderTargetProblemNoTargets String
"test" TargetSelector
targetSelector
renderTestTargetProblem TestTargetProblem
problem =
    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 '" forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
showTargetSelector TargetSelector
targetSelector
 forall a. [a] -> [a] -> [a]
++ String
"' which refers to " forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
renderTargetSelector TargetSelector
targetSelector
 forall a. [a] -> [a] -> [a]
++ String
" because "
 forall a. [a] -> [a] -> [a]
++ forall a. Plural -> a -> a -> a
plural (TargetSelector -> Plural
targetSelectorPluralPkgs TargetSelector
targetSelector) String
"it does" String
"they do"
 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 '"
 forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
showTargetSelector TargetSelector
targetSelector forall a. [a] -> [a] -> [a]
++ String
"' refers to "
 forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
renderTargetSelector TargetSelector
targetSelector forall a. [a] -> [a] -> [a]
++ String
" from the package "
 forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow PackageId
pkgid 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, "
 forall a. [a] -> [a] -> [a]
++ String
"not files or modules within them, but the target '"
 forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
showTargetSelector TargetSelector
targetSelector forall a. [a] -> [a] -> [a]
++ String
"' refers to "
 forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
renderTargetSelector TargetSelector
targetSelector forall a. [a] -> [a] -> [a]
++ String
"."
  where
    targetSelector :: TargetSelector
targetSelector = PackageId -> ComponentName -> SubComponentTarget -> TargetSelector
TargetComponent PackageId
pkgid ComponentName
cname SubComponentTarget
subtarget