Skip to content

Commit bc7a7a4

Browse files
committed
Add a cabal target command
1 parent a6b1eb5 commit bc7a7a4

File tree

5 files changed

+220
-2
lines changed

5 files changed

+220
-2
lines changed

cabal-install/cabal-install.cabal

+1
Original file line numberDiff line numberDiff line change
@@ -105,6 +105,7 @@ library
105105
Distribution.Client.CmdRepl
106106
Distribution.Client.CmdRun
107107
Distribution.Client.CmdSdist
108+
Distribution.Client.CmdTarget
108109
Distribution.Client.CmdTest
109110
Distribution.Client.CmdUpdate
110111
Distribution.Client.Compat.Directory
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,155 @@
1+
{-# LANGUAGE NamedFieldPuns #-}
2+
{-# LANGUAGE OverloadedStrings #-}
3+
{-# LANGUAGE RecordWildCards #-}
4+
{-# LANGUAGE ScopedTypeVariables #-}
5+
{-# LANGUAGE TupleSections #-}
6+
{-# LANGUAGE ViewPatterns #-}
7+
8+
module Distribution.Client.CmdTarget
9+
( targetCommand
10+
, targetAction
11+
) where
12+
13+
import Distribution.Client.Compat.Prelude
14+
import Prelude ()
15+
16+
import qualified Data.Map as Map
17+
import Distribution.Client.CmdBuild (selectComponentTarget, selectPackageTargets)
18+
import Distribution.Client.CmdErrorMessages
19+
import Distribution.Client.Errors
20+
import Distribution.Client.NixStyleOptions
21+
( NixStyleFlags (..)
22+
, defaultNixStyleFlags
23+
)
24+
import Distribution.Client.ProjectOrchestration
25+
import Distribution.Client.ScriptUtils
26+
( AcceptNoTargets (..)
27+
, TargetContext (..)
28+
, updateContextAndWriteProjectFile
29+
, withContextAndSelectors
30+
)
31+
import Distribution.Client.Setup
32+
( ConfigFlags (..)
33+
, GlobalFlags
34+
)
35+
import Distribution.Client.TargetProblem
36+
( TargetProblem'
37+
)
38+
import Distribution.Simple.Command
39+
( CommandUI (..)
40+
, usageAlternatives
41+
)
42+
import Distribution.Simple.Flag (fromFlagOrDefault)
43+
import Distribution.Simple.Utils
44+
( dieWithException
45+
, wrapText
46+
)
47+
import Distribution.Verbosity
48+
( normal
49+
)
50+
51+
-------------------------------------------------------------------------------
52+
-- Command
53+
-------------------------------------------------------------------------------
54+
55+
targetCommand :: CommandUI (NixStyleFlags ())
56+
targetCommand =
57+
CommandUI
58+
{ commandName = "v2-target"
59+
, commandSynopsis = "List target forms within the project."
60+
, commandUsage = usageAlternatives "v2-target" ["[TARGETS]"]
61+
, commandDescription = Just $ \_ ->
62+
wrapText $
63+
"List targets within a build plan. "
64+
++ "If no [TARGETS] are given 'all' will be used for selecting a build plan.\n\n"
65+
++ "The given target can be;\n"
66+
++ "- a package target (e.g. [pkg:]package)\n"
67+
++ "- a component target (e.g. [package:][ctype:]component)\n"
68+
++ "- all packages (e.g. all)\n"
69+
++ "- components of a particular type (e.g. package:ctypes or all:ctypes)\n"
70+
++ "- a module target: (e.g. [package:][ctype:]module)\n"
71+
++ "- a filepath target: (e.g. [package:][ctype:]filepath)\n"
72+
++ "- a script target: (e.g. path/to/script)\n\n"
73+
++ "The ctypes can be one of: "
74+
++ "libs or libraries, "
75+
++ "exes or executables, "
76+
++ "tests, "
77+
++ "benches or benchmarks, "
78+
++ " and flibs or foreign-libraries."
79+
, commandNotes = Just $ \pname ->
80+
"Examples:\n"
81+
++ " "
82+
++ pname
83+
++ " v2-target all\n"
84+
++ " List all targets of the package in the current directory "
85+
++ "or all packages in the project\n"
86+
++ " "
87+
++ pname
88+
++ " v2-target pkgname\n"
89+
++ " List targets of the package named pkgname in the project\n"
90+
++ " "
91+
++ pname
92+
++ " v2-target ./pkgfoo\n"
93+
++ " List targets of the package in the ./pkgfoo directory\n"
94+
++ " "
95+
++ pname
96+
++ " v2-target cname\n"
97+
++ " List targets of the component named cname in the project\n"
98+
++ " "
99+
, commandDefaultFlags = defaultNixStyleFlags ()
100+
, commandOptions = const []
101+
}
102+
103+
-------------------------------------------------------------------------------
104+
-- Action
105+
-------------------------------------------------------------------------------
106+
107+
targetAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO ()
108+
targetAction flags@NixStyleFlags{..} ts globalFlags = do
109+
let targetStrings = if null ts then ["all"] else ts
110+
withContextAndSelectors RejectNoTargets Nothing flags targetStrings globalFlags BuildCommand $ \targetCtx ctx targetSelectors -> do
111+
baseCtx <- case targetCtx of
112+
ProjectContext -> return ctx
113+
GlobalContext -> return ctx
114+
ScriptContext path exemeta -> updateContextAndWriteProjectFile ctx path exemeta
115+
116+
buildCtx <-
117+
runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do
118+
-- Interpret the targets on the command line as build targets
119+
-- (as opposed to say repl or haddock targets).
120+
targets <-
121+
either (reportBuildTargetProblems verbosity) return $
122+
resolveTargets
123+
selectPackageTargets
124+
selectComponentTarget
125+
elaboratedPlan
126+
Nothing
127+
targetSelectors
128+
129+
let elaboratedPlan' =
130+
pruneInstallPlanToTargets
131+
TargetActionConfigure
132+
targets
133+
elaboratedPlan
134+
elaboratedPlan'' <-
135+
if buildSettingOnlyDeps (buildSettings baseCtx)
136+
then
137+
either (reportCannotPruneDependencies verbosity) return $
138+
pruneInstallPlanToDependencies
139+
(Map.keysSet targets)
140+
elaboratedPlan'
141+
else return elaboratedPlan'
142+
143+
return (elaboratedPlan'', targets)
144+
145+
printPlanTargetForms verbosity buildCtx
146+
where
147+
verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
148+
149+
reportBuildTargetProblems :: Verbosity -> [TargetProblem'] -> IO a
150+
reportBuildTargetProblems verbosity problems =
151+
reportTargetProblems verbosity "target" problems
152+
153+
reportCannotPruneDependencies :: Verbosity -> CannotPruneDependencies -> IO a
154+
reportCannotPruneDependencies verbosity =
155+
dieWithException verbosity . ReportCannotPruneDependencies . renderCannotPruneDependencies

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

+2
Original file line numberDiff line numberDiff line change
@@ -135,6 +135,7 @@ import qualified Distribution.Client.CmdPath as CmdPath
135135
import qualified Distribution.Client.CmdRepl as CmdRepl
136136
import qualified Distribution.Client.CmdRun as CmdRun
137137
import qualified Distribution.Client.CmdSdist as CmdSdist
138+
import qualified Distribution.Client.CmdTarget as CmdTarget
138139
import qualified Distribution.Client.CmdTest as CmdTest
139140
import qualified Distribution.Client.CmdUpdate as CmdUpdate
140141

@@ -455,6 +456,7 @@ mainWorker args = do
455456
, newCmd CmdExec.execCommand CmdExec.execAction
456457
, newCmd CmdClean.cleanCommand CmdClean.cleanAction
457458
, newCmd CmdSdist.sdistCommand CmdSdist.sdistAction
459+
, newCmd CmdTarget.targetCommand CmdTarget.targetAction
458460
, legacyCmd configureExCommand configureAction
459461
, legacyCmd buildCommand buildAction
460462
, legacyCmd replCommand replAction

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

+57-1
Original file line numberDiff line numberDiff line change
@@ -90,6 +90,7 @@ module Distribution.Client.ProjectOrchestration
9090
, pruneInstallPlanToDependencies
9191
, CannotPruneDependencies (..)
9292
, printPlan
93+
, printPlanTargetForms
9394

9495
-- * Build phase: now do it.
9596
, runProjectBuildPhase
@@ -934,7 +935,62 @@ distinctTargetComponents targetsMap =
934935

935936
------------------------------------------------------------------------------
936937
-- Displaying what we plan to do
937-
--
938+
939+
-- | Print available target forms.
940+
printPlanTargetForms
941+
:: Verbosity
942+
-> ProjectBuildContext
943+
-> IO ()
944+
printPlanTargetForms
945+
verbosity
946+
ProjectBuildContext{elaboratedPlanToExecute = elaboratedPlan}
947+
| not (null pkgs) = noticeNoWrap verbosity . unlines $ map showPkgAndReason pkgs
948+
| otherwise = return ()
949+
where
950+
pkgs :: [GenericReadyPackage ElaboratedConfiguredPackage]
951+
pkgs =
952+
sortBy
953+
(compare `on` showPkgAndReason)
954+
(InstallPlan.executionOrder elaboratedPlan)
955+
956+
showPkgAndReason :: ElaboratedReadyPackage -> String
957+
showPkgAndReason (ReadyPackage elab) =
958+
unwords $
959+
filter (not . null) $
960+
[ " -"
961+
, concat . filter (not . null) $
962+
[ prettyShow $ packageName (packageId elab)
963+
, case elabPkgOrComp elab of
964+
ElabPackage _ -> showTargets elab
965+
ElabComponent comp -> ":" ++ showComp elab comp
966+
]
967+
]
968+
969+
showComp :: ElaboratedConfiguredPackage -> ElaboratedComponent -> String
970+
showComp elab comp =
971+
maybe "custom" prettyShow (compComponentName comp)
972+
++ if Map.null (elabInstantiatedWith elab)
973+
then ""
974+
else
975+
" with "
976+
++ intercalate
977+
", "
978+
-- TODO: Abbreviate the UnitIds
979+
[ prettyShow k ++ "=" ++ prettyShow v
980+
| (k, v) <- Map.toList (elabInstantiatedWith elab)
981+
]
982+
983+
showTargets :: ElaboratedConfiguredPackage -> String
984+
showTargets elab
985+
| null (elabBuildTargets elab) = ""
986+
| otherwise =
987+
"("
988+
++ intercalate
989+
", "
990+
[ showComponentTarget (packageId elab) t
991+
| t <- elabBuildTargets elab
992+
]
993+
++ ")"
938994

939995
-- | Print a user-oriented presentation of the install plan, indicating what
940996
-- will be built.

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

+5-1
Original file line numberDiff line numberDiff line change
@@ -275,6 +275,7 @@ globalCommand commands =
275275
, "unpack"
276276
, "init"
277277
, "configure"
278+
, "target"
278279
, "build"
279280
, "clean"
280281
, "run"
@@ -327,7 +328,8 @@ globalCommand commands =
327328
, "v1-register"
328329
, "v1-reconfigure"
329330
, -- v2 commands, nix-style
330-
"v2-build"
331+
"v2-target"
332+
, "v2-build"
331333
, "v2-configure"
332334
, "v2-repl"
333335
, "v2-freeze"
@@ -381,6 +383,7 @@ globalCommand commands =
381383
, addCmd "clean"
382384
, par
383385
, startGroup "running and testing"
386+
, addCmd "target"
384387
, addCmd "list-bin"
385388
, addCmd "repl"
386389
, addCmd "run"
@@ -399,6 +402,7 @@ globalCommand commands =
399402
, addCmd "hscolour"
400403
, par
401404
, startGroup "new-style projects (forwards-compatible aliases)"
405+
, addCmd "v2-target"
402406
, addCmd "v2-build"
403407
, addCmd "v2-configure"
404408
, addCmd "v2-repl"

0 commit comments

Comments
 (0)