1{-# LANGUAGE LambdaCase #-} 2{-# LANGUAGE NamedFieldPuns #-} 3{-# LANGUAGE OverloadedStrings #-} 4{-# LANGUAGE RecordWildCards #-} 5 6-- | cabal-install CLI command: run 7-- 8module Distribution.Client.CmdRun ( 9 -- * The @run@ CLI and action 10 runCommand, 11 runAction, 12 handleShebang, validScript, 13 14 -- * Internals exposed for testing 15 TargetProblem(..), 16 selectPackageTargets, 17 selectComponentTarget 18 ) where 19 20import Prelude () 21import Distribution.Client.Compat.Prelude hiding (toList) 22 23import Distribution.Client.ProjectOrchestration 24import Distribution.Client.CmdErrorMessages 25 26import Distribution.Client.CmdRun.ClientRunFlags 27 28import Distribution.Client.Setup 29 ( GlobalFlags(..), ConfigFlags(..), ConfigExFlags, InstallFlags(..) 30 , configureExOptions, haddockOptions, installOptions, testOptions 31 , benchmarkOptions, configureOptions, liftOptions ) 32import Distribution.Solver.Types.ConstraintSource 33 ( ConstraintSource(..) ) 34import Distribution.Client.GlobalFlags 35 ( defaultGlobalFlags ) 36import Distribution.Simple.Setup 37 ( HaddockFlags, TestFlags, BenchmarkFlags, fromFlagOrDefault ) 38import Distribution.Simple.Command 39 ( CommandUI(..), OptionField (..), usageAlternatives ) 40import Distribution.Types.ComponentName 41 ( showComponentName ) 42import Distribution.Deprecated.Text 43 ( display ) 44import Distribution.Verbosity 45 ( Verbosity, normal ) 46import Distribution.Simple.Utils 47 ( wrapText, warn, die', ordNub, info 48 , createTempDirectory, handleDoesNotExist ) 49import Distribution.Client.CmdInstall 50 ( establishDummyProjectBaseContext ) 51import Distribution.Client.ProjectConfig 52 ( ProjectConfig(..), ProjectConfigShared(..) 53 , withProjectOrGlobalConfigIgn ) 54import Distribution.Client.ProjectPlanning 55 ( ElaboratedConfiguredPackage(..) 56 , ElaboratedInstallPlan, binDirectoryFor ) 57import Distribution.Client.ProjectPlanning.Types 58 ( dataDirsEnvironmentForPlan ) 59import Distribution.Client.TargetSelector 60 ( TargetSelectorProblem(..), TargetString(..) ) 61import Distribution.Client.InstallPlan 62 ( toList, foldPlanPackage ) 63import Distribution.Types.UnqualComponentName 64 ( UnqualComponentName, unUnqualComponentName ) 65import Distribution.Simple.Program.Run 66 ( runProgramInvocation, ProgramInvocation(..), 67 emptyProgramInvocation ) 68import Distribution.Types.UnitId 69 ( UnitId ) 70 71import Distribution.CabalSpecVersion 72 ( cabalSpecLatest ) 73import Distribution.Client.Types 74 ( PackageLocation(..), PackageSpecifier(..) ) 75import Distribution.FieldGrammar 76 ( takeFields, parseFieldGrammar ) 77import Distribution.PackageDescription.FieldGrammar 78 ( executableFieldGrammar ) 79import Distribution.PackageDescription.PrettyPrint 80 ( writeGenericPackageDescription ) 81import Distribution.Parsec 82 ( Position(..) ) 83import Distribution.Fields 84 ( ParseResult, parseString, parseFatalFailure, readFields ) 85import qualified Distribution.SPDX.License as SPDX 86import Distribution.Solver.Types.SourcePackage as SP 87 ( SourcePackage(..) ) 88import Distribution.Types.BuildInfo 89 ( BuildInfo(..) ) 90import Distribution.Types.CondTree 91 ( CondTree(..) ) 92import Distribution.Types.Executable 93 ( Executable(..) ) 94import Distribution.Types.GenericPackageDescription as GPD 95 ( GenericPackageDescription(..), emptyGenericPackageDescription ) 96import Distribution.Types.PackageDescription 97 ( PackageDescription(..), emptyPackageDescription ) 98import Distribution.Types.Version 99 ( mkVersion ) 100import Distribution.Types.PackageName.Magic 101 ( fakePackageId ) 102import Language.Haskell.Extension 103 ( Language(..) ) 104 105import qualified Data.ByteString.Char8 as BS 106import qualified Data.Map as Map 107import qualified Data.Set as Set 108import qualified Text.Parsec as P 109import System.Directory 110 ( getTemporaryDirectory, removeDirectoryRecursive, doesFileExist ) 111import System.FilePath 112 ( (</>), isValid, isPathSeparator, takeExtension ) 113 114 115runCommand :: CommandUI ( ConfigFlags, ConfigExFlags, InstallFlags 116 , HaddockFlags, TestFlags, BenchmarkFlags 117 , ClientRunFlags 118 ) 119runCommand = CommandUI 120 { commandName = "v2-run" 121 , commandSynopsis = "Run an executable." 122 , commandUsage = usageAlternatives "v2-run" 123 [ "[TARGET] [FLAGS] [-- EXECUTABLE_FLAGS]" ] 124 , commandDescription = Just $ \pname -> wrapText $ 125 "Runs the specified executable-like component (an executable, a test, " 126 ++ "or a benchmark), first ensuring it is up to date.\n\n" 127 128 ++ "Any executable-like component in any package in the project can be " 129 ++ "specified. A package can be specified if contains just one " 130 ++ "executable-like. The default is to use the package in the current " 131 ++ "directory if it contains just one executable-like.\n\n" 132 133 ++ "Extra arguments can be passed to the program, but use '--' to " 134 ++ "separate arguments for the program from arguments for " ++ pname 135 ++ ". The executable is run in an environment where it can find its " 136 ++ "data files inplace in the build tree.\n\n" 137 138 ++ "Dependencies are built or rebuilt as necessary. Additional " 139 ++ "configuration flags can be specified on the command line and these " 140 ++ "extend the project configuration from the 'cabal.project', " 141 ++ "'cabal.project.local' and other files." 142 , commandNotes = Just $ \pname -> 143 "Examples:\n" 144 ++ " " ++ pname ++ " v2-run\n" 145 ++ " Run the executable-like in the package in the current directory\n" 146 ++ " " ++ pname ++ " v2-run foo-tool\n" 147 ++ " Run the named executable-like (in any package in the project)\n" 148 ++ " " ++ pname ++ " v2-run pkgfoo:foo-tool\n" 149 ++ " Run the executable-like 'foo-tool' in the package 'pkgfoo'\n" 150 ++ " " ++ pname ++ " v2-run foo -O2 -- dothing --fooflag\n" 151 ++ " Build with '-O2' and run the program, passing it extra arguments.\n\n" 152 153 ++ cmdCommonHelpTextNewBuildBeta 154 , commandDefaultFlags = (mempty, mempty, mempty, mempty, mempty, mempty, mempty) 155 , commandOptions = \showOrParseArgs -> 156 liftOptions get1 set1 157 -- Note: [Hidden Flags] 158 -- hide "constraint", "dependency", and 159 -- "exact-configuration" from the configure options. 160 (filter ((`notElem` ["constraint", "dependency" 161 , "exact-configuration"]) 162 . optionName) $ 163 configureOptions showOrParseArgs) 164 ++ liftOptions get2 set2 (configureExOptions showOrParseArgs ConstraintSourceCommandlineFlag) 165 ++ liftOptions get3 set3 166 -- hide "target-package-db" flag from the 167 -- install options. 168 (filter ((`notElem` ["target-package-db"]) 169 . optionName) $ 170 installOptions showOrParseArgs) 171 ++ liftOptions get4 set4 (haddockOptions showOrParseArgs) 172 ++ liftOptions get5 set5 (testOptions showOrParseArgs) 173 ++ liftOptions get6 set6 (benchmarkOptions showOrParseArgs) 174 ++ liftOptions get7 set7 (clientRunOptions showOrParseArgs) 175 } 176 where 177 get1 (a,_,_,_,_,_,_) = a; set1 a (_,b,c,d,e,f,g) = (a,b,c,d,e,f,g) 178 get2 (_,b,_,_,_,_,_) = b; set2 b (a,_,c,d,e,f,g) = (a,b,c,d,e,f,g) 179 get3 (_,_,c,_,_,_,_) = c; set3 c (a,b,_,d,e,f,g) = (a,b,c,d,e,f,g) 180 get4 (_,_,_,d,_,_,_) = d; set4 d (a,b,c,_,e,f,g) = (a,b,c,d,e,f,g) 181 get5 (_,_,_,_,e,_,_) = e; set5 e (a,b,c,d,_,f,g) = (a,b,c,d,e,f,g) 182 get6 (_,_,_,_,_,f,_) = f; set6 f (a,b,c,d,e,_,g) = (a,b,c,d,e,f,g) 183 get7 (_,_,_,_,_,_,g) = g; set7 g (a,b,c,d,e,f,_) = (a,b,c,d,e,f,g) 184 185 186-- | The @run@ command runs a specified executable-like component, building it 187-- first if necessary. The component can be either an executable, a test, 188-- or a benchmark. This is particularly useful for passing arguments to 189-- exes/tests/benchs by simply appending them after a @--@. 190-- 191-- For more details on how this works, see the module 192-- "Distribution.Client.ProjectOrchestration" 193-- 194runAction :: ( ConfigFlags, ConfigExFlags, InstallFlags 195 , HaddockFlags, TestFlags, BenchmarkFlags 196 , ClientRunFlags ) 197 -> [String] -> GlobalFlags -> IO () 198runAction ( configFlags, configExFlags, installFlags 199 , haddockFlags, testFlags, benchmarkFlags 200 , clientRunFlags ) 201 targetStrings globalFlags = do 202 globalTmp <- getTemporaryDirectory 203 tempDir <- createTempDirectory globalTmp "cabal-repl." 204 205 let 206 with = 207 establishProjectBaseContext verbosity cliConfig OtherCommand 208 without config = 209 establishDummyProjectBaseContext verbosity (config <> cliConfig) tempDir [] OtherCommand 210 211 let 212 ignoreProject = fromFlagOrDefault False (crunIgnoreProject clientRunFlags) 213 214 baseCtx <- withProjectOrGlobalConfigIgn ignoreProject verbosity globalConfigFlag with without 215 216 let 217 scriptOrError script err = do 218 exists <- doesFileExist script 219 let pol | takeExtension script == ".lhs" = LiterateHaskell 220 | otherwise = PlainHaskell 221 if exists 222 then BS.readFile script >>= handleScriptCase verbosity pol baseCtx tempDir 223 else reportTargetSelectorProblems verbosity err 224 225 (baseCtx', targetSelectors) <- 226 readTargetSelectors (localPackages baseCtx) (Just ExeKind) (take 1 targetStrings) 227 >>= \case 228 Left err@(TargetSelectorNoTargetsInProject:_) 229 | (script:_) <- targetStrings -> scriptOrError script err 230 Left err@(TargetSelectorNoSuch t _:_) 231 | TargetString1 script <- t -> scriptOrError script err 232 Left err@(TargetSelectorExpected t _ _:_) 233 | TargetString1 script <- t -> scriptOrError script err 234 Left err -> reportTargetSelectorProblems verbosity err 235 Right sels -> return (baseCtx, sels) 236 237 buildCtx <- 238 runProjectPreBuildPhase verbosity baseCtx' $ \elaboratedPlan -> do 239 240 when (buildSettingOnlyDeps (buildSettings baseCtx')) $ 241 die' verbosity $ 242 "The run command does not support '--only-dependencies'. " 243 ++ "You may wish to use 'build --only-dependencies' and then " 244 ++ "use 'run'." 245 246 -- Interpret the targets on the command line as build targets 247 -- (as opposed to say repl or haddock targets). 248 targets <- either (reportTargetProblems verbosity) return 249 $ resolveTargets 250 selectPackageTargets 251 selectComponentTarget 252 TargetProblemCommon 253 elaboratedPlan 254 Nothing 255 targetSelectors 256 257 -- Reject multiple targets, or at least targets in different 258 -- components. It is ok to have two module/file targets in the 259 -- same component, but not two that live in different components. 260 -- 261 -- Note that we discard the target and return the whole 'TargetsMap', 262 -- so this check will be repeated (and must succeed) after 263 -- the 'runProjectPreBuildPhase'. Keep it in mind when modifying this. 264 _ <- singleExeOrElse 265 (reportTargetProblems 266 verbosity 267 [TargetProblemMultipleTargets targets]) 268 targets 269 270 let elaboratedPlan' = pruneInstallPlanToTargets 271 TargetActionBuild 272 targets 273 elaboratedPlan 274 return (elaboratedPlan', targets) 275 276 (selectedUnitId, selectedComponent) <- 277 -- Slight duplication with 'runProjectPreBuildPhase'. 278 singleExeOrElse 279 (die' verbosity $ "No or multiple targets given, but the run " 280 ++ "phase has been reached. This is a bug.") 281 $ targetsMap buildCtx 282 283 printPlan verbosity baseCtx' buildCtx 284 285 buildOutcomes <- runProjectBuildPhase verbosity baseCtx' buildCtx 286 runProjectPostBuildPhase verbosity baseCtx' buildCtx buildOutcomes 287 288 289 let elaboratedPlan = elaboratedPlanToExecute buildCtx 290 matchingElaboratedConfiguredPackages = 291 matchingPackagesByUnitId 292 selectedUnitId 293 elaboratedPlan 294 295 let exeName = unUnqualComponentName selectedComponent 296 297 -- In the common case, we expect @matchingElaboratedConfiguredPackages@ 298 -- to consist of a single element that provides a single way of building 299 -- an appropriately-named executable. In that case we take that 300 -- package and continue. 301 -- 302 -- However, multiple packages/components could provide that 303 -- executable, or it's possible we don't find the executable anywhere 304 -- in the build plan. I suppose in principle it's also possible that 305 -- a single package provides an executable in two different ways, 306 -- though that's probably a bug if. Anyway it's a good lint to report 307 -- an error in all of these cases, even if some seem like they 308 -- shouldn't happen. 309 pkg <- case matchingElaboratedConfiguredPackages of 310 [] -> die' verbosity $ "Unknown executable " 311 ++ exeName 312 ++ " in package " 313 ++ display selectedUnitId 314 [elabPkg] -> do 315 info verbosity $ "Selecting " 316 ++ display selectedUnitId 317 ++ " to supply " ++ exeName 318 return elabPkg 319 elabPkgs -> die' verbosity 320 $ "Multiple matching executables found matching " 321 ++ exeName 322 ++ ":\n" 323 ++ unlines (fmap (\p -> " - in package " ++ display (elabUnitId p)) elabPkgs) 324 let exePath = binDirectoryFor (distDirLayout baseCtx) 325 (elaboratedShared buildCtx) 326 pkg 327 exeName 328 </> exeName 329 let args = drop 1 targetStrings 330 runProgramInvocation 331 verbosity 332 emptyProgramInvocation { 333 progInvokePath = exePath, 334 progInvokeArgs = args, 335 progInvokeEnv = dataDirsEnvironmentForPlan 336 (distDirLayout baseCtx) 337 elaboratedPlan 338 } 339 340 handleDoesNotExist () (removeDirectoryRecursive tempDir) 341 where 342 verbosity = fromFlagOrDefault normal (configVerbosity configFlags) 343 cliConfig = commandLineFlagsToProjectConfig 344 globalFlags configFlags configExFlags 345 installFlags 346 mempty -- ClientInstallFlags, not needed here 347 haddockFlags testFlags benchmarkFlags 348 globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig) 349 350-- | Used by the main CLI parser as heuristic to decide whether @cabal@ was 351-- invoked as a script interpreter, i.e. via 352-- 353-- > #! /usr/bin/env cabal 354-- 355-- or 356-- 357-- > #! /usr/bin/cabal 358-- 359-- As the first argument passed to `cabal` will be a filepath to the 360-- script to be interpreted. 361-- 362-- See also 'handleShebang' 363validScript :: String -> IO Bool 364validScript script 365 | isValid script && any isPathSeparator script = doesFileExist script 366 | otherwise = return False 367 368-- | Handle @cabal@ invoked as script interpreter, see also 'validScript' 369-- 370-- First argument is the 'FilePath' to the script to be executed; second 371-- argument is a list of arguments to be passed to the script. 372handleShebang :: FilePath -> [String] -> IO () 373handleShebang script args = 374 runAction (commandDefaultFlags runCommand) (script:args) defaultGlobalFlags 375 376parseScriptBlock :: BS.ByteString -> ParseResult Executable 377parseScriptBlock str = 378 case readFields str of 379 Right fs -> do 380 let (fields, _) = takeFields fs 381 parseFieldGrammar cabalSpecLatest fields (executableFieldGrammar "script") 382 Left perr -> parseFatalFailure pos (show perr) where 383 ppos = P.errorPos perr 384 pos = Position (P.sourceLine ppos) (P.sourceColumn ppos) 385 386readScriptBlock :: Verbosity -> BS.ByteString -> IO Executable 387readScriptBlock verbosity = parseString parseScriptBlock verbosity "script block" 388 389readScriptBlockFromScript :: Verbosity -> PlainOrLiterate -> BS.ByteString -> IO (Executable, BS.ByteString) 390readScriptBlockFromScript verbosity pol str = do 391 str' <- case extractScriptBlock pol str of 392 Left e -> die' verbosity $ "Failed extracting script block: " ++ e 393 Right x -> return x 394 when (BS.all isSpace str') $ warn verbosity "Empty script block" 395 (\x -> (x, noShebang)) <$> readScriptBlock verbosity str' 396 where 397 noShebang = BS.unlines . filter (not . BS.isPrefixOf "#!") . BS.lines $ str 398 399-- | Extract the first encountered script metadata block started end 400-- terminated by the tokens 401-- 402-- * @{- cabal:@ 403-- 404-- * @-}@ 405-- 406-- appearing alone on lines (while tolerating trailing whitespace). 407-- These tokens are not part of the 'Right' result. 408-- 409-- In case of missing or unterminated blocks a 'Left'-error is 410-- returned. 411extractScriptBlock :: PlainOrLiterate -> BS.ByteString -> Either String BS.ByteString 412extractScriptBlock _pol str = goPre (BS.lines str) 413 where 414 isStartMarker = (== startMarker) . stripTrailSpace 415 isEndMarker = (== endMarker) . stripTrailSpace 416 417 stripTrailSpace = fst . BS.spanEnd isSpace 418 419 -- before start marker 420 goPre ls = case dropWhile (not . isStartMarker) ls of 421 [] -> Left $ "`" ++ BS.unpack startMarker ++ "` start marker not found" 422 (_:ls') -> goBody [] ls' 423 424 goBody _ [] = Left $ "`" ++ BS.unpack endMarker ++ "` end marker not found" 425 goBody acc (l:ls) 426 | isEndMarker l = Right $! BS.unlines $ reverse acc 427 | otherwise = goBody (l:acc) ls 428 429 startMarker, endMarker :: BS.ByteString 430 startMarker = fromString "{- cabal:" 431 endMarker = fromString "-}" 432 433data PlainOrLiterate 434 = PlainHaskell 435 | LiterateHaskell 436 437handleScriptCase 438 :: Verbosity 439 -> PlainOrLiterate 440 -> ProjectBaseContext 441 -> FilePath 442 -> BS.ByteString 443 -> IO (ProjectBaseContext, [TargetSelector]) 444handleScriptCase verbosity pol baseCtx tempDir scriptContents = do 445 (executable, contents') <- readScriptBlockFromScript verbosity pol scriptContents 446 447 -- We need to create a dummy package that lives in our dummy project. 448 let 449 mainName = case pol of 450 PlainHaskell -> "Main.hs" 451 LiterateHaskell -> "Main.lhs" 452 453 sourcePackage = SourcePackage 454 { packageInfoId = pkgId 455 , SP.packageDescription = genericPackageDescription 456 , packageSource = LocalUnpackedPackage tempDir 457 , packageDescrOverride = Nothing 458 } 459 genericPackageDescription = emptyGenericPackageDescription 460 { GPD.packageDescription = packageDescription 461 , condExecutables = [("script", CondNode executable' targetBuildDepends [])] 462 } 463 executable' = executable 464 { modulePath = mainName 465 , buildInfo = binfo 466 { defaultLanguage = 467 case defaultLanguage of 468 just@(Just _) -> just 469 Nothing -> Just Haskell2010 470 } 471 } 472 binfo@BuildInfo{..} = buildInfo executable 473 packageDescription = emptyPackageDescription 474 { package = pkgId 475 , specVersionRaw = Left (mkVersion [2, 2]) 476 , licenseRaw = Left SPDX.NONE 477 } 478 pkgId = fakePackageId 479 480 writeGenericPackageDescription (tempDir </> "fake-package.cabal") genericPackageDescription 481 BS.writeFile (tempDir </> mainName) contents' 482 483 let 484 baseCtx' = baseCtx 485 { localPackages = localPackages baseCtx ++ [SpecificSourcePackage sourcePackage] } 486 targetSelectors = [TargetPackage TargetExplicitNamed [pkgId] Nothing] 487 488 return (baseCtx', targetSelectors) 489 490singleExeOrElse :: IO (UnitId, UnqualComponentName) -> TargetsMap -> IO (UnitId, UnqualComponentName) 491singleExeOrElse action targetsMap = 492 case Set.toList . distinctTargetComponents $ targetsMap 493 of [(unitId, CExeName component)] -> return (unitId, component) 494 [(unitId, CTestName component)] -> return (unitId, component) 495 [(unitId, CBenchName component)] -> return (unitId, component) 496 _ -> action 497 498-- | Filter the 'ElaboratedInstallPlan' keeping only the 499-- 'ElaboratedConfiguredPackage's that match the specified 500-- 'UnitId'. 501matchingPackagesByUnitId :: UnitId 502 -> ElaboratedInstallPlan 503 -> [ElaboratedConfiguredPackage] 504matchingPackagesByUnitId uid = 505 catMaybes 506 . fmap (foldPlanPackage 507 (const Nothing) 508 (\x -> if elabUnitId x == uid 509 then Just x 510 else Nothing)) 511 . toList 512 513-- | This defines what a 'TargetSelector' means for the @run@ command. 514-- It selects the 'AvailableTarget's that the 'TargetSelector' refers to, 515-- or otherwise classifies the problem. 516-- 517-- For the @run@ command we select the exe if there is only one and it's 518-- buildable. Fail if there are no or multiple buildable exe components. 519-- 520selectPackageTargets :: TargetSelector 521 -> [AvailableTarget k] -> Either TargetProblem [k] 522selectPackageTargets targetSelector targets 523 524 -- If there is exactly one buildable executable then we select that 525 | [target] <- targetsExesBuildable 526 = Right [target] 527 528 -- but fail if there are multiple buildable executables. 529 | not (null targetsExesBuildable) 530 = Left (TargetProblemMatchesMultiple targetSelector targetsExesBuildable') 531 532 -- If there are executables but none are buildable then we report those 533 | not (null targetsExes) 534 = Left (TargetProblemNoneEnabled targetSelector targetsExes) 535 536 -- If there are no executables but some other targets then we report that 537 | not (null targets) 538 = Left (TargetProblemNoExes targetSelector) 539 540 -- If there are no targets at all then we report that 541 | otherwise 542 = Left (TargetProblemNoTargets targetSelector) 543 where 544 -- Targets that can be executed 545 targetsExecutableLike = 546 concatMap (\kind -> filterTargetsKind kind targets) 547 [ExeKind, TestKind, BenchKind] 548 (targetsExesBuildable, 549 targetsExesBuildable') = selectBuildableTargets' targetsExecutableLike 550 551 targetsExes = forgetTargetsDetail targetsExecutableLike 552 553 554-- | For a 'TargetComponent' 'TargetSelector', check if the component can be 555-- selected. 556-- 557-- For the @run@ command we just need to check it is a executable-like 558-- (an executable, a test, or a benchmark), in addition 559-- to the basic checks on being buildable etc. 560-- 561selectComponentTarget :: SubComponentTarget 562 -> AvailableTarget k -> Either TargetProblem k 563selectComponentTarget subtarget@WholeComponent t 564 = case availableTargetComponentName t 565 of CExeName _ -> component 566 CTestName _ -> component 567 CBenchName _ -> component 568 _ -> Left (TargetProblemComponentNotExe pkgid cname) 569 where pkgid = availableTargetPackageId t 570 cname = availableTargetComponentName t 571 component = either (Left . TargetProblemCommon) return $ 572 selectComponentTargetBasic subtarget t 573 574selectComponentTarget subtarget t 575 = Left (TargetProblemIsSubComponent (availableTargetPackageId t) 576 (availableTargetComponentName t) 577 subtarget) 578 579-- | The various error conditions that can occur when matching a 580-- 'TargetSelector' against 'AvailableTarget's for the @run@ command. 581-- 582data TargetProblem = 583 TargetProblemCommon TargetProblemCommon 584 -- | The 'TargetSelector' matches targets but none are buildable 585 | TargetProblemNoneEnabled TargetSelector [AvailableTarget ()] 586 587 -- | There are no targets at all 588 | TargetProblemNoTargets TargetSelector 589 590 -- | The 'TargetSelector' matches targets but no executables 591 | TargetProblemNoExes TargetSelector 592 593 -- | A single 'TargetSelector' matches multiple targets 594 | TargetProblemMatchesMultiple TargetSelector [AvailableTarget ()] 595 596 -- | Multiple 'TargetSelector's match multiple targets 597 | TargetProblemMultipleTargets TargetsMap 598 599 -- | The 'TargetSelector' refers to a component that is not an executable 600 | TargetProblemComponentNotExe PackageId ComponentName 601 602 -- | Asking to run an individual file or module is not supported 603 | TargetProblemIsSubComponent PackageId ComponentName SubComponentTarget 604 deriving (Eq, Show) 605 606reportTargetProblems :: Verbosity -> [TargetProblem] -> IO a 607reportTargetProblems verbosity = 608 die' verbosity . unlines . map renderTargetProblem 609 610renderTargetProblem :: TargetProblem -> String 611renderTargetProblem (TargetProblemCommon problem) = 612 renderTargetProblemCommon "run" problem 613 614renderTargetProblem (TargetProblemNoneEnabled targetSelector targets) = 615 renderTargetProblemNoneEnabled "run" targetSelector targets 616 617renderTargetProblem (TargetProblemNoExes targetSelector) = 618 "Cannot run the target '" ++ showTargetSelector targetSelector 619 ++ "' which refers to " ++ renderTargetSelector targetSelector 620 ++ " because " 621 ++ plural (targetSelectorPluralPkgs targetSelector) "it does" "they do" 622 ++ " not contain any executables." 623 624renderTargetProblem (TargetProblemNoTargets targetSelector) = 625 case targetSelectorFilter targetSelector of 626 Just kind | kind /= ExeKind 627 -> "The run command is for running executables, but the target '" 628 ++ showTargetSelector targetSelector ++ "' refers to " 629 ++ renderTargetSelector targetSelector ++ "." 630 631 _ -> renderTargetProblemNoTargets "run" targetSelector 632 633renderTargetProblem (TargetProblemMatchesMultiple targetSelector targets) = 634 "The run command is for running a single executable at once. The target '" 635 ++ showTargetSelector targetSelector ++ "' refers to " 636 ++ renderTargetSelector targetSelector ++ " which includes " 637 ++ renderListCommaAnd ( ("the "++) <$> 638 showComponentName <$> 639 availableTargetComponentName <$> 640 foldMap 641 (\kind -> filterTargetsKind kind targets) 642 [ExeKind, TestKind, BenchKind] ) 643 ++ "." 644 645renderTargetProblem (TargetProblemMultipleTargets selectorMap) = 646 "The run command is for running a single executable at once. The targets " 647 ++ renderListCommaAnd [ "'" ++ showTargetSelector ts ++ "'" 648 | ts <- ordNub (concatMap snd (concat (Map.elems selectorMap))) ] 649 ++ " refer to different executables." 650 651renderTargetProblem (TargetProblemComponentNotExe pkgid cname) = 652 "The run command is for running executables, but the target '" 653 ++ showTargetSelector targetSelector ++ "' refers to " 654 ++ renderTargetSelector targetSelector ++ " from the package " 655 ++ display pkgid ++ "." 656 where 657 targetSelector = TargetComponent pkgid cname WholeComponent 658 659renderTargetProblem (TargetProblemIsSubComponent pkgid cname subtarget) = 660 "The run command can only run an executable as a whole, " 661 ++ "not files or modules within them, but the target '" 662 ++ showTargetSelector targetSelector ++ "' refers to " 663 ++ renderTargetSelector targetSelector ++ "." 664 where 665 targetSelector = TargetComponent pkgid cname subtarget 666