{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}

-- | cabal-install CLI command: run
module Distribution.Client.CmdRun
  ( -- * The @run@ CLI and action
    runCommand
  , runAction
  , handleShebang
  , validScript

    -- * Internals exposed for testing
  , matchesMultipleProblem
  , noExesProblem
  , selectPackageTargets
  , selectComponentTarget
  ) where

import Distribution.Client.Compat.Prelude hiding (toList)
import Prelude ()

import Data.List (group)
import qualified Data.Set as Set
import Distribution.Client.CmdErrorMessages
  ( plural
  , renderListCommaAnd
  , renderListPretty
  , renderTargetProblem
  , renderTargetProblemNoTargets
  , renderTargetSelector
  , showTargetSelector
  , targetSelectorFilter
  , targetSelectorPluralPkgs
  )
import Distribution.Client.Errors
import Distribution.Client.GlobalFlags
  ( defaultGlobalFlags
  )
import Distribution.Client.InstallPlan
  ( foldPlanPackage
  , toList
  )
import Distribution.Client.NixStyleOptions
  ( NixStyleFlags (..)
  , defaultNixStyleFlags
  , nixStyleOptions
  )
import Distribution.Client.ProjectConfig.Types
  ( ProjectConfig (projectConfigShared)
  , ProjectConfigShared (projectConfigProgPathExtra)
  )
import Distribution.Client.ProjectOrchestration
import Distribution.Client.ProjectPlanning
  ( ElaboratedConfiguredPackage (..)
  , ElaboratedInstallPlan
  , binDirectoryFor
  )
import Distribution.Client.ProjectPlanning.Types
  ( ElaboratedPackageOrComponent (..)
  , dataDirsEnvironmentForPlan
  , elabExeDependencyPaths
  )

import Distribution.Client.ScriptUtils
  ( AcceptNoTargets (..)
  , TargetContext (..)
  , movedExePath
  , updateContextAndWriteProjectFile
  , withContextAndSelectors
  )
import Distribution.Client.Setup
  ( CommonSetupFlags (setupVerbosity)
  , ConfigFlags (..)
  , GlobalFlags (..)
  )
import Distribution.Client.TargetProblem
  ( TargetProblem (..)
  )
import Distribution.Client.Utils
  ( giveRTSWarning
  , occursOnlyOrBefore
  )

import Distribution.Simple.BuildToolDepends
  ( getAllInternalToolDependencies
  )
import Distribution.Simple.Command
  ( CommandUI (..)
  , usageAlternatives
  )
import Distribution.Simple.Flag
  ( fromFlagOrDefault
  )
import Distribution.Simple.Program.Find
  ( ProgramSearchPathEntry (ProgramSearchPathDir)
  , defaultProgramSearchPath
  , logExtraProgramSearchPath
  , programSearchPathAsPATHVar
  )
import Distribution.Simple.Program.Run
  ( ProgramInvocation (..)
  , emptyProgramInvocation
  , runProgramInvocation
  )
import Distribution.Simple.Utils
  ( dieWithException
  , info
  , notice
  , safeHead
  , warn
  , wrapText
  )

import Distribution.Types.ComponentName
  ( componentNameRaw
  )
import Distribution.Types.Executable as PD
  ( buildInfo
  , exeName
  )
import qualified Distribution.Types.PackageDescription as PD
  ( executables
  )
import Distribution.Types.UnitId
  ( UnitId
  )
import Distribution.Types.UnqualComponentName
  ( UnqualComponentName
  , unUnqualComponentName
  )
import Distribution.Utils.NubList
  ( fromNubList
  )
import Distribution.Verbosity
  ( normal
  , silent
  )
import GHC.Environment
  ( getFullArgs
  )
import System.Directory
  ( doesFileExist
  )
import System.FilePath
  ( isPathSeparator
  , isValid
  , (</>)
  )

runCommand :: CommandUI (NixStyleFlags ())
runCommand :: CommandUI (NixStyleFlags ())
runCommand =
  CommandUI
    { commandName :: [Char]
commandName = [Char]
"v2-run"
    , commandSynopsis :: [Char]
commandSynopsis = [Char]
"Run an executable."
    , commandUsage :: [Char] -> [Char]
commandUsage =
        [Char] -> [[Char]] -> [Char] -> [Char]
usageAlternatives
          [Char]
"v2-run"
          [[Char]
"[TARGET] [FLAGS] [-- EXECUTABLE_FLAGS]"]
    , commandDescription :: Maybe ([Char] -> [Char])
commandDescription = ([Char] -> [Char]) -> Maybe ([Char] -> [Char])
forall a. a -> Maybe a
Just (([Char] -> [Char]) -> Maybe ([Char] -> [Char]))
-> ([Char] -> [Char]) -> Maybe ([Char] -> [Char])
forall a b. (a -> b) -> a -> b
$ \[Char]
pname ->
        [Char] -> [Char]
wrapText ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$
          [Char]
"Runs the specified executable-like component (an executable, a test, "
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"or a benchmark), first ensuring it is up to date.\n\n"
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Any executable-like component in any package in the project can be "
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"specified. A package can be specified if contains just one "
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"executable-like, preferring a single executable. The default is to "
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"use the package in the current directory if it contains just one "
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"executable-like.\n\n"
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Extra arguments can be passed to the program, but use '--' to "
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"separate arguments for the program from arguments for "
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
pname
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
". The executable is run in an environment where it can find its "
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"data files inplace in the build tree.\n\n"
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Dependencies are built or rebuilt as necessary. Additional "
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"configuration flags can be specified on the command line and these "
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"extend the project configuration from the 'cabal.project', "
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'cabal.project.local' and other files."
    , commandNotes :: Maybe ([Char] -> [Char])
commandNotes = ([Char] -> [Char]) -> Maybe ([Char] -> [Char])
forall a. a -> Maybe a
Just (([Char] -> [Char]) -> Maybe ([Char] -> [Char]))
-> ([Char] -> [Char]) -> Maybe ([Char] -> [Char])
forall a b. (a -> b) -> a -> b
$ \[Char]
pname ->
        [Char]
"Examples:\n"
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"  "
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
pname
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" v2-run\n"
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"    Run the executable-like in the package in the current directory\n"
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"  "
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
pname
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" v2-run foo-tool\n"
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"    Run the named executable-like (in any package in the project)\n"
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"  "
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
pname
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" v2-run pkgfoo:foo-tool\n"
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"    Run the executable-like 'foo-tool' in the package 'pkgfoo'\n"
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"  "
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
pname
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" v2-run foo -O2 -- dothing --fooflag\n"
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"    Build with '-O2' and run the program, passing it extra arguments.\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 [])
    }

-- | The @run@ command runs a specified executable-like component, building it
-- first if necessary. The component can be either an executable, a test,
-- or a benchmark. This is particularly useful for passing arguments to
-- exes/tests/benchs by simply appending them after a @--@.
--
-- For more details on how this works, see the module
-- "Distribution.Client.ProjectOrchestration"
runAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO ()
runAction :: NixStyleFlags () -> [[Char]] -> GlobalFlags -> IO ()
runAction flags :: NixStyleFlags ()
flags@NixStyleFlags{()
TestFlags
HaddockFlags
ConfigFlags
BenchmarkFlags
ProjectFlags
InstallFlags
ConfigExFlags
configFlags :: ConfigFlags
configExFlags :: ConfigExFlags
installFlags :: InstallFlags
haddockFlags :: HaddockFlags
testFlags :: TestFlags
benchmarkFlags :: BenchmarkFlags
projectFlags :: ProjectFlags
extraFlags :: ()
configFlags :: forall a. NixStyleFlags a -> ConfigFlags
configExFlags :: forall a. NixStyleFlags a -> ConfigExFlags
installFlags :: forall a. NixStyleFlags a -> InstallFlags
haddockFlags :: forall a. NixStyleFlags a -> HaddockFlags
testFlags :: forall a. NixStyleFlags a -> TestFlags
benchmarkFlags :: forall a. NixStyleFlags a -> BenchmarkFlags
projectFlags :: forall a. NixStyleFlags a -> ProjectFlags
extraFlags :: forall a. NixStyleFlags a -> a
..} [[Char]]
targetAndArgs GlobalFlags
globalFlags =
  AcceptNoTargets
-> Maybe ComponentKind
-> NixStyleFlags ()
-> [[Char]]
-> GlobalFlags
-> CurrentCommand
-> (TargetContext
    -> ProjectBaseContext -> [TargetSelector] -> IO ())
-> IO ()
forall a b.
AcceptNoTargets
-> Maybe ComponentKind
-> NixStyleFlags a
-> [[Char]]
-> GlobalFlags
-> CurrentCommand
-> (TargetContext
    -> ProjectBaseContext -> [TargetSelector] -> IO b)
-> IO b
withContextAndSelectors AcceptNoTargets
RejectNoTargets (ComponentKind -> Maybe ComponentKind
forall a. a -> Maybe a
Just ComponentKind
ExeKind) NixStyleFlags ()
flags [[Char]]
targetStr GlobalFlags
globalFlags CurrentCommand
OtherCommand ((TargetContext -> ProjectBaseContext -> [TargetSelector] -> IO ())
 -> IO ())
-> (TargetContext
    -> ProjectBaseContext -> [TargetSelector] -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \TargetContext
targetCtx ProjectBaseContext
ctx [TargetSelector]
targetSelectors -> do
    (ProjectBaseContext
baseCtx, Verbosity
defaultVerbosity) <- case TargetContext
targetCtx of
      TargetContext
ProjectContext -> (ProjectBaseContext, Verbosity)
-> IO (ProjectBaseContext, Verbosity)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProjectBaseContext
ctx, Verbosity
normal)
      TargetContext
GlobalContext -> (ProjectBaseContext, Verbosity)
-> IO (ProjectBaseContext, Verbosity)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProjectBaseContext
ctx, Verbosity
normal)
      ScriptContext [Char]
path Executable
exemeta -> (,Verbosity
silent) (ProjectBaseContext -> (ProjectBaseContext, Verbosity))
-> IO ProjectBaseContext -> IO (ProjectBaseContext, Verbosity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProjectBaseContext -> [Char] -> Executable -> IO ProjectBaseContext
updateContextAndWriteProjectFile ProjectBaseContext
ctx [Char]
path Executable
exemeta

    let verbosity :: Verbosity
verbosity = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
defaultVerbosity (CommonSetupFlags -> Flag Verbosity
setupVerbosity (CommonSetupFlags -> Flag Verbosity)
-> CommonSetupFlags -> Flag Verbosity
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> CommonSetupFlags
configCommonFlags ConfigFlags
configFlags)

    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 -> CabalInstallException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalInstallException
NoSupportForRunCommand

        [[Char]]
fullArgs <- IO [[Char]]
getFullArgs
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([[Char]] -> [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> a -> a -> Bool
occursOnlyOrBefore [[Char]]
fullArgs [Char]
"+RTS" [Char]
"--") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          Verbosity -> [Char] -> IO ()
warn Verbosity
verbosity ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
            [Char] -> [Char]
giveRTSWarning [Char]
"run"

        -- Interpret the targets on the command line as build targets
        -- (as opposed to say repl or haddock targets).
        TargetsMap
targets <-
          ([RunTargetProblem] -> IO TargetsMap)
-> (TargetsMap -> IO TargetsMap)
-> Either [RunTargetProblem] TargetsMap
-> IO TargetsMap
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Verbosity -> [RunTargetProblem] -> IO TargetsMap
forall a. Verbosity -> [RunTargetProblem] -> IO a
reportTargetProblems Verbosity
verbosity) TargetsMap -> IO TargetsMap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [RunTargetProblem] TargetsMap -> IO TargetsMap)
-> Either [RunTargetProblem] TargetsMap -> IO TargetsMap
forall a b. (a -> b) -> a -> b
$
            (forall k.
 TargetSelector
 -> [AvailableTarget k] -> Either RunTargetProblem [k])
-> (forall k.
    SubComponentTarget
    -> AvailableTarget k -> Either RunTargetProblem k)
-> ElaboratedInstallPlan
-> Maybe SourcePackageDb
-> [TargetSelector]
-> Either [RunTargetProblem] 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
              TargetSelector
-> [AvailableTarget k] -> Either RunTargetProblem [k]
forall k.
TargetSelector
-> [AvailableTarget k] -> Either RunTargetProblem [k]
selectPackageTargets
              SubComponentTarget
-> AvailableTarget k -> Either RunTargetProblem k
forall k.
SubComponentTarget
-> AvailableTarget k -> Either RunTargetProblem k
selectComponentTarget
              ElaboratedInstallPlan
elaboratedPlan
              Maybe SourcePackageDb
forall a. Maybe a
Nothing
              [TargetSelector]
targetSelectors

        -- Reject multiple targets, or at least targets in different
        -- components. It is ok to have two module/file targets in the
        -- same component, but not two that live in different components.
        --
        -- Note that we discard the target and return the whole 'TargetsMap',
        -- so this check will be repeated (and must succeed) after
        -- the 'runProjectPreBuildPhase'. Keep it in mind when modifying this.
        (UnitId, UnqualComponentName)
_ <-
          IO (UnitId, UnqualComponentName)
-> TargetsMap -> IO (UnitId, UnqualComponentName)
singleExeOrElse
            ( Verbosity -> [RunTargetProblem] -> IO (UnitId, UnqualComponentName)
forall a. Verbosity -> [RunTargetProblem] -> IO a
reportTargetProblems
                Verbosity
verbosity
                [TargetsMap -> RunTargetProblem
multipleTargetsProblem TargetsMap
targets]
            )
            TargetsMap
targets

        let elaboratedPlan' :: ElaboratedInstallPlan
elaboratedPlan' =
              TargetAction
-> TargetsMap -> ElaboratedInstallPlan -> ElaboratedInstallPlan
pruneInstallPlanToTargets
                TargetAction
TargetActionBuild
                TargetsMap
targets
                ElaboratedInstallPlan
elaboratedPlan
        (ElaboratedInstallPlan, TargetsMap)
-> IO (ElaboratedInstallPlan, TargetsMap)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ElaboratedInstallPlan
elaboratedPlan', TargetsMap
targets)

    (UnitId
selectedUnitId, UnqualComponentName
selectedComponent) <-
      -- Slight duplication with 'runProjectPreBuildPhase'.
      IO (UnitId, UnqualComponentName)
-> TargetsMap -> IO (UnitId, UnqualComponentName)
singleExeOrElse
        ( Verbosity
-> CabalInstallException -> IO (UnitId, UnqualComponentName)
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalInstallException
RunPhaseReached
        )
        (TargetsMap -> IO (UnitId, UnqualComponentName))
-> TargetsMap -> IO (UnitId, UnqualComponentName)
forall a b. (a -> b) -> a -> b
$ ProjectBuildContext -> TargetsMap
targetsMap ProjectBuildContext
buildCtx

    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

    let elaboratedPlan :: ElaboratedInstallPlan
elaboratedPlan = ProjectBuildContext -> ElaboratedInstallPlan
elaboratedPlanToExecute ProjectBuildContext
buildCtx
        matchingElaboratedConfiguredPackages :: [ElaboratedConfiguredPackage]
matchingElaboratedConfiguredPackages =
          UnitId -> ElaboratedInstallPlan -> [ElaboratedConfiguredPackage]
matchingPackagesByUnitId
            UnitId
selectedUnitId
            ElaboratedInstallPlan
elaboratedPlan

    let exeName :: [Char]
exeName = UnqualComponentName -> [Char]
unUnqualComponentName UnqualComponentName
selectedComponent

    -- In the common case, we expect @matchingElaboratedConfiguredPackages@
    -- to consist of a single element that provides a single way of building
    -- an appropriately-named executable. In that case we take that
    -- package and continue.
    --
    -- However, multiple packages/components could provide that
    -- executable, or it's possible we don't find the executable anywhere
    -- in the build plan. I suppose in principle it's also possible that
    -- a single package provides an executable in two different ways,
    -- though that's probably a bug if. Anyway it's a good lint to report
    -- an error in all of these cases, even if some seem like they
    -- shouldn't happen.
    ElaboratedConfiguredPackage
pkg <- case [ElaboratedConfiguredPackage]
matchingElaboratedConfiguredPackages of
      [] -> Verbosity
-> CabalInstallException -> IO ElaboratedConfiguredPackage
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> IO ElaboratedConfiguredPackage)
-> CabalInstallException -> IO ElaboratedConfiguredPackage
forall a b. (a -> b) -> a -> b
$ [Char] -> UnitId -> CabalInstallException
UnknownExecutable [Char]
exeName UnitId
selectedUnitId
      [ElaboratedConfiguredPackage
elabPkg] -> do
        Verbosity -> [Char] -> IO ()
info Verbosity
verbosity ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
          [Char]
"Selecting "
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UnitId -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow UnitId
selectedUnitId
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" to supply "
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
exeName
        ElaboratedConfiguredPackage -> IO ElaboratedConfiguredPackage
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ElaboratedConfiguredPackage
elabPkg
      [ElaboratedConfiguredPackage]
elabPkgs ->
        Verbosity
-> CabalInstallException -> IO ElaboratedConfiguredPackage
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> IO ElaboratedConfiguredPackage)
-> CabalInstallException -> IO ElaboratedConfiguredPackage
forall a b. (a -> b) -> a -> b
$
          [Char] -> [[Char]] -> CabalInstallException
MultipleMatchingExecutables [Char]
exeName ((ElaboratedConfiguredPackage -> [Char])
-> [ElaboratedConfiguredPackage] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ElaboratedConfiguredPackage
p -> [Char]
" - in package " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UnitId -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow (ElaboratedConfiguredPackage -> UnitId
elabUnitId ElaboratedConfiguredPackage
p)) [ElaboratedConfiguredPackage]
elabPkgs)

    let defaultExePath :: [Char]
defaultExePath =
          DistDirLayout
-> ElaboratedSharedConfig
-> ElaboratedConfiguredPackage
-> [Char]
-> [Char]
binDirectoryFor
            (ProjectBaseContext -> DistDirLayout
distDirLayout ProjectBaseContext
baseCtx)
            (ProjectBuildContext -> ElaboratedSharedConfig
elaboratedShared ProjectBuildContext
buildCtx)
            ElaboratedConfiguredPackage
pkg
            [Char]
exeName
            [Char] -> [Char] -> [Char]
</> [Char]
exeName
        exePath :: [Char]
exePath = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
defaultExePath (UnqualComponentName
-> DistDirLayout
-> ElaboratedSharedConfig
-> ElaboratedConfiguredPackage
-> Maybe [Char]
movedExePath UnqualComponentName
selectedComponent (ProjectBaseContext -> DistDirLayout
distDirLayout ProjectBaseContext
baseCtx) (ProjectBuildContext -> ElaboratedSharedConfig
elaboratedShared ProjectBuildContext
buildCtx) ElaboratedConfiguredPackage
pkg)

    let dryRun :: Bool
dryRun =
          BuildTimeSettings -> Bool
buildSettingDryRun (ProjectBaseContext -> BuildTimeSettings
buildSettings ProjectBaseContext
baseCtx)
            Bool -> Bool -> Bool
|| BuildTimeSettings -> Bool
buildSettingOnlyDownload (ProjectBaseContext -> BuildTimeSettings
buildSettings ProjectBaseContext
baseCtx)

    let
      -- HACK alert: when doing a per-package build (e.g. with a Custom setup),
      -- 'elabExeDependencyPaths' will not contain any internal executables
      -- (they are deliberately filtered out; and even if they weren't, they have the wrong paths).
      -- We add them back in here to ensure that any "build-tool-depends" of
      -- the current executable is available in PATH at runtime.
      internalToolDepsOfThisExe :: [[Char]]
internalToolDepsOfThisExe
        | ElabPackage{} <- ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
pkg
        , let pkg_descr :: PackageDescription
pkg_descr = ElaboratedConfiguredPackage -> PackageDescription
elabPkgDescription ElaboratedConfiguredPackage
pkg
        , Executable
thisExe : [Executable]
_ <- (Executable -> Bool) -> [Executable] -> [Executable]
forall a. (a -> Bool) -> [a] -> [a]
filter (([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
exeName) ([Char] -> Bool) -> (Executable -> [Char]) -> Executable -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> [Char]
unUnqualComponentName (UnqualComponentName -> [Char])
-> (Executable -> UnqualComponentName) -> Executable -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> UnqualComponentName
PD.exeName) ([Executable] -> [Executable]) -> [Executable] -> [Executable]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Executable]
PD.executables PackageDescription
pkg_descr
        , let thisExeBI :: BuildInfo
thisExeBI = Executable -> BuildInfo
PD.buildInfo Executable
thisExe =
            [ DistDirLayout
-> ElaboratedSharedConfig
-> ElaboratedConfiguredPackage
-> [Char]
-> [Char]
binDirectoryFor (ProjectBaseContext -> DistDirLayout
distDirLayout ProjectBaseContext
baseCtx) (ProjectBuildContext -> ElaboratedSharedConfig
elaboratedShared ProjectBuildContext
buildCtx) ElaboratedConfiguredPackage
pkg [Char]
depExeNm
            | UnqualComponentName
depExe <- PackageDescription -> BuildInfo -> [UnqualComponentName]
getAllInternalToolDependencies PackageDescription
pkg_descr BuildInfo
thisExeBI
            , let depExeNm :: [Char]
depExeNm = UnqualComponentName -> [Char]
unUnqualComponentName UnqualComponentName
depExe
            ]
        | Bool
otherwise =
            []
      extraPath :: [[Char]]
extraPath =
        ElaboratedConfiguredPackage -> [[Char]]
elabExeDependencyPaths ElaboratedConfiguredPackage
pkg
          [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ ( NubList [Char] -> [[Char]]
forall a. NubList a -> [a]
fromNubList
                (NubList [Char] -> [[Char]])
-> (ProjectBaseContext -> NubList [Char])
-> ProjectBaseContext
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectConfigShared -> NubList [Char]
projectConfigProgPathExtra
                (ProjectConfigShared -> NubList [Char])
-> (ProjectBaseContext -> ProjectConfigShared)
-> ProjectBaseContext
-> NubList [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectConfig -> ProjectConfigShared
projectConfigShared
                (ProjectConfig -> ProjectConfigShared)
-> (ProjectBaseContext -> ProjectConfig)
-> ProjectBaseContext
-> ProjectConfigShared
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectBaseContext -> ProjectConfig
projectConfig
                (ProjectBaseContext -> [[Char]]) -> ProjectBaseContext -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ProjectBaseContext
baseCtx
             )
          [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
internalToolDepsOfThisExe

    Verbosity -> [[Char]] -> IO ()
logExtraProgramSearchPath Verbosity
verbosity [[Char]]
extraPath
    [Char]
progPath <- ProgramSearchPath -> IO [Char]
programSearchPathAsPATHVar (([Char] -> ProgramSearchPathEntry) -> [[Char]] -> ProgramSearchPath
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> ProgramSearchPathEntry
ProgramSearchPathDir [[Char]]
extraPath ProgramSearchPath -> ProgramSearchPath -> ProgramSearchPath
forall a. [a] -> [a] -> [a]
++ ProgramSearchPath
defaultProgramSearchPath)

    if Bool
dryRun
      then Verbosity -> [Char] -> IO ()
notice Verbosity
verbosity [Char]
"Running of executable suppressed by flag(s)"
      else
        Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation
          Verbosity
verbosity
          ProgramInvocation
emptyProgramInvocation
            { progInvokePath = exePath
            , progInvokeArgs = args
            , progInvokeEnv =
                ("PATH", Just $ progPath)
                  : dataDirsEnvironmentForPlan
                    (distDirLayout baseCtx)
                    elaboratedPlan
            }
  where
    ([[Char]]
targetStr, [[Char]]
args) = Int -> [[Char]] -> ([[Char]], [[Char]])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 [[Char]]
targetAndArgs

-- | Used by the main CLI parser as heuristic to decide whether @cabal@ was
-- invoked as a script interpreter, i.e. via
--
-- > #! /usr/bin/env cabal
--
-- or
--
-- > #! /usr/bin/cabal
--
-- As the first argument passed to `cabal` will be a filepath to the
-- script to be interpreted.
--
-- See also 'handleShebang'
validScript :: String -> IO Bool
validScript :: [Char] -> IO Bool
validScript [Char]
script
  | [Char] -> Bool
isValid [Char]
script Bool -> Bool -> Bool
&& (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isPathSeparator [Char]
script = [Char] -> IO Bool
doesFileExist [Char]
script
  | Bool
otherwise = Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Handle @cabal@ invoked as script interpreter, see also 'validScript'
--
-- First argument is the 'FilePath' to the script to be executed; second
-- argument is a list of arguments to be passed to the script.
handleShebang :: FilePath -> [String] -> IO ()
handleShebang :: [Char] -> [[Char]] -> IO ()
handleShebang [Char]
script [[Char]]
args =
  NixStyleFlags () -> [[Char]] -> GlobalFlags -> IO ()
runAction (CommandUI (NixStyleFlags ()) -> NixStyleFlags ()
forall flags. CommandUI flags -> flags
commandDefaultFlags CommandUI (NixStyleFlags ())
runCommand) ([Char]
script [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
args) GlobalFlags
defaultGlobalFlags

singleExeOrElse :: IO (UnitId, UnqualComponentName) -> TargetsMap -> IO (UnitId, UnqualComponentName)
singleExeOrElse :: IO (UnitId, UnqualComponentName)
-> TargetsMap -> IO (UnitId, UnqualComponentName)
singleExeOrElse IO (UnitId, UnqualComponentName)
action TargetsMap
targetsMap =
  case Set (UnitId, ComponentName) -> [(UnitId, ComponentName)]
forall a. Set a -> [a]
Set.toList (Set (UnitId, ComponentName) -> [(UnitId, ComponentName)])
-> (TargetsMap -> Set (UnitId, ComponentName))
-> TargetsMap
-> [(UnitId, ComponentName)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TargetsMap -> Set (UnitId, ComponentName)
distinctTargetComponents (TargetsMap -> [(UnitId, ComponentName)])
-> TargetsMap -> [(UnitId, ComponentName)]
forall a b. (a -> b) -> a -> b
$ TargetsMap
targetsMap of
    [(UnitId
unitId, CExeName UnqualComponentName
component)] -> (UnitId, UnqualComponentName) -> IO (UnitId, UnqualComponentName)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UnitId
unitId, UnqualComponentName
component)
    [(UnitId
unitId, CTestName UnqualComponentName
component)] -> (UnitId, UnqualComponentName) -> IO (UnitId, UnqualComponentName)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UnitId
unitId, UnqualComponentName
component)
    [(UnitId
unitId, CBenchName UnqualComponentName
component)] -> (UnitId, UnqualComponentName) -> IO (UnitId, UnqualComponentName)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UnitId
unitId, UnqualComponentName
component)
    [(UnitId, ComponentName)]
_ -> IO (UnitId, UnqualComponentName)
action

-- | Filter the 'ElaboratedInstallPlan' keeping only the
-- 'ElaboratedConfiguredPackage's that match the specified
-- 'UnitId'.
matchingPackagesByUnitId
  :: UnitId
  -> ElaboratedInstallPlan
  -> [ElaboratedConfiguredPackage]
matchingPackagesByUnitId :: UnitId -> ElaboratedInstallPlan -> [ElaboratedConfiguredPackage]
matchingPackagesByUnitId UnitId
uid =
  [Maybe ElaboratedConfiguredPackage]
-> [ElaboratedConfiguredPackage]
forall a. [Maybe a] -> [a]
catMaybes
    ([Maybe ElaboratedConfiguredPackage]
 -> [ElaboratedConfiguredPackage])
-> (ElaboratedInstallPlan -> [Maybe ElaboratedConfiguredPackage])
-> ElaboratedInstallPlan
-> [ElaboratedConfiguredPackage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenericPlanPackage
   InstalledPackageInfo ElaboratedConfiguredPackage
 -> Maybe ElaboratedConfiguredPackage)
-> [GenericPlanPackage
      InstalledPackageInfo ElaboratedConfiguredPackage]
-> [Maybe ElaboratedConfiguredPackage]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      ( (InstalledPackageInfo -> Maybe ElaboratedConfiguredPackage)
-> (ElaboratedConfiguredPackage
    -> Maybe ElaboratedConfiguredPackage)
-> GenericPlanPackage
     InstalledPackageInfo ElaboratedConfiguredPackage
-> Maybe ElaboratedConfiguredPackage
forall ipkg a srcpkg.
(ipkg -> a) -> (srcpkg -> a) -> GenericPlanPackage ipkg srcpkg -> a
foldPlanPackage
          (Maybe ElaboratedConfiguredPackage
-> InstalledPackageInfo -> Maybe ElaboratedConfiguredPackage
forall a b. a -> b -> a
const Maybe ElaboratedConfiguredPackage
forall a. Maybe a
Nothing)
          ( \ElaboratedConfiguredPackage
x ->
              if ElaboratedConfiguredPackage -> UnitId
elabUnitId ElaboratedConfiguredPackage
x UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
== UnitId
uid
                then ElaboratedConfiguredPackage -> Maybe ElaboratedConfiguredPackage
forall a. a -> Maybe a
Just ElaboratedConfiguredPackage
x
                else Maybe ElaboratedConfiguredPackage
forall a. Maybe a
Nothing
          )
      )
    ([GenericPlanPackage
    InstalledPackageInfo ElaboratedConfiguredPackage]
 -> [Maybe ElaboratedConfiguredPackage])
-> (ElaboratedInstallPlan
    -> [GenericPlanPackage
          InstalledPackageInfo ElaboratedConfiguredPackage])
-> ElaboratedInstallPlan
-> [Maybe ElaboratedConfiguredPackage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedInstallPlan
-> [GenericPlanPackage
      InstalledPackageInfo ElaboratedConfiguredPackage]
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
toList

-- | This defines what a 'TargetSelector' means for the @run@ command.
-- It selects the 'AvailableTarget's that the 'TargetSelector' refers to,
-- or otherwise classifies the problem.
--
-- For the @run@ command we select the exe if there is only one and it's
-- buildable. Fail if there are no or multiple buildable exe components.
selectPackageTargets
  :: TargetSelector
  -> [AvailableTarget k]
  -> Either RunTargetProblem [k]
selectPackageTargets :: forall k.
TargetSelector
-> [AvailableTarget k] -> Either RunTargetProblem [k]
selectPackageTargets TargetSelector
targetSelector [AvailableTarget k]
targets
  -- If there is a single executable component, select that. See #7403
  | [k
target] <- [k]
targetsExesBuildable =
      [k] -> Either RunTargetProblem [k]
forall a b. b -> Either a b
Right [k
target]
  -- Otherwise, if there is a single executable-like component left, select that.
  | [k
target] <- [k]
targetsExeLikesBuildable =
      [k] -> Either RunTargetProblem [k]
forall a b. b -> Either a b
Right [k
target]
  -- but fail if there are multiple buildable executables.
  | Bool -> Bool
not ([k] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [k]
targetsExeLikesBuildable) =
      RunTargetProblem -> Either RunTargetProblem [k]
forall a b. a -> Either a b
Left (TargetSelector -> [AvailableTarget ()] -> RunTargetProblem
matchesMultipleProblem TargetSelector
targetSelector [AvailableTarget ()]
targetsExeLikesBuildable')
  -- If there are executables but none are buildable then we report those
  | Bool -> Bool
not ([AvailableTarget ()] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AvailableTarget ()]
targetsExeLikes') =
      RunTargetProblem -> Either RunTargetProblem [k]
forall a b. a -> Either a b
Left (TargetSelector -> [AvailableTarget ()] -> RunTargetProblem
forall a. TargetSelector -> [AvailableTarget ()] -> TargetProblem a
TargetProblemNoneEnabled TargetSelector
targetSelector [AvailableTarget ()]
targetsExeLikes')
  -- If there are no executables but some other targets then we report that
  | Bool -> Bool
not ([AvailableTarget k] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AvailableTarget k]
targets) =
      RunTargetProblem -> Either RunTargetProblem [k]
forall a b. a -> Either a b
Left (TargetSelector -> RunTargetProblem
noExesProblem TargetSelector
targetSelector)
  -- If there are no targets at all then we report that
  | Bool
otherwise =
      RunTargetProblem -> Either RunTargetProblem [k]
forall a b. a -> Either a b
Left (TargetSelector -> RunTargetProblem
forall a. TargetSelector -> TargetProblem a
TargetProblemNoTargets TargetSelector
targetSelector)
  where
    -- Targets that are precisely executables
    targetsExes :: [AvailableTarget k]
targetsExes = ComponentKind -> [AvailableTarget k] -> [AvailableTarget k]
forall k.
ComponentKind -> [AvailableTarget k] -> [AvailableTarget k]
filterTargetsKind ComponentKind
ExeKind [AvailableTarget k]
targets
    targetsExesBuildable :: [k]
targetsExesBuildable = [AvailableTarget k] -> [k]
forall k. [AvailableTarget k] -> [k]
selectBuildableTargets [AvailableTarget k]
targetsExes

    -- Any target that could be executed
    targetsExeLikes :: [AvailableTarget k]
targetsExeLikes =
      [AvailableTarget k]
targetsExes
        [AvailableTarget k] -> [AvailableTarget k] -> [AvailableTarget k]
forall a. [a] -> [a] -> [a]
++ ComponentKind -> [AvailableTarget k] -> [AvailableTarget k]
forall k.
ComponentKind -> [AvailableTarget k] -> [AvailableTarget k]
filterTargetsKind ComponentKind
TestKind [AvailableTarget k]
targets
        [AvailableTarget k] -> [AvailableTarget k] -> [AvailableTarget k]
forall a. [a] -> [a] -> [a]
++ ComponentKind -> [AvailableTarget k] -> [AvailableTarget k]
forall k.
ComponentKind -> [AvailableTarget k] -> [AvailableTarget k]
filterTargetsKind ComponentKind
BenchKind [AvailableTarget k]
targets

    ( [k]
targetsExeLikesBuildable
      , [AvailableTarget ()]
targetsExeLikesBuildable'
      ) = [AvailableTarget k] -> ([k], [AvailableTarget ()])
forall k. [AvailableTarget k] -> ([k], [AvailableTarget ()])
selectBuildableTargets' [AvailableTarget k]
targetsExeLikes

    targetsExeLikes' :: [AvailableTarget ()]
targetsExeLikes' = [AvailableTarget k] -> [AvailableTarget ()]
forall k. [AvailableTarget k] -> [AvailableTarget ()]
forgetTargetsDetail [AvailableTarget k]
targetsExeLikes

-- | For a 'TargetComponent' 'TargetSelector', check if the component can be
-- selected.
--
-- For the @run@ command we just need to check it is a executable-like
-- (an executable, a test, or a benchmark), in addition
-- to the basic checks on being buildable etc.
selectComponentTarget
  :: SubComponentTarget
  -> AvailableTarget k
  -> Either RunTargetProblem k
selectComponentTarget :: forall k.
SubComponentTarget
-> AvailableTarget k -> Either RunTargetProblem k
selectComponentTarget subtarget :: SubComponentTarget
subtarget@SubComponentTarget
WholeComponent AvailableTarget k
t =
  case AvailableTarget k -> ComponentName
forall k. AvailableTarget k -> ComponentName
availableTargetComponentName AvailableTarget k
t of
    CExeName UnqualComponentName
_ -> Either RunTargetProblem k
forall {a}. Either (TargetProblem a) k
component
    CTestName UnqualComponentName
_ -> Either RunTargetProblem k
forall {a}. Either (TargetProblem a) k
component
    CBenchName UnqualComponentName
_ -> Either RunTargetProblem k
forall {a}. Either (TargetProblem a) k
component
    ComponentName
_ -> RunTargetProblem -> Either RunTargetProblem k
forall a b. a -> Either a b
Left (PackageId -> ComponentName -> RunTargetProblem
componentNotExeProblem PackageId
pkgid ComponentName
cname)
  where
    pkgid :: PackageId
pkgid = AvailableTarget k -> PackageId
forall k. AvailableTarget k -> PackageId
availableTargetPackageId AvailableTarget k
t
    cname :: ComponentName
cname = AvailableTarget k -> ComponentName
forall k. AvailableTarget k -> ComponentName
availableTargetComponentName AvailableTarget k
t
    component :: Either (TargetProblem a) k
component = SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem a) k
forall k a.
SubComponentTarget
-> AvailableTarget k -> Either (TargetProblem a) k
selectComponentTargetBasic SubComponentTarget
subtarget AvailableTarget k
t
selectComponentTarget SubComponentTarget
subtarget AvailableTarget k
t =
  RunTargetProblem -> Either RunTargetProblem k
forall a b. a -> Either a b
Left
    ( PackageId
-> ComponentName -> SubComponentTarget -> RunTargetProblem
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
    )

-- | The various error conditions that can occur when matching a
-- 'TargetSelector' against 'AvailableTarget's for the @run@ command.
data RunProblem
  = -- | The 'TargetSelector' matches targets but no executables
    TargetProblemNoExes TargetSelector
  | -- | A single 'TargetSelector' matches multiple targets
    TargetProblemMatchesMultiple TargetSelector [AvailableTarget ()]
  | -- | Multiple 'TargetSelector's match multiple targets
    TargetProblemMultipleTargets TargetsMap
  | -- | The 'TargetSelector' refers to a component that is not an executable
    TargetProblemComponentNotExe PackageId ComponentName
  | -- | Asking to run an individual file or module is not supported
    TargetProblemIsSubComponent PackageId ComponentName SubComponentTarget
  deriving (RunProblem -> RunProblem -> Bool
(RunProblem -> RunProblem -> Bool)
-> (RunProblem -> RunProblem -> Bool) -> Eq RunProblem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunProblem -> RunProblem -> Bool
== :: RunProblem -> RunProblem -> Bool
$c/= :: RunProblem -> RunProblem -> Bool
/= :: RunProblem -> RunProblem -> Bool
Eq, Int -> RunProblem -> [Char] -> [Char]
[RunProblem] -> [Char] -> [Char]
RunProblem -> [Char]
(Int -> RunProblem -> [Char] -> [Char])
-> (RunProblem -> [Char])
-> ([RunProblem] -> [Char] -> [Char])
-> Show RunProblem
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> RunProblem -> [Char] -> [Char]
showsPrec :: Int -> RunProblem -> [Char] -> [Char]
$cshow :: RunProblem -> [Char]
show :: RunProblem -> [Char]
$cshowList :: [RunProblem] -> [Char] -> [Char]
showList :: [RunProblem] -> [Char] -> [Char]
Show)

type RunTargetProblem = TargetProblem RunProblem

noExesProblem :: TargetSelector -> RunTargetProblem
noExesProblem :: TargetSelector -> RunTargetProblem
noExesProblem = RunProblem -> RunTargetProblem
forall a. a -> TargetProblem a
CustomTargetProblem (RunProblem -> RunTargetProblem)
-> (TargetSelector -> RunProblem)
-> TargetSelector
-> RunTargetProblem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TargetSelector -> RunProblem
TargetProblemNoExes

matchesMultipleProblem :: TargetSelector -> [AvailableTarget ()] -> RunTargetProblem
matchesMultipleProblem :: TargetSelector -> [AvailableTarget ()] -> RunTargetProblem
matchesMultipleProblem TargetSelector
selector [AvailableTarget ()]
targets =
  RunProblem -> RunTargetProblem
forall a. a -> TargetProblem a
CustomTargetProblem (RunProblem -> RunTargetProblem) -> RunProblem -> RunTargetProblem
forall a b. (a -> b) -> a -> b
$
    TargetSelector -> [AvailableTarget ()] -> RunProblem
TargetProblemMatchesMultiple TargetSelector
selector [AvailableTarget ()]
targets

multipleTargetsProblem :: TargetsMap -> TargetProblem RunProblem
multipleTargetsProblem :: TargetsMap -> RunTargetProblem
multipleTargetsProblem = RunProblem -> RunTargetProblem
forall a. a -> TargetProblem a
CustomTargetProblem (RunProblem -> RunTargetProblem)
-> (TargetsMap -> RunProblem) -> TargetsMap -> RunTargetProblem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TargetsMap -> RunProblem
TargetProblemMultipleTargets

componentNotExeProblem :: PackageId -> ComponentName -> TargetProblem RunProblem
componentNotExeProblem :: PackageId -> ComponentName -> RunTargetProblem
componentNotExeProblem PackageId
pkgid ComponentName
name =
  RunProblem -> RunTargetProblem
forall a. a -> TargetProblem a
CustomTargetProblem (RunProblem -> RunTargetProblem) -> RunProblem -> RunTargetProblem
forall a b. (a -> b) -> a -> b
$
    PackageId -> ComponentName -> RunProblem
TargetProblemComponentNotExe PackageId
pkgid ComponentName
name

isSubComponentProblem
  :: PackageId
  -> ComponentName
  -> SubComponentTarget
  -> TargetProblem RunProblem
isSubComponentProblem :: PackageId
-> ComponentName -> SubComponentTarget -> RunTargetProblem
isSubComponentProblem PackageId
pkgid ComponentName
name SubComponentTarget
subcomponent =
  RunProblem -> RunTargetProblem
forall a. a -> TargetProblem a
CustomTargetProblem (RunProblem -> RunTargetProblem) -> RunProblem -> RunTargetProblem
forall a b. (a -> b) -> a -> b
$
    PackageId -> ComponentName -> SubComponentTarget -> RunProblem
TargetProblemIsSubComponent PackageId
pkgid ComponentName
name SubComponentTarget
subcomponent

reportTargetProblems :: Verbosity -> [RunTargetProblem] -> IO a
reportTargetProblems :: forall a. Verbosity -> [RunTargetProblem] -> IO a
reportTargetProblems Verbosity
verbosity =
  Verbosity -> CabalInstallException -> IO a
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalInstallException -> IO a)
-> ([RunTargetProblem] -> CabalInstallException)
-> [RunTargetProblem]
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> CabalInstallException
CmdRunReportTargetProblems ([Char] -> CabalInstallException)
-> ([RunTargetProblem] -> [Char])
-> [RunTargetProblem]
-> CabalInstallException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
unlines ([[Char]] -> [Char])
-> ([RunTargetProblem] -> [[Char]]) -> [RunTargetProblem] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RunTargetProblem -> [Char]) -> [RunTargetProblem] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map RunTargetProblem -> [Char]
renderRunTargetProblem

renderRunTargetProblem :: RunTargetProblem -> String
renderRunTargetProblem :: RunTargetProblem -> [Char]
renderRunTargetProblem (TargetProblemNoTargets TargetSelector
targetSelector) =
  case TargetSelector -> Maybe ComponentKind
targetSelectorFilter TargetSelector
targetSelector of
    Just ComponentKind
kind
      | ComponentKind
kind ComponentKind -> ComponentKind -> Bool
forall a. Eq a => a -> a -> Bool
/= ComponentKind
ExeKind ->
          [Char]
"The run command is for running executables, but the target '"
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
showTargetSelector TargetSelector
targetSelector
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' refers to "
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
renderTargetSelector TargetSelector
targetSelector
            [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"."
    Maybe ComponentKind
_ -> [Char] -> TargetSelector -> [Char]
renderTargetProblemNoTargets [Char]
"run" TargetSelector
targetSelector
renderRunTargetProblem RunTargetProblem
problem =
  [Char] -> (RunProblem -> [Char]) -> RunTargetProblem -> [Char]
forall a. [Char] -> (a -> [Char]) -> TargetProblem a -> [Char]
renderTargetProblem [Char]
"run" RunProblem -> [Char]
renderRunProblem RunTargetProblem
problem

renderRunProblem :: RunProblem -> String
renderRunProblem :: RunProblem -> [Char]
renderRunProblem (TargetProblemMatchesMultiple TargetSelector
targetSelector [AvailableTarget ()]
targets) =
  [Char]
"The run command is for running a single executable at once. The target '"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
showTargetSelector TargetSelector
targetSelector
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' refers to "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
renderTargetSelector TargetSelector
targetSelector
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" which includes \n"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unlines
      ( (\([Char]
label, [[Char]]
xs) -> [Char]
"- " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
label [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
renderListPretty [[Char]]
xs)
          (([Char], [[Char]]) -> [Char]) -> [([Char], [[Char]])] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]] -> [[[Char]]] -> [([Char], [[Char]])]
forall a b. [a] -> [b] -> [(a, b)]
zip
            [[Char]
"executables", [Char]
"test-suites", [Char]
"benchmarks"]
            ( ([[Char]] -> Bool) -> [[[Char]]] -> [[[Char]]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([[Char]] -> Bool) -> [[Char]] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[[Char]]] -> [[[Char]]])
-> ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[Char]] -> [[Char]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map [[Char]] -> [[Char]]
removeDuplicates ([[[Char]]] -> [[[Char]]]) -> [[[Char]]] -> [[[Char]]]
forall a b. (a -> b) -> a -> b
$
                (AvailableTarget () -> [Char]) -> [AvailableTarget ()] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (ComponentName -> [Char]
componentNameRaw (ComponentName -> [Char])
-> (AvailableTarget () -> ComponentName)
-> AvailableTarget ()
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AvailableTarget () -> ComponentName
forall k. AvailableTarget k -> ComponentName
availableTargetComponentName)
                  ([AvailableTarget ()] -> [[Char]])
-> (ComponentKind -> [AvailableTarget ()])
-> ComponentKind
-> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ComponentKind -> [AvailableTarget ()] -> [AvailableTarget ()])
-> [AvailableTarget ()] -> ComponentKind -> [AvailableTarget ()]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ComponentKind -> [AvailableTarget ()] -> [AvailableTarget ()]
forall k.
ComponentKind -> [AvailableTarget k] -> [AvailableTarget k]
filterTargetsKind ([AvailableTarget ()] -> ComponentKind -> [AvailableTarget ()])
-> [AvailableTarget ()] -> ComponentKind -> [AvailableTarget ()]
forall a b. (a -> b) -> a -> b
$ [AvailableTarget ()]
targets)
                  (ComponentKind -> [[Char]]) -> [ComponentKind] -> [[[Char]]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ComponentKind
ExeKind, ComponentKind
TestKind, ComponentKind
BenchKind]
            )
      )
  where
    removeDuplicates :: [[Char]] -> [[Char]]
removeDuplicates = [Maybe [Char]] -> [[Char]]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe [Char]] -> [[Char]])
-> ([[Char]] -> [Maybe [Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[Char]] -> Maybe [Char]) -> [[[Char]]] -> [Maybe [Char]]
forall a b. (a -> b) -> [a] -> [b]
map [[Char]] -> Maybe [Char]
forall a. [a] -> Maybe a
safeHead ([[[Char]]] -> [Maybe [Char]])
-> ([[Char]] -> [[[Char]]]) -> [[Char]] -> [Maybe [Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[[Char]]]
forall a. Eq a => [a] -> [[a]]
group ([[Char]] -> [[[Char]]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
sort
renderRunProblem (TargetProblemMultipleTargets TargetsMap
selectorMap) =
  [Char]
"The run command is for running a single executable at once. The targets "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
renderListCommaAnd
      [ [Char]
"'" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
showTargetSelector TargetSelector
ts [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'"
      | TargetSelector
ts <- TargetsMap -> [TargetSelector]
uniqueTargetSelectors TargetsMap
selectorMap
      ]
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" refer to different executables."
renderRunProblem (TargetProblemComponentNotExe PackageId
pkgid ComponentName
cname) =
  [Char]
"The run command is for running executables, but the target '"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
showTargetSelector TargetSelector
targetSelector
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' refers to "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
renderTargetSelector TargetSelector
targetSelector
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" from the package "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PackageId -> [Char]
forall a. Pretty a => a -> [Char]
prettyShow PackageId
pkgid
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"."
  where
    targetSelector :: TargetSelector
targetSelector = PackageId -> ComponentName -> SubComponentTarget -> TargetSelector
TargetComponent PackageId
pkgid ComponentName
cname SubComponentTarget
WholeComponent
renderRunProblem (TargetProblemIsSubComponent PackageId
pkgid ComponentName
cname SubComponentTarget
subtarget) =
  [Char]
"The run command can only run an executable as a whole, "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"not files or modules within them, but the target '"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
showTargetSelector TargetSelector
targetSelector
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' refers to "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
renderTargetSelector TargetSelector
targetSelector
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"."
  where
    targetSelector :: TargetSelector
targetSelector = PackageId -> ComponentName -> SubComponentTarget -> TargetSelector
TargetComponent PackageId
pkgid ComponentName
cname SubComponentTarget
subtarget
renderRunProblem (TargetProblemNoExes TargetSelector
targetSelector) =
  [Char]
"Cannot run the target '"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
showTargetSelector TargetSelector
targetSelector
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' which refers to "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TargetSelector -> [Char]
renderTargetSelector TargetSelector
targetSelector
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" because "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Plural -> [Char] -> [Char] -> [Char]
forall a. Plural -> a -> a -> a
plural (TargetSelector -> Plural
targetSelectorPluralPkgs TargetSelector
targetSelector) [Char]
"it does" [Char]
"they do"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not contain any executables."