{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ViewPatterns #-} -- | cabal-install CLI command: run -- module Distribution.Client.CmdRun ( -- * The @run@ CLI and action runCommand, runAction, -- * Internals exposed for testing TargetProblem(..), selectPackageTargets, selectComponentTarget ) where import Prelude () import Distribution.Client.Compat.Prelude import Distribution.Client.ProjectOrchestration import Distribution.Client.CmdErrorMessages import Distribution.Client.Setup ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags , applyFlagDefaults ) import qualified Distribution.Client.Setup as Client import Distribution.Simple.Setup ( HaddockFlags, fromFlagOrDefault ) import Distribution.Simple.Command ( CommandUI(..), usageAlternatives ) import Distribution.Types.ComponentName ( componentNameString ) import Distribution.Text ( display ) import Distribution.Verbosity ( Verbosity, normal ) import Distribution.Simple.Utils ( wrapText, die', ordNub, info ) import Distribution.Client.ProjectPlanning ( ElaboratedConfiguredPackage(..), BuildStyle(..) , ElaboratedInstallPlan, binDirectoryFor ) import Distribution.Client.InstallPlan ( toList, foldPlanPackage ) import Distribution.Types.UnqualComponentName ( UnqualComponentName, unUnqualComponentName ) import Distribution.Types.PackageDescription ( PackageDescription(dataDir) ) import Distribution.Simple.Program.Run ( runProgramInvocation, ProgramInvocation(..), emptyProgramInvocation ) import Distribution.Simple.Build.PathsModule ( pkgPathEnvVar ) import Distribution.Types.UnitId ( UnitId ) import Distribution.Client.Types ( PackageLocation(..) ) import qualified Data.Map as Map import qualified Data.Set as Set import System.FilePath ( () ) runCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) runCommand = Client.installCommand { commandName = "new-run", commandSynopsis = "Run an executable.", commandUsage = usageAlternatives "new-run" [ "[TARGET] [FLAGS] [-- EXECUTABLE_FLAGS]" ], commandDescription = Just $ \pname -> wrapText $ "Runs the specified executable, first ensuring it is up to date.\n\n" ++ "Any executable in any package in the project can be specified. " ++ "A package can be specified if contains just one executable. " ++ "The default is to use the package in the current directory if it " ++ "contains just one executable.\n\n" ++ "Extra arguments can be passed to the program, but use '--' to " ++ "separate arguments for the program from arguments for " ++ pname ++ ". The executable is run in an environment where it can find its " ++ "data files inplace in the build tree.\n\n" ++ "Dependencies are built or rebuilt as necessary. Additional " ++ "configuration flags can be specified on the command line and these " ++ "extend the project configuration from the 'cabal.project', " ++ "'cabal.project.local' and other files.", commandNotes = Just $ \pname -> "Examples:\n" ++ " " ++ pname ++ " new-run\n" ++ " Run the executable in the package in the current directory\n" ++ " " ++ pname ++ " new-run foo-tool\n" ++ " Run the named executable (in any package in the project)\n" ++ " " ++ pname ++ " new-run pkgfoo:foo-tool\n" ++ " Run the executable 'foo-tool' in the package 'pkgfoo'\n" ++ " " ++ pname ++ " new-run foo -O2 -- dothing --fooflag\n" ++ " Build with '-O2' and run the program, passing it extra arguments.\n\n" ++ cmdCommonHelpTextNewBuildBeta } -- | The @build@ command does a lot. It brings the install plan up to date, -- selects that part of the plan needed by the given or implicit targets and -- then executes the plan. -- -- For more details on how this works, see the module -- "Distribution.Client.ProjectOrchestration" -- runAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) -> [String] -> GlobalFlags -> IO () runAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, haddockFlags)) targetStrings globalFlags = do baseCtx <- establishProjectBaseContext verbosity cliConfig targetSelectors <- either (reportTargetSelectorProblems verbosity) return =<< readTargetSelectors (localPackages baseCtx) (take 1 targetStrings) -- Drop the exe's args. buildCtx <- runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do when (buildSettingOnlyDeps (buildSettings baseCtx)) $ die' verbosity $ "The run command does not support '--only-dependencies'. " ++ "You may wish to use 'build --only-dependencies' and then " ++ "use 'run'." -- Interpret the targets on the command line as build targets -- (as opposed to say repl or haddock targets). targets <- either (reportTargetProblems verbosity) return $ resolveTargets selectPackageTargets selectComponentTarget TargetProblemCommon elaboratedPlan 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. _ <- singleExeOrElse (reportTargetProblems verbosity [TargetProblemMultipleTargets targets]) targets let elaboratedPlan' = pruneInstallPlanToTargets TargetActionBuild targets elaboratedPlan return (elaboratedPlan', targets) (selectedUnitId, selectedComponent) <- -- Slight duplication with 'runProjectPreBuildPhase'. singleExeOrElse (die' verbosity $ "No or multiple targets given, but the run " ++ "phase has been reached. This is a bug.") $ targetsMap buildCtx printPlan verbosity baseCtx buildCtx buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes let elaboratedPlan = elaboratedPlanToExecute buildCtx matchingElaboratedConfiguredPackages = matchingPackagesByUnitId selectedUnitId elaboratedPlan let exeName = unUnqualComponentName 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. pkg <- case matchingElaboratedConfiguredPackages of [] -> die' verbosity $ "Unknown executable " ++ exeName ++ " in package " ++ display selectedUnitId [elabPkg] -> do info verbosity $ "Selecting " ++ display selectedUnitId ++ " to supply " ++ exeName return elabPkg elabPkgs -> die' verbosity $ "Multiple matching executables found matching " ++ exeName ++ ":\n" ++ unlines (fmap (\p -> " - in package " ++ display (elabUnitId p)) elabPkgs) let exePath = binDirectoryFor (distDirLayout baseCtx) (elaboratedShared buildCtx) pkg exeName exeName let args = drop 1 targetStrings runProgramInvocation verbosity emptyProgramInvocation { progInvokePath = exePath, progInvokeArgs = args, progInvokeEnv = dataDirsEnvironmentForPlan elaboratedPlan } where verbosity = fromFlagOrDefault normal (configVerbosity configFlags) cliConfig = commandLineFlagsToProjectConfig globalFlags configFlags configExFlags installFlags haddockFlags -- | Construct the environment needed for the data files to work. -- This consists of a separate @*_datadir@ variable for each -- inplace package in the plan. dataDirsEnvironmentForPlan :: ElaboratedInstallPlan -> [(String, Maybe FilePath)] dataDirsEnvironmentForPlan = catMaybes . fmap (foldPlanPackage (const Nothing) dataDirEnvVarForPackage) . toList -- | Construct an environment variable that points -- the package's datadir to its correct location. -- This might be: -- * 'Just' the package's source directory plus the data subdirectory -- for inplace packages. -- * 'Nothing' for packages installed in the store (the path was -- already included in the package at install/build time). -- * The other cases are not handled yet. See below. dataDirEnvVarForPackage :: ElaboratedConfiguredPackage -> Maybe (String, Maybe FilePath) dataDirEnvVarForPackage pkg = case (elabBuildStyle pkg, elabPkgSourceLocation pkg) of (BuildAndInstall, _) -> Nothing (BuildInplaceOnly, LocalUnpackedPackage path) -> Just (pkgPathEnvVar (elabPkgDescription pkg) "datadir", Just $ path dataDir (elabPkgDescription pkg)) -- TODO: handle the other cases for PackageLocation. -- We will only need this when we add support for -- remote/local tarballs. (BuildInplaceOnly, _) -> Nothing singleExeOrElse :: IO (UnitId, UnqualComponentName) -> TargetsMap -> IO (UnitId, UnqualComponentName) singleExeOrElse action targetsMap = case Set.toList . distinctTargetComponents $ targetsMap of [(unitId, CExeName component)] -> return (unitId, component) _ -> action -- | Filter the 'ElaboratedInstallPlan' keeping only the -- 'ElaboratedConfiguredPackage's that match the specified -- 'UnitId'. matchingPackagesByUnitId :: UnitId -> ElaboratedInstallPlan -> [ElaboratedConfiguredPackage] matchingPackagesByUnitId uid = catMaybes . fmap (foldPlanPackage (const Nothing) (\x -> if elabUnitId x == uid then Just x else Nothing)) . 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 PackageId -> [AvailableTarget k] -> Either TargetProblem [k] selectPackageTargets targetSelector targets -- If there is exactly one buildable executable then we select that | [target] <- targetsExesBuildable = Right [target] -- but fail if there are multiple buildable executables. | not (null targetsExesBuildable) = Left (TargetProblemMatchesMultiple targetSelector targetsExesBuildable') -- If there are executables but none are buildable then we report those | not (null targetsExes) = Left (TargetProblemNoneEnabled targetSelector targetsExes) -- If there are no executables but some other targets then we report that | not (null targets) = Left (TargetProblemNoExes targetSelector) -- If there are no targets at all then we report that | otherwise = Left (TargetProblemNoTargets targetSelector) where (targetsExesBuildable, targetsExesBuildable') = selectBuildableTargets' . filterTargetsKind ExeKind $ targets targetsExes = forgetTargetsDetail . filterTargetsKind ExeKind $ targets -- | For a 'TargetComponent' 'TargetSelector', check if the component can be -- selected. -- -- For the @run@ command we just need to check it is a executable, in addition -- to the basic checks on being buildable etc. -- selectComponentTarget :: PackageId -> ComponentName -> SubComponentTarget -> AvailableTarget k -> Either TargetProblem k selectComponentTarget pkgid cname subtarget@WholeComponent t | CExeName _ <- availableTargetComponentName t = either (Left . TargetProblemCommon) return $ selectComponentTargetBasic pkgid cname subtarget t | otherwise = Left (TargetProblemComponentNotExe pkgid cname) selectComponentTarget pkgid cname subtarget _ = Left (TargetProblemIsSubComponent pkgid cname subtarget) -- | The various error conditions that can occur when matching a -- 'TargetSelector' against 'AvailableTarget's for the @run@ command. -- data TargetProblem = TargetProblemCommon TargetProblemCommon -- | The 'TargetSelector' matches targets but none are buildable | TargetProblemNoneEnabled (TargetSelector PackageId) [AvailableTarget ()] -- | There are no targets at all | TargetProblemNoTargets (TargetSelector PackageId) -- | The 'TargetSelector' matches targets but no executables | TargetProblemNoExes (TargetSelector PackageId) -- | A single 'TargetSelector' matches multiple targets | TargetProblemMatchesMultiple (TargetSelector PackageId) [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 (Eq, Show) reportTargetProblems :: Verbosity -> [TargetProblem] -> IO a reportTargetProblems verbosity = die' verbosity . unlines . map renderTargetProblem renderTargetProblem :: TargetProblem -> String renderTargetProblem (TargetProblemCommon problem) = renderTargetProblemCommon "run" problem renderTargetProblem (TargetProblemNoneEnabled targetSelector targets) = renderTargetProblemNoneEnabled "run" targetSelector targets renderTargetProblem (TargetProblemNoExes targetSelector) = "Cannot run the target '" ++ showTargetSelector targetSelector ++ "' which refers to " ++ renderTargetSelector targetSelector ++ " because " ++ plural (targetSelectorPluralPkgs targetSelector) "it does" "they do" ++ " not contain any executables." renderTargetProblem (TargetProblemNoTargets targetSelector) = case targetSelectorFilter targetSelector of Just kind | kind /= ExeKind -> "The run command is for running executables, but the target '" ++ showTargetSelector targetSelector ++ "' refers to " ++ renderTargetSelector targetSelector ++ "." _ -> renderTargetProblemNoTargets "run" targetSelector renderTargetProblem (TargetProblemMatchesMultiple targetSelector targets) = "The run command is for running a single executable at once. The target '" ++ showTargetSelector targetSelector ++ "' refers to " ++ renderTargetSelector targetSelector ++ " which includes the executables " ++ renderListCommaAnd [ display name | cname@CExeName{} <- map availableTargetComponentName targets , let Just name = componentNameString cname ] ++ "." renderTargetProblem (TargetProblemMultipleTargets selectorMap) = "The run command is for running a single executable at once. The targets " ++ renderListCommaAnd [ "'" ++ showTargetSelector ts ++ "'" | ts <- ordNub (concatMap snd (concat (Map.elems selectorMap))) ] ++ " refer to different executables." renderTargetProblem (TargetProblemComponentNotExe pkgid cname) = "The run command is for running executables, but the target '" ++ showTargetSelector targetSelector ++ "' refers to " ++ renderTargetSelector targetSelector ++ " from the package " ++ display pkgid ++ "." where targetSelector = TargetComponent pkgid cname WholeComponent renderTargetProblem (TargetProblemIsSubComponent pkgid cname subtarget) = "The run command can only run an executable as a whole, " ++ "not files or modules within them, but the target '" ++ showTargetSelector targetSelector ++ "' refers to " ++ renderTargetSelector targetSelector ++ "." where targetSelector = TargetComponent pkgid cname subtarget