cabal-install/src/Distribution/Client/CmdRun.hs

   1 {-# LANGUAGE LambdaCase #-}
   2 {-# LANGUAGE NamedFieldPuns #-}
   3 {-# LANGUAGE OverloadedStrings #-}
   4 {-# LANGUAGE RecordWildCards #-}
   5 {-# LANGUAGE TupleSections #-}
   6
   7 -- | cabal-install CLI command: run
   8 module Distribution.Client.CmdRun
   9   ( -- * The @run@ CLI and action
  10     runCommand
  11   , runAction
  12   , handleShebang
  13   , validScript
  14
  15     -- * Internals exposed for testing
  16   , matchesMultipleProblem
  17   , noExesProblem
  18   , selectPackageTargets
  19   , selectComponentTarget
  20   ) where
  21
  22 import Distribution.Client.Compat.Prelude hiding (toList)
  23 import Prelude ()
  24
  25 import Data.List (group)
  26 import qualified Data.Set as Set
  27 import Distribution.Client.CmdErrorMessages
  28   ( plural
  29   , renderListCommaAnd
  30   , renderListPretty
  31   , renderTargetProblem
  32   , renderTargetProblemNoTargets
  33   , renderTargetSelector
  34   , showTargetSelector
  35   , targetSelectorFilter
  36   , targetSelectorPluralPkgs
  37   )
  38 import Distribution.Client.Errors
  39 import Distribution.Client.GlobalFlags
  40   ( defaultGlobalFlags
  41   )
  42 import Distribution.Client.InstallPlan
  43   ( foldPlanPackage
  44   , toList
  45   )
  46 import Distribution.Client.NixStyleOptions
  47   ( NixStyleFlags (..)
  48   , defaultNixStyleFlags
  49   , nixStyleOptions
  50   )
  51 import Distribution.Client.ProjectOrchestration
  52 import Distribution.Client.ProjectPlanning
  53   ( ElaboratedConfiguredPackage (..)
  54   , ElaboratedInstallPlan
  55   , binDirectoryFor
  56   )
  57 import Distribution.Client.ProjectPlanning.Types
  58   ( dataDirsEnvironmentForPlan
  59   )
  60 import Distribution.Client.ScriptUtils
  61   ( AcceptNoTargets (..)
  62   , TargetContext (..)
  63   , movedExePath
  64   , updateContextAndWriteProjectFile
  65   , withContextAndSelectors
  66   )
  67 import Distribution.Client.Setup
  68   ( ConfigFlags (..)
  69   , GlobalFlags (..)
  70   )
  71 import Distribution.Client.TargetProblem
  72   ( TargetProblem (..)
  73   )
  74 import Distribution.Client.Utils
  75   ( giveRTSWarning
  76   , occursOnlyOrBefore
  77   )
  78 import Distribution.Simple.Command
  79   ( CommandUI (..)
  80   , usageAlternatives
  81   )
  82 import Distribution.Simple.Flag
  83   ( fromFlagOrDefault
  84   )
  85 import Distribution.Simple.Program.Run
  86   ( ProgramInvocation (..)
  87   , emptyProgramInvocation
  88   , runProgramInvocation
  89   )
  90 import Distribution.Simple.Utils
  91   ( dieWithException
  92   , info
  93   , notice
  94   , safeHead
  95   , warn
  96   , wrapText
  97   )
  98 import Distribution.Types.ComponentName
  99   ( componentNameRaw
 100   )
 101 import Distribution.Types.UnitId
 102   ( UnitId
 103   )
 104 import Distribution.Types.UnqualComponentName
 105   ( UnqualComponentName
 106   , unUnqualComponentName
 107   )
 108 import Distribution.Verbosity
 109   ( normal
 110   , silent
 111   )
 112 import GHC.Environment
 113   ( getFullArgs
 114   )
 115 import System.Directory
 116   ( doesFileExist
 117   )
 118 import System.FilePath
 119   ( isPathSeparator
 120   , isValid
 121   , (</>)
 122   )
 123
 124 runCommand :: CommandUI (NixStyleFlags ())
 125 runCommand =
 126   CommandUI
 127     { commandName = "v2-run"
 128     , commandSynopsis = "Run an executable."
 129     , commandUsage =
 130         usageAlternatives
 131           "v2-run"
 132           ["[TARGET] [FLAGS] [-- EXECUTABLE_FLAGS]"]
 133     , commandDescription = Just $ \pname ->
 134         wrapText $
 135           "Runs the specified executable-like component (an executable, a test, "
 136             ++ "or a benchmark), first ensuring it is up to date.\n\n"
 137             ++ "Any executable-like component in any package in the project can be "
 138             ++ "specified. A package can be specified if contains just one "
 139             ++ "executable-like, preferring a single executable. The default is to "
 140             ++ "use the package in the current directory if it contains just one "
 141             ++ "executable-like.\n\n"
 142             ++ "Extra arguments can be passed to the program, but use '--' to "
 143             ++ "separate arguments for the program from arguments for "
 144             ++ pname
 145             ++ ". The executable is run in an environment where it can find its "
 146             ++ "data files inplace in the build tree.\n\n"
 147             ++ "Dependencies are built or rebuilt as necessary. Additional "
 148             ++ "configuration flags can be specified on the command line and these "
 149             ++ "extend the project configuration from the 'cabal.project', "
 150             ++ "'cabal.project.local' and other files."
 151     , commandNotes = Just $ \pname ->
 152         "Examples:\n"
 153           ++ "  "
 154           ++ pname
 155           ++ " v2-run\n"
 156           ++ "    Run the executable-like in the package in the current directory\n"
 157           ++ "  "
 158           ++ pname
 159           ++ " v2-run foo-tool\n"
 160           ++ "    Run the named executable-like (in any package in the project)\n"
 161           ++ "  "
 162           ++ pname
 163           ++ " v2-run pkgfoo:foo-tool\n"
 164           ++ "    Run the executable-like 'foo-tool' in the package 'pkgfoo'\n"
 165           ++ "  "
 166           ++ pname
 167           ++ " v2-run foo -O2 -- dothing --fooflag\n"
 168           ++ "    Build with '-O2' and run the program, passing it extra arguments.\n"
 169     , commandDefaultFlags = defaultNixStyleFlags ()
 170     , commandOptions = nixStyleOptions (const [])
 171     }
 172
 173 -- | The @run@ command runs a specified executable-like component, building it
 174 -- first if necessary. The component can be either an executable, a test,
 175 -- or a benchmark. This is particularly useful for passing arguments to
 176 -- exes/tests/benchs by simply appending them after a @--@.
 177 --
 178 -- For more details on how this works, see the module
 179 -- "Distribution.Client.ProjectOrchestration"
 180 runAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO ()
 181 runAction flags@NixStyleFlags{..} targetAndArgs globalFlags =
 182   withContextAndSelectors RejectNoTargets (Just ExeKind) flags targetStr globalFlags OtherCommand $ \targetCtx ctx targetSelectors -> do
 183     (baseCtx, defaultVerbosity) <- case targetCtx of
 184       ProjectContext -> return (ctx, normal)
 185       GlobalContext -> return (ctx, normal)
 186       ScriptContext path exemeta -> (,silent) <$> updateContextAndWriteProjectFile ctx path exemeta
 187
 188     let verbosity = fromFlagOrDefault defaultVerbosity (configVerbosity configFlags)
 189
 190     buildCtx <-
 191       runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do
 192         when (buildSettingOnlyDeps (buildSettings baseCtx)) $
 193           dieWithException verbosity NoSupportForRunCommand
 194
 195         fullArgs <- getFullArgs
 196         when (occursOnlyOrBefore fullArgs "+RTS" "--") $
 197           warn verbosity $
 198             giveRTSWarning "run"
 199
 200         -- Interpret the targets on the command line as build targets
 201         -- (as opposed to say repl or haddock targets).
 202         targets <-
 203           either (reportTargetProblems verbosity) return $
 204             resolveTargets
 205               selectPackageTargets
 206               selectComponentTarget
 207               elaboratedPlan
 208               Nothing
 209               targetSelectors
 210
 211         -- Reject multiple targets, or at least targets in different
 212         -- components. It is ok to have two module/file targets in the
 213         -- same component, but not two that live in different components.
 214         --
 215         -- Note that we discard the target and return the whole 'TargetsMap',
 216         -- so this check will be repeated (and must succeed) after
 217         -- the 'runProjectPreBuildPhase'. Keep it in mind when modifying this.
 218         _ <-
 219           singleExeOrElse
 220             ( reportTargetProblems
 221                 verbosity
 222                 [multipleTargetsProblem targets]
 223             )
 224             targets
 225
 226         let elaboratedPlan' =
 227               pruneInstallPlanToTargets
 228                 TargetActionBuild
 229                 targets
 230                 elaboratedPlan
 231         return (elaboratedPlan', targets)
 232
 233     (selectedUnitId, selectedComponent) <-
 234       -- Slight duplication with 'runProjectPreBuildPhase'.
 235       singleExeOrElse
 236         ( dieWithException verbosity RunPhaseReached
 237         )
 238         $ targetsMap buildCtx
 239
 240     printPlan verbosity baseCtx buildCtx
 241
 242     buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx
 243     runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes
 244
 245     let elaboratedPlan = elaboratedPlanToExecute buildCtx
 246         matchingElaboratedConfiguredPackages =
 247           matchingPackagesByUnitId
 248             selectedUnitId
 249             elaboratedPlan
 250
 251     let exeName = unUnqualComponentName selectedComponent
 252
 253     -- In the common case, we expect @matchingElaboratedConfiguredPackages@
 254     -- to consist of a single element that provides a single way of building
 255     -- an appropriately-named executable. In that case we take that
 256     -- package and continue.
 257     --
 258     -- However, multiple packages/components could provide that
 259     -- executable, or it's possible we don't find the executable anywhere
 260     -- in the build plan. I suppose in principle it's also possible that
 261     -- a single package provides an executable in two different ways,
 262     -- though that's probably a bug if. Anyway it's a good lint to report
 263     -- an error in all of these cases, even if some seem like they
 264     -- shouldn't happen.
 265     pkg <- case matchingElaboratedConfiguredPackages of
 266       [] -> dieWithException verbosity $ UnknownExecutable exeName selectedUnitId
 267       [elabPkg] -> do
 268         info verbosity $
 269           "Selecting "
 270             ++ prettyShow selectedUnitId
 271             ++ " to supply "
 272             ++ exeName
 273         return elabPkg
 274       elabPkgs ->
 275         dieWithException verbosity $
 276           MultipleMatchingExecutables exeName (fmap (\p -> " - in package " ++ prettyShow (elabUnitId p)) elabPkgs)
 277
 278     let defaultExePath =
 279           binDirectoryFor
 280             (distDirLayout baseCtx)
 281             (elaboratedShared buildCtx)
 282             pkg
 283             exeName
 284             </> exeName
 285         exePath = fromMaybe defaultExePath (movedExePath selectedComponent (distDirLayout baseCtx) (elaboratedShared buildCtx) pkg)
 286
 287     let dryRun =
 288           buildSettingDryRun (buildSettings baseCtx)
 289             || buildSettingOnlyDownload (buildSettings baseCtx)
 290
 291     if dryRun
 292       then notice verbosity "Running of executable suppressed by flag(s)"
 293       else
 294         runProgramInvocation
 295           verbosity
 296           emptyProgramInvocation
 297             { progInvokePath = exePath
 298             , progInvokeArgs = args
 299             , progInvokeEnv =
 300                 dataDirsEnvironmentForPlan
 301                   (distDirLayout baseCtx)
 302                   elaboratedPlan
 303             }
 304   where
 305     (targetStr, args) = splitAt 1 targetAndArgs
 306
 307 -- | Used by the main CLI parser as heuristic to decide whether @cabal@ was
 308 -- invoked as a script interpreter, i.e. via
 309 --
 310 -- > #! /usr/bin/env cabal
 311 --
 312 -- or
 313 --
 314 -- > #! /usr/bin/cabal
 315 --
 316 -- As the first argument passed to `cabal` will be a filepath to the
 317 -- script to be interpreted.
 318 --
 319 -- See also 'handleShebang'
 320 validScript :: String -> IO Bool
 321 validScript script
 322   | isValid script && any isPathSeparator script = doesFileExist script
 323   | otherwise = return False
 324
 325 -- | Handle @cabal@ invoked as script interpreter, see also 'validScript'
 326 --
 327 -- First argument is the 'FilePath' to the script to be executed; second
 328 -- argument is a list of arguments to be passed to the script.
 329 handleShebang :: FilePath -> [String] -> IO ()
 330 handleShebang script args =
 331   runAction (commandDefaultFlags runCommand) (script : args) defaultGlobalFlags
 332
 333 singleExeOrElse :: IO (UnitId, UnqualComponentName) -> TargetsMap -> IO (UnitId, UnqualComponentName)
 334 singleExeOrElse action targetsMap =
 335   case Set.toList . distinctTargetComponents $ targetsMap of
 336     [(unitId, CExeName component)] -> return (unitId, component)
 337     [(unitId, CTestName component)] -> return (unitId, component)
 338     [(unitId, CBenchName component)] -> return (unitId, component)
 339     _ -> action
 340
 341 -- | Filter the 'ElaboratedInstallPlan' keeping only the
 342 -- 'ElaboratedConfiguredPackage's that match the specified
 343 -- 'UnitId'.
 344 matchingPackagesByUnitId
 345   :: UnitId
 346   -> ElaboratedInstallPlan
 347   -> [ElaboratedConfiguredPackage]
 348 matchingPackagesByUnitId uid =
 349   catMaybes
 350     . fmap
 351       ( foldPlanPackage
 352           (const Nothing)
 353           ( \x ->
 354               if elabUnitId x == uid
 355                 then Just x
 356                 else Nothing
 357           )
 358       )
 359     . toList
 360
 361 -- | This defines what a 'TargetSelector' means for the @run@ command.
 362 -- It selects the 'AvailableTarget's that the 'TargetSelector' refers to,
 363 -- or otherwise classifies the problem.
 364 --
 365 -- For the @run@ command we select the exe if there is only one and it's
 366 -- buildable. Fail if there are no or multiple buildable exe components.
 367 selectPackageTargets
 368   :: TargetSelector
 369   -> [AvailableTarget k]
 370   -> Either RunTargetProblem [k]
 371 selectPackageTargets targetSelector targets
 372   -- If there is a single executable component, select that. See #7403
 373   | [target] <- targetsExesBuildable =
 374       Right [target]
 375   -- Otherwise, if there is a single executable-like component left, select that.
 376   | [target] <- targetsExeLikesBuildable =
 377       Right [target]
 378   -- but fail if there are multiple buildable executables.
 379   | not (null targetsExeLikesBuildable) =
 380       Left (matchesMultipleProblem targetSelector targetsExeLikesBuildable')
 381   -- If there are executables but none are buildable then we report those
 382   | not (null targetsExeLikes') =
 383       Left (TargetProblemNoneEnabled targetSelector targetsExeLikes')
 384   -- If there are no executables but some other targets then we report that
 385   | not (null targets) =
 386       Left (noExesProblem targetSelector)
 387   -- If there are no targets at all then we report that
 388   | otherwise =
 389       Left (TargetProblemNoTargets targetSelector)
 390   where
 391     -- Targets that are precisely executables
 392     targetsExes = filterTargetsKind ExeKind targets
 393     targetsExesBuildable = selectBuildableTargets targetsExes
 394
 395     -- Any target that could be executed
 396     targetsExeLikes =
 397       targetsExes
 398         ++ filterTargetsKind TestKind targets
 399         ++ filterTargetsKind BenchKind targets
 400
 401     ( targetsExeLikesBuildable
 402       , targetsExeLikesBuildable'
 403       ) = selectBuildableTargets' targetsExeLikes
 404
 405     targetsExeLikes' = forgetTargetsDetail targetsExeLikes
 406
 407 -- | For a 'TargetComponent' 'TargetSelector', check if the component can be
 408 -- selected.
 409 --
 410 -- For the @run@ command we just need to check it is a executable-like
 411 -- (an executable, a test, or a benchmark), in addition
 412 -- to the basic checks on being buildable etc.
 413 selectComponentTarget
 414   :: SubComponentTarget
 415   -> AvailableTarget k
 416   -> Either RunTargetProblem k
 417 selectComponentTarget subtarget@WholeComponent t =
 418   case availableTargetComponentName t of
 419     CExeName _ -> component
 420     CTestName _ -> component
 421     CBenchName _ -> component
 422     _ -> Left (componentNotExeProblem pkgid cname)
 423   where
 424     pkgid = availableTargetPackageId t
 425     cname = availableTargetComponentName t
 426     component = selectComponentTargetBasic subtarget t
 427 selectComponentTarget subtarget t =
 428   Left
 429     ( isSubComponentProblem
 430         (availableTargetPackageId t)
 431         (availableTargetComponentName t)
 432         subtarget
 433     )
 434
 435 -- | The various error conditions that can occur when matching a
 436 -- 'TargetSelector' against 'AvailableTarget's for the @run@ command.
 437 data RunProblem
 438   = -- | The 'TargetSelector' matches targets but no executables
 439     TargetProblemNoExes TargetSelector
 440   | -- | A single 'TargetSelector' matches multiple targets
 441     TargetProblemMatchesMultiple TargetSelector [AvailableTarget ()]
 442   | -- | Multiple 'TargetSelector's match multiple targets
 443     TargetProblemMultipleTargets TargetsMap
 444   | -- | The 'TargetSelector' refers to a component that is not an executable
 445     TargetProblemComponentNotExe PackageId ComponentName
 446   | -- | Asking to run an individual file or module is not supported
 447     TargetProblemIsSubComponent PackageId ComponentName SubComponentTarget
 448   deriving (Eq, Show)
 449
 450 type RunTargetProblem = TargetProblem RunProblem
 451
 452 noExesProblem :: TargetSelector -> RunTargetProblem
 453 noExesProblem = CustomTargetProblem . TargetProblemNoExes
 454
 455 matchesMultipleProblem :: TargetSelector -> [AvailableTarget ()] -> RunTargetProblem
 456 matchesMultipleProblem selector targets =
 457   CustomTargetProblem $
 458     TargetProblemMatchesMultiple selector targets
 459
 460 multipleTargetsProblem :: TargetsMap -> TargetProblem RunProblem
 461 multipleTargetsProblem = CustomTargetProblem . TargetProblemMultipleTargets
 462
 463 componentNotExeProblem :: PackageId -> ComponentName -> TargetProblem RunProblem
 464 componentNotExeProblem pkgid name =
 465   CustomTargetProblem $
 466     TargetProblemComponentNotExe pkgid name
 467
 468 isSubComponentProblem
 469   :: PackageId
 470   -> ComponentName
 471   -> SubComponentTarget
 472   -> TargetProblem RunProblem
 473 isSubComponentProblem pkgid name subcomponent =
 474   CustomTargetProblem $
 475     TargetProblemIsSubComponent pkgid name subcomponent
 476
 477 reportTargetProblems :: Verbosity -> [RunTargetProblem] -> IO a
 478 reportTargetProblems verbosity =
 479   dieWithException verbosity . CmdRunReportTargetProblems . unlines . map renderRunTargetProblem
 480
 481 renderRunTargetProblem :: RunTargetProblem -> String
 482 renderRunTargetProblem (TargetProblemNoTargets targetSelector) =
 483   case targetSelectorFilter targetSelector of
 484     Just kind
 485       | kind /= ExeKind ->
 486           "The run command is for running executables, but the target '"
 487             ++ showTargetSelector targetSelector
 488             ++ "' refers to "
 489             ++ renderTargetSelector targetSelector
 490             ++ "."
 491     _ -> renderTargetProblemNoTargets "run" targetSelector
 492 renderRunTargetProblem problem =
 493   renderTargetProblem "run" renderRunProblem problem
 494
 495 renderRunProblem :: RunProblem -> String
 496 renderRunProblem (TargetProblemMatchesMultiple targetSelector targets) =
 497   "The run command is for running a single executable at once. The target '"
 498     ++ showTargetSelector targetSelector
 499     ++ "' refers to "
 500     ++ renderTargetSelector targetSelector
 501     ++ " which includes \n"
 502     ++ unlines
 503       ( (\(label, xs) -> "- " ++ label ++ ": " ++ renderListPretty xs)
 504           <$> zip
 505             ["executables", "test-suites", "benchmarks"]
 506             ( filter (not . null) . map removeDuplicates $
 507                 map (componentNameRaw . availableTargetComponentName)
 508                   <$> (flip filterTargetsKind $ targets)
 509                   <$> [ExeKind, TestKind, BenchKind]
 510             )
 511       )
 512   where
 513     removeDuplicates = catMaybes . map safeHead . group . sort
 514 renderRunProblem (TargetProblemMultipleTargets selectorMap) =
 515   "The run command is for running a single executable at once. The targets "
 516     ++ renderListCommaAnd
 517       [ "'" ++ showTargetSelector ts ++ "'"
 518       | ts <- uniqueTargetSelectors selectorMap
 519       ]
 520     ++ " refer to different executables."
 521 renderRunProblem (TargetProblemComponentNotExe pkgid cname) =
 522   "The run command is for running executables, but the target '"
 523     ++ showTargetSelector targetSelector
 524     ++ "' refers to "
 525     ++ renderTargetSelector targetSelector
 526     ++ " from the package "
 527     ++ prettyShow pkgid
 528     ++ "."
 529   where
 530     targetSelector = TargetComponent pkgid cname WholeComponent
 531 renderRunProblem (TargetProblemIsSubComponent pkgid cname subtarget) =
 532   "The run command can only run an executable as a whole, "
 533     ++ "not files or modules within them, but the target '"
 534     ++ showTargetSelector targetSelector
 535     ++ "' refers to "
 536     ++ renderTargetSelector targetSelector
 537     ++ "."
 538   where
 539     targetSelector = TargetComponent pkgid cname subtarget
 540 renderRunProblem (TargetProblemNoExes targetSelector) =
 541   "Cannot run the target '"
 542     ++ showTargetSelector targetSelector
 543     ++ "' which refers to "
 544     ++ renderTargetSelector targetSelector
 545     ++ " because "
 546     ++ plural (targetSelectorPluralPkgs targetSelector) "it does" "they do"
 547     ++ " not contain any executables."