-
Notifications
You must be signed in to change notification settings - Fork 691
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
Add a cabal target command #9744
Open
philderbeast
wants to merge
2
commits into
haskell:master
Choose a base branch
from
cabalism:add/command-target
base: master
Could not load branches
Branch not found: {{ refName }}
Loading
Could not load tags
Nothing to show
Loading
Are you sure you want to change the base?
Some commits from the old base branch may be removed from the timeline,
and old review comments may become outdated.
Open
Changes from all commits
Commits
Show all changes
2 commits
Select commit
Hold shift + click to select a range
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,155 @@ | ||
{-# LANGUAGE NamedFieldPuns #-} | ||
{-# LANGUAGE OverloadedStrings #-} | ||
{-# LANGUAGE RecordWildCards #-} | ||
{-# LANGUAGE ScopedTypeVariables #-} | ||
{-# LANGUAGE TupleSections #-} | ||
{-# LANGUAGE ViewPatterns #-} | ||
|
||
module Distribution.Client.CmdTarget | ||
( targetCommand | ||
, targetAction | ||
) where | ||
|
||
import Distribution.Client.Compat.Prelude | ||
import Prelude () | ||
|
||
import qualified Data.Map as Map | ||
import Distribution.Client.CmdBuild (selectComponentTarget, selectPackageTargets) | ||
import Distribution.Client.CmdErrorMessages | ||
import Distribution.Client.Errors | ||
import Distribution.Client.NixStyleOptions | ||
( NixStyleFlags (..) | ||
, defaultNixStyleFlags | ||
) | ||
import Distribution.Client.ProjectOrchestration | ||
import Distribution.Client.ScriptUtils | ||
( AcceptNoTargets (..) | ||
, TargetContext (..) | ||
, updateContextAndWriteProjectFile | ||
, withContextAndSelectors | ||
) | ||
import Distribution.Client.Setup | ||
( ConfigFlags (..) | ||
, GlobalFlags | ||
) | ||
import Distribution.Client.TargetProblem | ||
( TargetProblem' | ||
) | ||
import Distribution.Simple.Command | ||
( CommandUI (..) | ||
, usageAlternatives | ||
) | ||
import Distribution.Simple.Flag (fromFlagOrDefault) | ||
import Distribution.Simple.Utils | ||
( dieWithException | ||
, wrapText | ||
) | ||
import Distribution.Verbosity | ||
( normal | ||
) | ||
|
||
------------------------------------------------------------------------------- | ||
-- Command | ||
------------------------------------------------------------------------------- | ||
|
||
targetCommand :: CommandUI (NixStyleFlags ()) | ||
targetCommand = | ||
CommandUI | ||
{ commandName = "v2-target" | ||
, commandSynopsis = "Target disclosure." | ||
, commandUsage = usageAlternatives "v2-target" ["[TARGETS]"] | ||
, commandDescription = Just $ \_ -> | ||
wrapText $ | ||
"Reveal the targets of build plan. " | ||
++ "If no [TARGETS] are given 'all' will be used for selecting a build plan.\n\n" | ||
++ "A [TARGETS] item can be one of these target forms;\n" | ||
++ "- a package target (e.g. [pkg:]package)\n" | ||
++ "- a component target (e.g. [package:][ctype:]component)\n" | ||
++ "- all packages (e.g. all)\n" | ||
++ "- components of a particular type (e.g. package:ctypes or all:ctypes)\n" | ||
++ "- a module target: (e.g. [package:][ctype:]module)\n" | ||
++ "- a filepath target: (e.g. [package:][ctype:]filepath)\n" | ||
++ "- a script target: (e.g. path/to/script)\n\n" | ||
++ "The ctypes can be one of: " | ||
++ "libs or libraries, " | ||
++ "exes or executables, " | ||
++ "tests, " | ||
++ "benches or benchmarks, " | ||
++ " and flibs or foreign-libraries." | ||
, commandNotes = Just $ \pname -> | ||
"Examples:\n" | ||
++ " " | ||
++ pname | ||
++ " v2-target all\n" | ||
++ " Targets of the package in the current directory " | ||
++ "or all packages in the project\n" | ||
++ " " | ||
++ pname | ||
++ " v2-target pkgname\n" | ||
++ " Targets of the package named pkgname in the project\n" | ||
++ " " | ||
++ pname | ||
++ " v2-target ./pkgfoo\n" | ||
++ " Targets of the package in the ./pkgfoo directory\n" | ||
++ " " | ||
++ pname | ||
++ " v2-target cname\n" | ||
++ " Targets of the component named cname in the project\n" | ||
++ " " | ||
, commandDefaultFlags = defaultNixStyleFlags () | ||
, commandOptions = const [] | ||
} | ||
|
||
------------------------------------------------------------------------------- | ||
-- Action | ||
------------------------------------------------------------------------------- | ||
|
||
targetAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO () | ||
targetAction flags@NixStyleFlags{..} ts globalFlags = do | ||
let targetStrings = if null ts then ["all"] else ts | ||
withContextAndSelectors RejectNoTargets Nothing flags targetStrings globalFlags BuildCommand $ \targetCtx ctx targetSelectors -> do | ||
baseCtx <- case targetCtx of | ||
ProjectContext -> return ctx | ||
GlobalContext -> return ctx | ||
ScriptContext path exemeta -> updateContextAndWriteProjectFile ctx path exemeta | ||
|
||
buildCtx <- | ||
runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do | ||
-- Interpret the targets on the command line as build targets | ||
-- (as opposed to say repl or haddock targets). | ||
targets <- | ||
either (reportBuildTargetProblems verbosity) return $ | ||
resolveTargets | ||
selectPackageTargets | ||
selectComponentTarget | ||
elaboratedPlan | ||
Nothing | ||
targetSelectors | ||
|
||
let elaboratedPlan' = | ||
pruneInstallPlanToTargets | ||
TargetActionConfigure | ||
targets | ||
elaboratedPlan | ||
elaboratedPlan'' <- | ||
if buildSettingOnlyDeps (buildSettings baseCtx) | ||
then | ||
either (reportCannotPruneDependencies verbosity) return $ | ||
pruneInstallPlanToDependencies | ||
(Map.keysSet targets) | ||
elaboratedPlan' | ||
else return elaboratedPlan' | ||
|
||
return (elaboratedPlan'', targets) | ||
|
||
printPlanTargetForms verbosity buildCtx | ||
where | ||
verbosity = fromFlagOrDefault normal (configVerbosity configFlags) | ||
|
||
reportBuildTargetProblems :: Verbosity -> [TargetProblem'] -> IO a | ||
reportBuildTargetProblems verbosity problems = | ||
reportTargetProblems verbosity "target" problems | ||
|
||
reportCannotPruneDependencies :: Verbosity -> CannotPruneDependencies -> IO a | ||
reportCannotPruneDependencies verbosity = | ||
dieWithException verbosity . ReportCannotPruneDependencies . renderCannotPruneDependencies |
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 |
---|---|---|
|
@@ -90,6 +90,7 @@ module Distribution.Client.ProjectOrchestration | |
, pruneInstallPlanToDependencies | ||
, CannotPruneDependencies (..) | ||
, printPlan | ||
, printPlanTargetForms | ||
|
||
-- * Build phase: now do it. | ||
, runProjectBuildPhase | ||
|
@@ -934,7 +935,62 @@ distinctTargetComponents targetsMap = | |
|
||
------------------------------------------------------------------------------ | ||
-- Displaying what we plan to do | ||
-- | ||
|
||
-- | Print available target forms. | ||
printPlanTargetForms | ||
:: Verbosity | ||
-> ProjectBuildContext | ||
-> IO () | ||
printPlanTargetForms | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. This function shows every single single component in E.g.
|
||
verbosity | ||
ProjectBuildContext{elaboratedPlanToExecute = elaboratedPlan} | ||
| not (null pkgs) = noticeNoWrap verbosity . unlines $ map showPkgAndReason pkgs | ||
| otherwise = return () | ||
where | ||
pkgs :: [GenericReadyPackage ElaboratedConfiguredPackage] | ||
pkgs = | ||
sortBy | ||
(compare `on` showPkgAndReason) | ||
(InstallPlan.executionOrder elaboratedPlan) | ||
|
||
showPkgAndReason :: ElaboratedReadyPackage -> String | ||
showPkgAndReason (ReadyPackage elab) = | ||
unwords $ | ||
filter (not . null) $ | ||
[ " -" | ||
, concat . filter (not . null) $ | ||
[ prettyShow $ packageName (packageId elab) | ||
, case elabPkgOrComp elab of | ||
ElabPackage _ -> showTargets elab | ||
ElabComponent comp -> ":" ++ showComp elab comp | ||
] | ||
] | ||
|
||
showComp :: ElaboratedConfiguredPackage -> ElaboratedComponent -> String | ||
showComp elab comp = | ||
maybe "custom" prettyShow (compComponentName comp) | ||
++ if Map.null (elabInstantiatedWith elab) | ||
then "" | ||
else | ||
" with " | ||
++ intercalate | ||
", " | ||
-- TODO: Abbreviate the UnitIds | ||
[ prettyShow k ++ "=" ++ prettyShow v | ||
| (k, v) <- Map.toList (elabInstantiatedWith elab) | ||
] | ||
|
||
showTargets :: ElaboratedConfiguredPackage -> String | ||
showTargets elab | ||
| null (elabBuildTargets elab) = "" | ||
| otherwise = | ||
"(" | ||
++ intercalate | ||
", " | ||
[ showComponentTarget (packageId elab) t | ||
| t <- elabBuildTargets elab | ||
] | ||
++ ")" | ||
|
||
-- | Print a user-oriented presentation of the install plan, indicating what | ||
-- will be built. | ||
|
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.
Here you require (
RejectNoTargets
) a list of target selectors.Why?I would think a command to list targets does not need targets to be specified.
If you want to just list the targets you probably do not need all most of this function, but only the elaborated plan.
withContextAndSelectors
is what powerscabal run myscript.hs
unless you want to supportcabal target myscript.hs
you won't need it. If you do not use it,cabal target
will only work in a project context. This is what I would expect.runProjectPreBuildPhase
rebuilds the project plan and then uses the function you pass to trim it down to only the required targets. Again, if you just want to list the available targets, you don't need to trim anything. Also it marks the up-to-date targets as 'installed', which means you won't get them fromInstallPlan.executionOrder
.