-
Notifications
You must be signed in to change notification settings - Fork 704
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
implement a new-exec command #4304
Closed
Closed
Changes from all commits
Commits
Show all changes
12 commits
Select commit
Hold shift + click to select a range
b41505a
enviroment -> environment
dmwit 599120e
disable GHC environment files in another way
dmwit 585fe3a
bare-bones new-exec support
dmwit c5f0052
factor out the logic for choosing a directory for binaries
dmwit effe36b
PATH modifications for new-exec
dmwit 43893e4
use the ProgramDb in new-exec
dmwit 1d4533e
write help text for new-exec
dmwit 603897f
backwards compatibility
dmwit 44af73e
use the install plan to modify PATH in new-exec
dmwit e49880b
comment on a tricky line of code
dmwit a6df3e8
accept all new-build flags in new-exec
dmwit 108ab93
allow new-exec'ing of executables built inplace
dmwit File filter
Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,191 @@ | ||
------------------------------------------------------------------------------- | ||
-- | | ||
-- Module : Distribution.Client.Exec | ||
-- Maintainer : cabal-devel@haskell.org | ||
-- Portability : portable | ||
-- | ||
-- Implementation of the 'new-exec' command for running an arbitrary executable | ||
-- in an environment suited to the part of the store built for a project. | ||
------------------------------------------------------------------------------- | ||
|
||
{-# LANGUAGE RecordWildCards #-} | ||
module Distribution.Client.CmdExec | ||
( execAction | ||
, execCommand | ||
) where | ||
|
||
import Distribution.Client.DistDirLayout | ||
( DistDirLayout(..) | ||
) | ||
import Distribution.Client.InstallPlan | ||
( GenericPlanPackage(..) | ||
, toGraph | ||
) | ||
import Distribution.Client.Setup | ||
( ConfigExFlags | ||
, ConfigFlags(configVerbosity) | ||
, GlobalFlags | ||
, InstallFlags | ||
, installCommand | ||
) | ||
import Distribution.Client.ProjectOrchestration | ||
( ProjectBuildContext(..) | ||
, PreBuildHooks(..) | ||
, runProjectPreBuildPhase | ||
) | ||
import Distribution.Client.ProjectPlanOutput | ||
( updatePostBuildProjectStatus | ||
, createPackageEnvironment | ||
) | ||
import qualified Distribution.Client.ProjectPlanning as Planning | ||
import Distribution.Client.ProjectPlanning | ||
( ElaboratedInstallPlan | ||
, ElaboratedSharedConfig(..) | ||
) | ||
import Distribution.Simple.Command | ||
( CommandUI(..) | ||
) | ||
import Distribution.Simple.Program.Db | ||
( modifyProgramSearchPath | ||
, requireProgram | ||
) | ||
import Distribution.Simple.Program.Find | ||
( ProgramSearchPathEntry(..) | ||
) | ||
import Distribution.Simple.Program.Run | ||
( programInvocation | ||
, runProgramInvocation | ||
) | ||
import Distribution.Simple.Program.Types | ||
( programOverrideEnv | ||
, simpleProgram | ||
) | ||
import Distribution.Simple.Setup | ||
( HaddockFlags | ||
, fromFlagOrDefault | ||
) | ||
import Distribution.Simple.Utils | ||
( die | ||
, info | ||
, withTempDirectory | ||
, wrapText | ||
) | ||
import Distribution.Verbosity | ||
( Verbosity | ||
, normal | ||
) | ||
|
||
import Prelude () | ||
import Distribution.Client.Compat.Prelude | ||
|
||
import Data.Set (Set) | ||
import qualified Data.Set as S | ||
|
||
execCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) | ||
execCommand = installCommand | ||
{ commandName = "new-exec" | ||
, commandSynopsis = "Give a command access to the store." | ||
, commandUsage = \pname -> | ||
"Usage: " ++ pname ++ " new-exec [FLAGS] [--] COMMAND [--] [ARGS]\n" | ||
, commandDescription = Just $ \pname -> wrapText $ | ||
"During development it is often useful to run build tasks and perform" | ||
++ " one-off program executions to experiment with the behavior of build" | ||
++ " tools. It is convenient to run these tools in the same way " ++ pname | ||
++ " itself would. The `" ++ pname ++ " new-exec` command provides a way to" | ||
++ " do so.\n" | ||
++ "\n" | ||
++ "Compiler tools will be configured to see the same subset of the store" | ||
++ " that builds would see. The PATH is modified to make all executables in" | ||
++ " the dependency tree available (provided they have been built already)." | ||
++ " Commands are also rewritten in the way cabal itself would. For" | ||
++ " example, `" ++ pname ++ " new-exec ghc` will consult the configuration" | ||
++ " to choose an appropriate version of ghc and to include any" | ||
++ " ghc-specific flags requested." | ||
, commandNotes = Nothing | ||
} | ||
|
||
execAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) | ||
-> [String] -> GlobalFlags -> IO () | ||
execAction (configFlags, configExFlags, installFlags, haddockFlags) | ||
extraArgs globalFlags = do | ||
let verbosity = fromFlagOrDefault normal (configVerbosity configFlags) | ||
|
||
-- To set up the environment, we'd like to select the libraries in our | ||
-- dependency tree that we've already built. So first we set up an install | ||
-- plan, but we walk the dependency tree without first executing the plan. | ||
buildCtx <- runProjectPreBuildPhase | ||
verbosity | ||
(globalFlags, configFlags, configExFlags, installFlags, haddockFlags) | ||
PreBuildHooks | ||
{ hookPrePlanning = \_ _ _ -> return () | ||
, hookSelectPlanSubset = \_ -> return | ||
} | ||
|
||
-- We use the build status below to decide what libraries to include in the | ||
-- compiler environment, but we don't want to actually build anything. So we | ||
-- pass mempty to indicate that nothing happened and we just want the current | ||
-- status. | ||
buildStatus <- updatePostBuildProjectStatus | ||
verbosity | ||
(distDirLayout buildCtx) | ||
(elaboratedPlanToExecute buildCtx) | ||
(pkgsBuildStatus buildCtx) | ||
mempty | ||
|
||
-- Now that we have the packages, set up the environment. We accomplish this | ||
-- by creating an environment file that selects the databases and packages we | ||
-- computed in the previous step, and setting an environment variable to | ||
-- point at the file. | ||
withTempDirectory | ||
verbosity | ||
(distTempDirectory (distDirLayout buildCtx)) | ||
"environment." | ||
$ \tmpDir -> do | ||
envOverrides <- createPackageEnvironment | ||
verbosity | ||
tmpDir | ||
(elaboratedPlanToExecute buildCtx) | ||
(elaboratedShared buildCtx) | ||
buildStatus | ||
|
||
-- Some dependencies may have executables. Let's put those on the PATH. | ||
extraPaths <- pathAdditions verbosity buildCtx | ||
let programDb = modifyProgramSearchPath | ||
(map ProgramSearchPathDir extraPaths ++) | ||
. pkgConfigCompilerProgs | ||
. elaboratedShared | ||
$ buildCtx | ||
|
||
case extraArgs of | ||
exe:args -> do | ||
(program, _) <- requireProgram verbosity (simpleProgram exe) programDb | ||
let program' = withOverrides envOverrides program | ||
invocation = programInvocation program' args | ||
runProgramInvocation verbosity invocation | ||
[] -> die "Please specify an executable to run" | ||
where | ||
withOverrides env program = program | ||
{ programOverrideEnv = programOverrideEnv program ++ env } | ||
|
||
pathAdditions :: Verbosity -> ProjectBuildContext -> IO [FilePath] | ||
pathAdditions verbosity ProjectBuildContext{..} = do | ||
info verbosity . unlines $ "Including the following directories in PATH:" | ||
: paths | ||
return paths | ||
where | ||
paths = S.toList | ||
$ binDirectories distDirLayout elaboratedShared elaboratedPlanToExecute | ||
|
||
binDirectories | ||
:: DistDirLayout | ||
-> ElaboratedSharedConfig | ||
-> ElaboratedInstallPlan | ||
-> Set FilePath | ||
binDirectories layout config = fromElaboratedInstallPlan where | ||
fromElaboratedInstallPlan = fromGraph . toGraph | ||
fromGraph = foldMap fromPlan | ||
fromSrcPkg = S.fromList . Planning.binDirectories layout config | ||
|
||
fromPlan (PreExisting _) = mempty | ||
fromPlan (Configured pkg) = fromSrcPkg pkg | ||
fromPlan (Installed pkg) = fromSrcPkg pkg |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
If I wanted to be picky, I'd create a pure function to compute the envfile name, and then have
writeGhcEnvironmentFile
take the final filename to write it out to. You don't have to do this.