From f95bec5f029c3996d611047bc1c741d490680a5d Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Mon, 26 Feb 2024 09:56:19 -0500 Subject: [PATCH 01/39] Add a cabal target command --- cabal-install/cabal-install.cabal | 1 + .../src/Distribution/Client/CmdTarget.hs | 155 ++++++++++++++++++ cabal-install/src/Distribution/Client/Main.hs | 2 + .../Client/ProjectOrchestration.hs | 58 ++++++- .../src/Distribution/Client/Setup.hs | 6 +- 5 files changed, 220 insertions(+), 2 deletions(-) create mode 100644 cabal-install/src/Distribution/Client/CmdTarget.hs diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index cef5fbd8277..94080878afa 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -110,6 +110,7 @@ library Distribution.Client.CmdRepl Distribution.Client.CmdRun Distribution.Client.CmdSdist + Distribution.Client.CmdTarget Distribution.Client.CmdTest Distribution.Client.CmdUpdate Distribution.Client.Compat.Directory diff --git a/cabal-install/src/Distribution/Client/CmdTarget.hs b/cabal-install/src/Distribution/Client/CmdTarget.hs new file mode 100644 index 00000000000..c59e20957ce --- /dev/null +++ b/cabal-install/src/Distribution/Client/CmdTarget.hs @@ -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 = "List target forms within the project." + , commandUsage = usageAlternatives "v2-target" ["[TARGETS]"] + , commandDescription = Just $ \_ -> + wrapText $ + "List targets within a build plan. " + ++ "If no [TARGETS] are given 'all' will be used for selecting a build plan.\n\n" + ++ "The given target can be;\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" + ++ " List all targets of the package in the current directory " + ++ "or all packages in the project\n" + ++ " " + ++ pname + ++ " v2-target pkgname\n" + ++ " List targets of the package named pkgname in the project\n" + ++ " " + ++ pname + ++ " v2-target ./pkgfoo\n" + ++ " List targets of the package in the ./pkgfoo directory\n" + ++ " " + ++ pname + ++ " v2-target cname\n" + ++ " List 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 diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index 2f191676c65..228583a0ed3 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -135,6 +135,7 @@ import qualified Distribution.Client.CmdPath as CmdPath import qualified Distribution.Client.CmdRepl as CmdRepl import qualified Distribution.Client.CmdRun as CmdRun import qualified Distribution.Client.CmdSdist as CmdSdist +import qualified Distribution.Client.CmdTarget as CmdTarget import qualified Distribution.Client.CmdTest as CmdTest import qualified Distribution.Client.CmdUpdate as CmdUpdate @@ -465,6 +466,7 @@ mainWorker args = do , newCmd CmdExec.execCommand CmdExec.execAction , newCmd CmdClean.cleanCommand CmdClean.cleanAction , newCmd CmdSdist.sdistCommand CmdSdist.sdistAction + , newCmd CmdTarget.targetCommand CmdTarget.targetAction , legacyCmd configureExCommand configureAction , legacyCmd buildCommand buildAction , legacyCmd replCommand replAction diff --git a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs index fef9f6efde4..00bdd280754 100644 --- a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs +++ b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs @@ -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 + 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. diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs index c68f0dec44a..3de844a97d9 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/cabal-install/src/Distribution/Client/Setup.hs @@ -282,6 +282,7 @@ globalCommand commands = , "unpack" , "init" , "configure" + , "target" , "build" , "clean" , "run" @@ -334,7 +335,8 @@ globalCommand commands = , "v1-register" , "v1-reconfigure" , -- v2 commands, nix-style - "v2-build" + "v2-target" + , "v2-build" , "v2-configure" , "v2-repl" , "v2-freeze" @@ -388,6 +390,7 @@ globalCommand commands = , addCmd "clean" , par , startGroup "running and testing" + , addCmd "target" , addCmd "list-bin" , addCmd "repl" , addCmd "run" @@ -406,6 +409,7 @@ globalCommand commands = , addCmd "hscolour" , par , startGroup "new-style projects (forwards-compatible aliases)" + , addCmd "v2-target" , addCmd "v2-build" , addCmd "v2-configure" , addCmd "v2-repl" From 61462c38a71387efbbe5a2a04a93a8b615401282 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 28 Feb 2024 09:09:49 -0500 Subject: [PATCH 02/39] Avoid list in the help --- cabal-install/src/Distribution/Client/CmdTarget.hs | 14 +++++++------- cabal-install/src/Distribution/Client/Setup.hs | 2 +- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdTarget.hs b/cabal-install/src/Distribution/Client/CmdTarget.hs index c59e20957ce..47b2e3ab756 100644 --- a/cabal-install/src/Distribution/Client/CmdTarget.hs +++ b/cabal-install/src/Distribution/Client/CmdTarget.hs @@ -56,13 +56,13 @@ targetCommand :: CommandUI (NixStyleFlags ()) targetCommand = CommandUI { commandName = "v2-target" - , commandSynopsis = "List target forms within the project." + , commandSynopsis = "Target disclosure." , commandUsage = usageAlternatives "v2-target" ["[TARGETS]"] , commandDescription = Just $ \_ -> wrapText $ - "List targets within a build plan. " + "Reveal the targets of build plan. " ++ "If no [TARGETS] are given 'all' will be used for selecting a build plan.\n\n" - ++ "The given target can be;\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" @@ -81,20 +81,20 @@ targetCommand = ++ " " ++ pname ++ " v2-target all\n" - ++ " List all targets of the package in the current directory " + ++ " Targets of the package in the current directory " ++ "or all packages in the project\n" ++ " " ++ pname ++ " v2-target pkgname\n" - ++ " List targets of the package named pkgname in the project\n" + ++ " Targets of the package named pkgname in the project\n" ++ " " ++ pname ++ " v2-target ./pkgfoo\n" - ++ " List targets of the package in the ./pkgfoo directory\n" + ++ " Targets of the package in the ./pkgfoo directory\n" ++ " " ++ pname ++ " v2-target cname\n" - ++ " List targets of the component named cname in the project\n" + ++ " Targets of the component named cname in the project\n" ++ " " , commandDefaultFlags = defaultNixStyleFlags () , commandOptions = const [] diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs index 3de844a97d9..8e5494477cd 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/cabal-install/src/Distribution/Client/Setup.hs @@ -383,6 +383,7 @@ globalCommand commands = , addCmd "path" , par , startGroup "project building and installing" + , addCmd "target" , addCmd "build" , addCmd "install" , addCmd "haddock" @@ -390,7 +391,6 @@ globalCommand commands = , addCmd "clean" , par , startGroup "running and testing" - , addCmd "target" , addCmd "list-bin" , addCmd "repl" , addCmd "run" From d4b5b581476896bdeda2bd875ba24e25c56abbbf Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Mon, 30 Dec 2024 14:05:48 -0500 Subject: [PATCH 03/39] Use establishProjectBaseContext - Remove withContextAndSelectors --- .../src/Distribution/Client/CmdTarget.hs | 79 +++++++++---------- 1 file changed, 37 insertions(+), 42 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdTarget.hs b/cabal-install/src/Distribution/Client/CmdTarget.hs index 47b2e3ab756..7d71cd299ec 100644 --- a/cabal-install/src/Distribution/Client/CmdTarget.hs +++ b/cabal-install/src/Distribution/Client/CmdTarget.hs @@ -1,9 +1,6 @@ -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE ViewPatterns #-} module Distribution.Client.CmdTarget ( targetCommand @@ -22,12 +19,6 @@ import Distribution.Client.NixStyleOptions , defaultNixStyleFlags ) import Distribution.Client.ProjectOrchestration -import Distribution.Client.ScriptUtils - ( AcceptNoTargets (..) - , TargetContext (..) - , updateContextAndWriteProjectFile - , withContextAndSelectors - ) import Distribution.Client.Setup ( ConfigFlags (..) , GlobalFlags @@ -106,45 +97,49 @@ targetCommand = 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 + baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand + + targetSelectors <- + either (reportTargetSelectorProblems verbosity) return + =<< readTargetSelectors (localPackages baseCtx) Nothing targetStrings - 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 + 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' + 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) + return (elaboratedPlan'', targets) - printPlanTargetForms verbosity buildCtx + printPlanTargetForms verbosity buildCtx where verbosity = fromFlagOrDefault normal (configVerbosity configFlags) + targetStrings = if null ts then ["all"] else ts + cliConfig = + commandLineFlagsToProjectConfig + globalFlags + flags + mempty -- ClientInstallFlags, not needed here reportBuildTargetProblems :: Verbosity -> [TargetProblem'] -> IO a reportBuildTargetProblems verbosity problems = From 9e20fc9993c38091dea8c1203103c39f7b08ce10 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Tue, 31 Dec 2024 07:48:37 -0500 Subject: [PATCH 04/39] Use rebuildInstallPlan and resolveTargets --- .../src/Distribution/Client/CmdTarget.hs | 89 +++++++++++-------- 1 file changed, 52 insertions(+), 37 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdTarget.hs b/cabal-install/src/Distribution/Client/CmdTarget.hs index 7d71cd299ec..1b46a9121d4 100644 --- a/cabal-install/src/Distribution/Client/CmdTarget.hs +++ b/cabal-install/src/Distribution/Client/CmdTarget.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -13,12 +14,14 @@ 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.InstallPlan +import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Client.NixStyleOptions ( NixStyleFlags (..) , defaultNixStyleFlags ) import Distribution.Client.ProjectOrchestration +import Distribution.Client.ProjectPlanning import Distribution.Client.Setup ( ConfigFlags (..) , GlobalFlags @@ -26,18 +29,20 @@ import Distribution.Client.Setup import Distribution.Client.TargetProblem ( TargetProblem' ) +import Distribution.Package import Distribution.Simple.Command ( CommandUI (..) , usageAlternatives ) import Distribution.Simple.Flag (fromFlagOrDefault) import Distribution.Simple.Utils - ( dieWithException - , wrapText + ( wrapText ) import Distribution.Verbosity ( normal ) +import Text.PrettyPrint +import qualified Text.PrettyPrint as Pretty ------------------------------------------------------------------------------- -- Command @@ -97,41 +102,37 @@ targetCommand = targetAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO () targetAction flags@NixStyleFlags{..} ts globalFlags = do - baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand + ProjectBaseContext + { distDirLayout + , cabalDirLayout + , projectConfig + , localPackages + } <- + establishProjectBaseContext verbosity cliConfig OtherCommand + + (_, elaboratedPlan, _, _, _) <- + rebuildInstallPlan + verbosity + distDirLayout + cabalDirLayout + projectConfig + localPackages + Nothing targetSelectors <- either (reportTargetSelectorProblems verbosity) return - =<< readTargetSelectors (localPackages baseCtx) Nothing targetStrings - - 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' + =<< readTargetSelectors localPackages Nothing targetStrings - return (elaboratedPlan'', targets) + targets :: TargetsMap <- + either (reportBuildTargetProblems verbosity) return $ + resolveTargets + selectPackageTargets + selectComponentTarget + elaboratedPlan + Nothing + targetSelectors - printPlanTargetForms verbosity buildCtx + printTargetForms targets elaboratedPlan where verbosity = fromFlagOrDefault normal (configVerbosity configFlags) targetStrings = if null ts then ["all"] else ts @@ -139,12 +140,26 @@ targetAction flags@NixStyleFlags{..} ts globalFlags = do commandLineFlagsToProjectConfig globalFlags flags - mempty -- ClientInstallFlags, not needed here + mempty reportBuildTargetProblems :: Verbosity -> [TargetProblem'] -> IO a reportBuildTargetProblems verbosity problems = reportTargetProblems verbosity "target" problems -reportCannotPruneDependencies :: Verbosity -> CannotPruneDependencies -> IO a -reportCannotPruneDependencies verbosity = - dieWithException verbosity . ReportCannotPruneDependencies . renderCannotPruneDependencies +printTargetForms :: TargetsMap -> ElaboratedInstallPlan -> IO () +printTargetForms targets elaboratedPlan = do + putStrLn . render . nest 1 . vcat . ((text "-" <+>) . text <$>) . sort $ + catMaybes + [ targetForm ct pkgs + | (u :: UnitId, xs) <- Map.toAscList targets + , (ct :: ComponentTarget, _) <- xs + , let pkgs = filter ((== u) . elabUnitId) localPkgs + ] + where + localPkgs = + [x | Configured x@ElaboratedConfiguredPackage{elabLocalToProject = True} <- InstallPlan.toList elaboratedPlan] + + targetForm _ [] = Nothing + targetForm ct (x : _) = + let pkgId@PackageIdentifier{pkgName = n} = elabPkgSourceId x + in Just . render $ pretty n Pretty.<> colon Pretty.<> text (showComponentTarget pkgId ct) From c2decc7f4e20d98134959cdaac29e175dc915db5 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Tue, 31 Dec 2024 07:58:28 -0500 Subject: [PATCH 05/39] Extract targetForms --- .../src/Distribution/Client/CmdTarget.hs | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdTarget.hs b/cabal-install/src/Distribution/Client/CmdTarget.hs index 1b46a9121d4..d396c9f7b41 100644 --- a/cabal-install/src/Distribution/Client/CmdTarget.hs +++ b/cabal-install/src/Distribution/Client/CmdTarget.hs @@ -148,12 +148,10 @@ reportBuildTargetProblems verbosity problems = printTargetForms :: TargetsMap -> ElaboratedInstallPlan -> IO () printTargetForms targets elaboratedPlan = do - putStrLn . render . nest 1 . vcat . ((text "-" <+>) . text <$>) . sort $ - catMaybes - [ targetForm ct pkgs - | (u :: UnitId, xs) <- Map.toAscList targets - , (ct :: ComponentTarget, _) <- xs - , let pkgs = filter ((== u) . elabUnitId) localPkgs + putStrLn . render $ + vcat + [ text "Fully qualified target forms" Pretty.<> colon + , nest 1 $ vcat [text "-" <+> text tf | tf <- targetForms] ] where localPkgs = @@ -163,3 +161,12 @@ printTargetForms targets elaboratedPlan = do targetForm ct (x : _) = let pkgId@PackageIdentifier{pkgName = n} = elabPkgSourceId x in Just . render $ pretty n Pretty.<> colon Pretty.<> text (showComponentTarget pkgId ct) + + targetForms = + sort $ + catMaybes + [ targetForm ct pkgs + | (u :: UnitId, xs) <- Map.toAscList targets + , (ct :: ComponentTarget, _) <- xs + , let pkgs = filter ((== u) . elabUnitId) localPkgs + ] From fd4255560f1e5c42ff24be886e35a66c5d63dcdf Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Tue, 31 Dec 2024 08:00:44 -0500 Subject: [PATCH 06/39] Satisfy hlint --- cabal-install/src/Distribution/Client/CmdTarget.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdTarget.hs b/cabal-install/src/Distribution/Client/CmdTarget.hs index d396c9f7b41..4f09a4063a5 100644 --- a/cabal-install/src/Distribution/Client/CmdTarget.hs +++ b/cabal-install/src/Distribution/Client/CmdTarget.hs @@ -143,8 +143,7 @@ targetAction flags@NixStyleFlags{..} ts globalFlags = do mempty reportBuildTargetProblems :: Verbosity -> [TargetProblem'] -> IO a -reportBuildTargetProblems verbosity problems = - reportTargetProblems verbosity "target" problems +reportBuildTargetProblems verbosity = reportTargetProblems verbosity "target" printTargetForms :: TargetsMap -> ElaboratedInstallPlan -> IO () printTargetForms targets elaboratedPlan = do @@ -167,6 +166,6 @@ printTargetForms targets elaboratedPlan = do catMaybes [ targetForm ct pkgs | (u :: UnitId, xs) <- Map.toAscList targets - , (ct :: ComponentTarget, _) <- xs , let pkgs = filter ((== u) . elabUnitId) localPkgs + , (ct :: ComponentTarget, _) <- xs ] From 00b5c1b4906e4783200ca370dae5675d3adda247 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Tue, 31 Dec 2024 12:59:24 -0500 Subject: [PATCH 07/39] Remove unnecessary do --- cabal-install/src/Distribution/Client/CmdTarget.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal-install/src/Distribution/Client/CmdTarget.hs b/cabal-install/src/Distribution/Client/CmdTarget.hs index 4f09a4063a5..8cfecc1fdac 100644 --- a/cabal-install/src/Distribution/Client/CmdTarget.hs +++ b/cabal-install/src/Distribution/Client/CmdTarget.hs @@ -146,7 +146,7 @@ reportBuildTargetProblems :: Verbosity -> [TargetProblem'] -> IO a reportBuildTargetProblems verbosity = reportTargetProblems verbosity "target" printTargetForms :: TargetsMap -> ElaboratedInstallPlan -> IO () -printTargetForms targets elaboratedPlan = do +printTargetForms targets elaboratedPlan = putStrLn . render $ vcat [ text "Fully qualified target forms" Pretty.<> colon From 95f3560159bdfc029b0d122ca8d62a654f94b823 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Tue, 31 Dec 2024 13:05:54 -0500 Subject: [PATCH 08/39] Use safeHead --- cabal-install/src/Distribution/Client/CmdTarget.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdTarget.hs b/cabal-install/src/Distribution/Client/CmdTarget.hs index 8cfecc1fdac..4580e142118 100644 --- a/cabal-install/src/Distribution/Client/CmdTarget.hs +++ b/cabal-install/src/Distribution/Client/CmdTarget.hs @@ -36,7 +36,8 @@ import Distribution.Simple.Command ) import Distribution.Simple.Flag (fromFlagOrDefault) import Distribution.Simple.Utils - ( wrapText + ( safeHead + , wrapText ) import Distribution.Verbosity ( normal @@ -156,16 +157,15 @@ printTargetForms targets elaboratedPlan = localPkgs = [x | Configured x@ElaboratedConfiguredPackage{elabLocalToProject = True} <- InstallPlan.toList elaboratedPlan] - targetForm _ [] = Nothing - targetForm ct (x : _) = + targetForm ct x = let pkgId@PackageIdentifier{pkgName = n} = elabPkgSourceId x - in Just . render $ pretty n Pretty.<> colon Pretty.<> text (showComponentTarget pkgId ct) + in render $ pretty n Pretty.<> colon Pretty.<> text (showComponentTarget pkgId ct) targetForms = sort $ catMaybes - [ targetForm ct pkgs + [ targetForm ct <$> pkg | (u :: UnitId, xs) <- Map.toAscList targets - , let pkgs = filter ((== u) . elabUnitId) localPkgs + , let pkg = safeHead $ filter ((== u) . elabUnitId) localPkgs , (ct :: ComponentTarget, _) <- xs ] From 6cb423ef9012a8476d89ab15a95a2372c4adf9e1 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Tue, 31 Dec 2024 16:33:33 -0500 Subject: [PATCH 09/39] Call printPlanTargetForms for everything --- .../src/Distribution/Client/CmdTarget.hs | 39 +++++--- .../Client/ProjectOrchestration.hs | 96 +++++++++---------- 2 files changed, 70 insertions(+), 65 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdTarget.hs b/cabal-install/src/Distribution/Client/CmdTarget.hs index 4580e142118..d996cfde1da 100644 --- a/cabal-install/src/Distribution/Client/CmdTarget.hs +++ b/cabal-install/src/Distribution/Client/CmdTarget.hs @@ -120,20 +120,23 @@ targetAction flags@NixStyleFlags{..} ts globalFlags = do localPackages Nothing - targetSelectors <- - either (reportTargetSelectorProblems verbosity) return - =<< readTargetSelectors localPackages Nothing targetStrings - - targets :: TargetsMap <- - either (reportBuildTargetProblems verbosity) return $ - resolveTargets - selectPackageTargets - selectComponentTarget - elaboratedPlan - Nothing - targetSelectors - - printTargetForms targets elaboratedPlan + if any (== "everything") targetStrings + then printEveryTargetForm elaboratedPlan + else do + targetSelectors <- + either (reportTargetSelectorProblems verbosity) return + =<< readTargetSelectors localPackages Nothing targetStrings + + targets :: TargetsMap <- + either (reportBuildTargetProblems verbosity) return $ + resolveTargets + selectPackageTargets + selectComponentTarget + elaboratedPlan + Nothing + targetSelectors + + printTargetForms targets elaboratedPlan where verbosity = fromFlagOrDefault normal (configVerbosity configFlags) targetStrings = if null ts then ["all"] else ts @@ -169,3 +172,11 @@ printTargetForms targets elaboratedPlan = , let pkg = safeHead $ filter ((== u) . elabUnitId) localPkgs , (ct :: ComponentTarget, _) <- xs ] + +printEveryTargetForm :: ElaboratedInstallPlan -> IO () +printEveryTargetForm elaboratedPlan = + putStrLn . render $ + vcat + [ text "Fully qualified target forms" Pretty.<> colon + , nest 1 $ vcat [text "-" <+> text tf | tf <- planTargetForms elaboratedPlan] + ] diff --git a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs index 00bdd280754..b6e5c39f52b 100644 --- a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs +++ b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs @@ -90,7 +90,7 @@ module Distribution.Client.ProjectOrchestration , pruneInstallPlanToDependencies , CannotPruneDependencies (..) , printPlan - , printPlanTargetForms + , planTargetForms -- * Build phase: now do it. , runProjectBuildPhase @@ -937,60 +937,54 @@ distinctTargetComponents targetsMap = -- Displaying what we plan to do -- | Print available target forms. -printPlanTargetForms - :: Verbosity - -> ProjectBuildContext - -> IO () -printPlanTargetForms - 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) - ] +planTargetForms :: ElaboratedInstallPlan -> [String] +planTargetForms elaboratedPlan + | not (null pkgs) = map showPkgAndReason pkgs + | otherwise = [] + 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 + ] + ] - showTargets :: ElaboratedConfiguredPackage -> String - showTargets elab - | null (elabBuildTargets elab) = "" - | otherwise = - "(" + showComp :: ElaboratedConfiguredPackage -> ElaboratedComponent -> String + showComp elab comp = + maybe "custom" prettyShow (compComponentName comp) + ++ if Map.null (elabInstantiatedWith elab) + then "" + else + " with " ++ intercalate ", " - [ showComponentTarget (packageId elab) t - | t <- elabBuildTargets elab + -- 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. From f1d2c60f7d0f51cee11e3cdb03ff9da2d09f3077 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 1 Jan 2025 11:24:15 -0500 Subject: [PATCH 10/39] Remove planTargetForms --- .../src/Distribution/Client/CmdTarget.hs | 39 +++++--------- .../Client/ProjectOrchestration.hs | 51 ------------------- 2 files changed, 14 insertions(+), 76 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdTarget.hs b/cabal-install/src/Distribution/Client/CmdTarget.hs index d996cfde1da..4580e142118 100644 --- a/cabal-install/src/Distribution/Client/CmdTarget.hs +++ b/cabal-install/src/Distribution/Client/CmdTarget.hs @@ -120,23 +120,20 @@ targetAction flags@NixStyleFlags{..} ts globalFlags = do localPackages Nothing - if any (== "everything") targetStrings - then printEveryTargetForm elaboratedPlan - else do - targetSelectors <- - either (reportTargetSelectorProblems verbosity) return - =<< readTargetSelectors localPackages Nothing targetStrings - - targets :: TargetsMap <- - either (reportBuildTargetProblems verbosity) return $ - resolveTargets - selectPackageTargets - selectComponentTarget - elaboratedPlan - Nothing - targetSelectors - - printTargetForms targets elaboratedPlan + targetSelectors <- + either (reportTargetSelectorProblems verbosity) return + =<< readTargetSelectors localPackages Nothing targetStrings + + targets :: TargetsMap <- + either (reportBuildTargetProblems verbosity) return $ + resolveTargets + selectPackageTargets + selectComponentTarget + elaboratedPlan + Nothing + targetSelectors + + printTargetForms targets elaboratedPlan where verbosity = fromFlagOrDefault normal (configVerbosity configFlags) targetStrings = if null ts then ["all"] else ts @@ -172,11 +169,3 @@ printTargetForms targets elaboratedPlan = , let pkg = safeHead $ filter ((== u) . elabUnitId) localPkgs , (ct :: ComponentTarget, _) <- xs ] - -printEveryTargetForm :: ElaboratedInstallPlan -> IO () -printEveryTargetForm elaboratedPlan = - putStrLn . render $ - vcat - [ text "Fully qualified target forms" Pretty.<> colon - , nest 1 $ vcat [text "-" <+> text tf | tf <- planTargetForms elaboratedPlan] - ] diff --git a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs index b6e5c39f52b..a14d43e4b99 100644 --- a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs +++ b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs @@ -90,7 +90,6 @@ module Distribution.Client.ProjectOrchestration , pruneInstallPlanToDependencies , CannotPruneDependencies (..) , printPlan - , planTargetForms -- * Build phase: now do it. , runProjectBuildPhase @@ -936,56 +935,6 @@ distinctTargetComponents targetsMap = ------------------------------------------------------------------------------ -- Displaying what we plan to do --- | Print available target forms. -planTargetForms :: ElaboratedInstallPlan -> [String] -planTargetForms elaboratedPlan - | not (null pkgs) = map showPkgAndReason pkgs - | otherwise = [] - 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. printPlan From d4c93817bf2021520ca03c68dc91b50475f485f1 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 1 Jan 2025 11:42:11 -0500 Subject: [PATCH 11/39] Rework command description - Remove script as a possible TARGET form - Section help into; intro, targetFroms and ctypes - Use pretty printing for examples --- .../src/Distribution/Client/CmdTarget.hs | 105 +++++++++++------- 1 file changed, 66 insertions(+), 39 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdTarget.hs b/cabal-install/src/Distribution/Client/CmdTarget.hs index 4580e142118..5bef27bab92 100644 --- a/cabal-install/src/Distribution/Client/CmdTarget.hs +++ b/cabal-install/src/Distribution/Client/CmdTarget.hs @@ -53,49 +53,76 @@ targetCommand :: CommandUI (NixStyleFlags ()) targetCommand = CommandUI { commandName = "v2-target" - , commandSynopsis = "Target disclosure." + , commandSynopsis = "Disclose selected targets." , 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" - ++ " " + , commandDescription = + Just . const . render $ + vcat + [ intro + , vcat $ punctuate (text "\n") [targetForms, ctypes, Pretty.empty] + ] + , commandNotes = Just $ \pname -> render $ examples pname , commandDefaultFlags = defaultNixStyleFlags () , commandOptions = const [] } + where + intro = + text . wrapText $ + "Discover targets in a project for use with other commands taking [TARGETS].\n\n" + ++ "Discloses fully-qualified targets from a selection of target form" + ++ " [TARGETS] (or 'all' if none given). Can also check if a target form is" + ++ " unique as some commands require a unique TARGET." + + targetForms = + vcat + [ text "A [TARGETS] item can be one of these target forms:" + , nest 1 . vcat $ + (char '-' <+>) + <$> [ text "a package target (e.g. [pkg:]package)" + , text "a component target (e.g. [package:][ctype:]component)" + , text "all packages (e.g. all)" + , text "components of a particular type (e.g. package:ctypes or all:ctypes)" + , text "a module target: (e.g. [package:][ctype:]module)" + , text "a filepath target: (e.g. [package:][ctype:]filepath)" + ] + ] + + ctypes = + vcat + [ text "The ctypes can be one of:" + , nest 1 . vcat $ + (char '-' <+>) + <$> [ "libs" <+> parens "libraries" + , "exes" <+> parens "executables" + , "tests" + , "benches" <+> parens "benchmarks" + , "flibs" <+> parens "foreign-libraries" + ] + ] + + examples pname = + vcat + [ text "Examples" Pretty.<> colon + , nest 2 $ + vcat + [ vcat + [ text pname <+> text "v2-target all" + , nest 2 $ text "Targets of the package in the current directory or all packages in the project" + ] + , vcat + [ text pname <+> text "v2-target pkgname" + , nest 2 $ text "Targets of the package named pkgname in the project" + ] + , vcat + [ text pname <+> text "v2-target ./pkgfoo" + , nest 2 $ text "Targets of the package in the ./pkgfoo directory" + ] + , vcat + [ text pname <+> text "v2-target cname" + , nest 2 $ text "Targets of the component named cname in the project" + ] + ] + ] ------------------------------------------------------------------------------- -- Action From 429c51636417ce80af22b8040d542e4f1fa496cd Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 1 Jan 2025 14:31:13 -0500 Subject: [PATCH 12/39] Short form and long form --- cabal-install/src/Distribution/Client/CmdTarget.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal-install/src/Distribution/Client/CmdTarget.hs b/cabal-install/src/Distribution/Client/CmdTarget.hs index 5bef27bab92..dbfa2c51884 100644 --- a/cabal-install/src/Distribution/Client/CmdTarget.hs +++ b/cabal-install/src/Distribution/Client/CmdTarget.hs @@ -89,7 +89,7 @@ targetCommand = ctypes = vcat - [ text "The ctypes can be one of:" + [ text "The ctypes, in short form and (long form), can be one of:" , nest 1 . vcat $ (char '-' <+>) <$> [ "libs" <+> parens "libraries" From 9a4b642978facf0cbe65f12206b73bc01c8223ad Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 1 Jan 2025 14:51:41 -0500 Subject: [PATCH 13/39] Add a changelog entry --- changelog.d/pr-9744.md | 10 ++++++++++ 1 file changed, 10 insertions(+) create mode 100644 changelog.d/pr-9744.md diff --git a/changelog.d/pr-9744.md b/changelog.d/pr-9744.md new file mode 100644 index 00000000000..4bfc590f042 --- /dev/null +++ b/changelog.d/pr-9744.md @@ -0,0 +1,10 @@ +--- +synopsis: Discovery targets in a project +packages: [cabal-install] +prs: 9744 +issues: [4070,8953] +--- + +Adds a `cabal target` command for discovering, disclosing and checking selected +targets. The returned list shows targets in fully-qualified form. These are +unambiguous and can be used with other commands expecting `[TARGETS]`. From 3e1d311adf161a447a3a6b4bb49ce3c40ef684a9 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 2 Jan 2025 05:00:30 -0500 Subject: [PATCH 14/39] Need nixStyleOptions for cabal-testsuite - unrecognized 'v2-target' option `-vverbose +markoutput +nowrap' - unrecognized 'v2-target' option `--builddir' - unrecognized 'v2-target' option `-j1' --- cabal-install/src/Distribution/Client/CmdTarget.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/cabal-install/src/Distribution/Client/CmdTarget.hs b/cabal-install/src/Distribution/Client/CmdTarget.hs index dbfa2c51884..2dfe6bed184 100644 --- a/cabal-install/src/Distribution/Client/CmdTarget.hs +++ b/cabal-install/src/Distribution/Client/CmdTarget.hs @@ -19,6 +19,7 @@ import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Client.NixStyleOptions ( NixStyleFlags (..) , defaultNixStyleFlags + , nixStyleOptions ) import Distribution.Client.ProjectOrchestration import Distribution.Client.ProjectPlanning @@ -63,7 +64,7 @@ targetCommand = ] , commandNotes = Just $ \pname -> render $ examples pname , commandDefaultFlags = defaultNixStyleFlags () - , commandOptions = const [] + , commandOptions = nixStyleOptions (const []) } where intro = From 48fb86459a5ea58c792cd1e3d658de22278dfd3c Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 2 Jan 2025 05:13:41 -0500 Subject: [PATCH 15/39] Use notice so target forms are marked output --- cabal-install/src/Distribution/Client/CmdTarget.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdTarget.hs b/cabal-install/src/Distribution/Client/CmdTarget.hs index 2dfe6bed184..8f56cc39bdb 100644 --- a/cabal-install/src/Distribution/Client/CmdTarget.hs +++ b/cabal-install/src/Distribution/Client/CmdTarget.hs @@ -37,7 +37,8 @@ import Distribution.Simple.Command ) import Distribution.Simple.Flag (fromFlagOrDefault) import Distribution.Simple.Utils - ( safeHead + ( notice + , safeHead , wrapText ) import Distribution.Verbosity @@ -161,7 +162,7 @@ targetAction flags@NixStyleFlags{..} ts globalFlags = do Nothing targetSelectors - printTargetForms targets elaboratedPlan + printTargetForms verbosity targets elaboratedPlan where verbosity = fromFlagOrDefault normal (configVerbosity configFlags) targetStrings = if null ts then ["all"] else ts @@ -174,9 +175,9 @@ targetAction flags@NixStyleFlags{..} ts globalFlags = do reportBuildTargetProblems :: Verbosity -> [TargetProblem'] -> IO a reportBuildTargetProblems verbosity = reportTargetProblems verbosity "target" -printTargetForms :: TargetsMap -> ElaboratedInstallPlan -> IO () -printTargetForms targets elaboratedPlan = - putStrLn . render $ +printTargetForms :: Verbosity -> TargetsMap -> ElaboratedInstallPlan -> IO () +printTargetForms verbosity targets elaboratedPlan = + notice verbosity . render $ vcat [ text "Fully qualified target forms" Pretty.<> colon , nest 1 $ vcat [text "-" <+> text tf | tf <- targetForms] From 8a0589828bb1cc17a3e80e414d1ccb17a95997c0 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 1 Jan 2025 16:17:22 -0500 Subject: [PATCH 16/39] Add tests of target all, implicit and explicit --- .../PackageTests/Target/cabal.default-all.out | 8 ++++++++ .../PackageTests/Target/cabal.explicit-all.out | 8 ++++++++ cabal-testsuite/PackageTests/Target/cabal.project | 1 + cabal-testsuite/PackageTests/Target/cabal.test.hs | 10 ++++++++++ cabal-testsuite/PackageTests/Target/dir-a/a.cabal | 9 +++++++++ cabal-testsuite/PackageTests/Target/dir-b/b.cabal | 9 +++++++++ 6 files changed, 45 insertions(+) create mode 100644 cabal-testsuite/PackageTests/Target/cabal.default-all.out create mode 100644 cabal-testsuite/PackageTests/Target/cabal.explicit-all.out create mode 100644 cabal-testsuite/PackageTests/Target/cabal.project create mode 100644 cabal-testsuite/PackageTests/Target/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/Target/dir-a/a.cabal create mode 100644 cabal-testsuite/PackageTests/Target/dir-b/b.cabal diff --git a/cabal-testsuite/PackageTests/Target/cabal.default-all.out b/cabal-testsuite/PackageTests/Target/cabal.default-all.out new file mode 100644 index 00000000000..54123945a4d --- /dev/null +++ b/cabal-testsuite/PackageTests/Target/cabal.default-all.out @@ -0,0 +1,8 @@ +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Fully qualified target forms: + - a:lib:a + - b:lib:b diff --git a/cabal-testsuite/PackageTests/Target/cabal.explicit-all.out b/cabal-testsuite/PackageTests/Target/cabal.explicit-all.out new file mode 100644 index 00000000000..54123945a4d --- /dev/null +++ b/cabal-testsuite/PackageTests/Target/cabal.explicit-all.out @@ -0,0 +1,8 @@ +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Fully qualified target forms: + - a:lib:a + - b:lib:b diff --git a/cabal-testsuite/PackageTests/Target/cabal.project b/cabal-testsuite/PackageTests/Target/cabal.project new file mode 100644 index 00000000000..bdab35c5b01 --- /dev/null +++ b/cabal-testsuite/PackageTests/Target/cabal.project @@ -0,0 +1 @@ +packages: dir-a dir-b diff --git a/cabal-testsuite/PackageTests/Target/cabal.test.hs b/cabal-testsuite/PackageTests/Target/cabal.test.hs new file mode 100644 index 00000000000..40d2734cdd8 --- /dev/null +++ b/cabal-testsuite/PackageTests/Target/cabal.test.hs @@ -0,0 +1,10 @@ +import Test.Cabal.Prelude + +main = do + cabalTest' "default-all" $ do + cabal "clean" [] + cabal "v2-target" [] + + cabalTest' "explicit-all" $ do + cabal "clean" [] + cabal "v2-target" ["all"] diff --git a/cabal-testsuite/PackageTests/Target/dir-a/a.cabal b/cabal-testsuite/PackageTests/Target/dir-a/a.cabal new file mode 100644 index 00000000000..03e6d72d4c5 --- /dev/null +++ b/cabal-testsuite/PackageTests/Target/dir-a/a.cabal @@ -0,0 +1,9 @@ +name: a +version: 0.1 +license: BSD3 +cabal-version: >= 1.2 +build-type: Simple + +library + exposed-modules: Foo + build-depends: base \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/Target/dir-b/b.cabal b/cabal-testsuite/PackageTests/Target/dir-b/b.cabal new file mode 100644 index 00000000000..3157443f6cf --- /dev/null +++ b/cabal-testsuite/PackageTests/Target/dir-b/b.cabal @@ -0,0 +1,9 @@ +name: b +version: 0.1 +license: BSD3 +cabal-version: >= 1.2 +build-type: Simple + +library + exposed-modules: Foo + build-depends: base \ No newline at end of file From 72666fa1a40326672545663bc94dc03fb94374b6 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 2 Jan 2025 05:20:50 -0500 Subject: [PATCH 17/39] Add tests of all:exes and all:tests --- cabal-testsuite/PackageTests/Target/cabal.all-exes.out | 8 ++++++++ cabal-testsuite/PackageTests/Target/cabal.all-tests.out | 8 ++++++++ .../PackageTests/Target/cabal.default-all.out | 4 ++++ .../PackageTests/Target/cabal.explicit-all.out | 4 ++++ cabal-testsuite/PackageTests/Target/cabal.test.hs | 8 ++++++++ cabal-testsuite/PackageTests/Target/dir-a/a.cabal | 9 ++++++--- cabal-testsuite/PackageTests/Target/dir-b/b.cabal | 9 ++++++--- 7 files changed, 44 insertions(+), 6 deletions(-) create mode 100644 cabal-testsuite/PackageTests/Target/cabal.all-exes.out create mode 100644 cabal-testsuite/PackageTests/Target/cabal.all-tests.out diff --git a/cabal-testsuite/PackageTests/Target/cabal.all-exes.out b/cabal-testsuite/PackageTests/Target/cabal.all-exes.out new file mode 100644 index 00000000000..fea2396d5ee --- /dev/null +++ b/cabal-testsuite/PackageTests/Target/cabal.all-exes.out @@ -0,0 +1,8 @@ +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Fully qualified target forms: + - a:exe:a-exe + - b:exe:b-exe diff --git a/cabal-testsuite/PackageTests/Target/cabal.all-tests.out b/cabal-testsuite/PackageTests/Target/cabal.all-tests.out new file mode 100644 index 00000000000..6d6faa5d17f --- /dev/null +++ b/cabal-testsuite/PackageTests/Target/cabal.all-tests.out @@ -0,0 +1,8 @@ +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Fully qualified target forms: + - a:test:a-test + - b:test:b-test diff --git a/cabal-testsuite/PackageTests/Target/cabal.default-all.out b/cabal-testsuite/PackageTests/Target/cabal.default-all.out index 54123945a4d..e40ae5fee18 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.default-all.out +++ b/cabal-testsuite/PackageTests/Target/cabal.default-all.out @@ -4,5 +4,9 @@ Configuration is affected by the following files: - cabal.project Resolving dependencies... Fully qualified target forms: + - a:exe:a-exe - a:lib:a + - a:lib:a-sublib + - b:exe:b-exe - b:lib:b + - b:lib:b-sublib diff --git a/cabal-testsuite/PackageTests/Target/cabal.explicit-all.out b/cabal-testsuite/PackageTests/Target/cabal.explicit-all.out index 54123945a4d..e40ae5fee18 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.explicit-all.out +++ b/cabal-testsuite/PackageTests/Target/cabal.explicit-all.out @@ -4,5 +4,9 @@ Configuration is affected by the following files: - cabal.project Resolving dependencies... Fully qualified target forms: + - a:exe:a-exe - a:lib:a + - a:lib:a-sublib + - b:exe:b-exe - b:lib:b + - b:lib:b-sublib diff --git a/cabal-testsuite/PackageTests/Target/cabal.test.hs b/cabal-testsuite/PackageTests/Target/cabal.test.hs index 40d2734cdd8..0a579312dc1 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.test.hs +++ b/cabal-testsuite/PackageTests/Target/cabal.test.hs @@ -8,3 +8,11 @@ main = do cabalTest' "explicit-all" $ do cabal "clean" [] cabal "v2-target" ["all"] + + cabalTest' "all-exes" $ do + cabal "clean" [] + cabal "v2-target" ["all:exes"] + + cabalTest' "all-tests" $ do + cabal "clean" [] + cabal "v2-target" ["all:tests"] diff --git a/cabal-testsuite/PackageTests/Target/dir-a/a.cabal b/cabal-testsuite/PackageTests/Target/dir-a/a.cabal index 03e6d72d4c5..3fa13c4a9d1 100644 --- a/cabal-testsuite/PackageTests/Target/dir-a/a.cabal +++ b/cabal-testsuite/PackageTests/Target/dir-a/a.cabal @@ -1,9 +1,12 @@ name: a version: 0.1 license: BSD3 -cabal-version: >= 1.2 +cabal-version: >= 1.8 build-type: Simple library - exposed-modules: Foo - build-depends: base \ No newline at end of file +library a-sublib +executable a-exe +test-suite a-test + type: exitcode-stdio-1.0 + main-is: Test.hs \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/Target/dir-b/b.cabal b/cabal-testsuite/PackageTests/Target/dir-b/b.cabal index 3157443f6cf..027f5fbcfed 100644 --- a/cabal-testsuite/PackageTests/Target/dir-b/b.cabal +++ b/cabal-testsuite/PackageTests/Target/dir-b/b.cabal @@ -1,9 +1,12 @@ name: b version: 0.1 license: BSD3 -cabal-version: >= 1.2 +cabal-version: >= 1.8 build-type: Simple library - exposed-modules: Foo - build-depends: base \ No newline at end of file +library b-sublib +executable b-exe +test-suite b-test + type: exitcode-stdio-1.0 + main-is: Test.hs \ No newline at end of file From 3429b4a623acc073eb593c7652a400fbc17e87ed Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 2 Jan 2025 05:24:08 -0500 Subject: [PATCH 18/39] Add test of all:benches --- cabal-testsuite/PackageTests/Target/cabal.all-benches.out | 8 ++++++++ cabal-testsuite/PackageTests/Target/cabal.test.hs | 4 ++++ cabal-testsuite/PackageTests/Target/dir-a/a.cabal | 5 ++++- cabal-testsuite/PackageTests/Target/dir-b/b.cabal | 5 ++++- 4 files changed, 20 insertions(+), 2 deletions(-) create mode 100644 cabal-testsuite/PackageTests/Target/cabal.all-benches.out diff --git a/cabal-testsuite/PackageTests/Target/cabal.all-benches.out b/cabal-testsuite/PackageTests/Target/cabal.all-benches.out new file mode 100644 index 00000000000..e2926fcf115 --- /dev/null +++ b/cabal-testsuite/PackageTests/Target/cabal.all-benches.out @@ -0,0 +1,8 @@ +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Fully qualified target forms: + - a:bench:a-bench + - b:bench:b-bench diff --git a/cabal-testsuite/PackageTests/Target/cabal.test.hs b/cabal-testsuite/PackageTests/Target/cabal.test.hs index 0a579312dc1..4a163d18dcd 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.test.hs +++ b/cabal-testsuite/PackageTests/Target/cabal.test.hs @@ -16,3 +16,7 @@ main = do cabalTest' "all-tests" $ do cabal "clean" [] cabal "v2-target" ["all:tests"] + + cabalTest' "all-benches" $ do + cabal "clean" [] + cabal "v2-target" ["all:benches"] diff --git a/cabal-testsuite/PackageTests/Target/dir-a/a.cabal b/cabal-testsuite/PackageTests/Target/dir-a/a.cabal index 3fa13c4a9d1..681032bcdf0 100644 --- a/cabal-testsuite/PackageTests/Target/dir-a/a.cabal +++ b/cabal-testsuite/PackageTests/Target/dir-a/a.cabal @@ -9,4 +9,7 @@ library a-sublib executable a-exe test-suite a-test type: exitcode-stdio-1.0 - main-is: Test.hs \ No newline at end of file + main-is: Test.hs +benchmark a-bench + type: exitcode-stdio-1.0 + main-is: Bench.hs diff --git a/cabal-testsuite/PackageTests/Target/dir-b/b.cabal b/cabal-testsuite/PackageTests/Target/dir-b/b.cabal index 027f5fbcfed..b31ca9e81d3 100644 --- a/cabal-testsuite/PackageTests/Target/dir-b/b.cabal +++ b/cabal-testsuite/PackageTests/Target/dir-b/b.cabal @@ -9,4 +9,7 @@ library b-sublib executable b-exe test-suite b-test type: exitcode-stdio-1.0 - main-is: Test.hs \ No newline at end of file + main-is: Test.hs +benchmark b-bench + type: exitcode-stdio-1.0 + main-is: Bench.hs From f2d6ba226932d33193882db1fe93733f50eebd9f Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 2 Jan 2025 05:27:29 -0500 Subject: [PATCH 19/39] Add tests with --enable-tests and --enable-benchmarks --- .../Target/cabal.all-enable-benches.out | 14 ++++++++++++++ .../Target/cabal.all-enable-tests.out | 14 ++++++++++++++ .../PackageTests/Target/cabal.everything.out | 16 ++++++++++++++++ .../PackageTests/Target/cabal.test.hs | 12 ++++++++++++ 4 files changed, 56 insertions(+) create mode 100644 cabal-testsuite/PackageTests/Target/cabal.all-enable-benches.out create mode 100644 cabal-testsuite/PackageTests/Target/cabal.all-enable-tests.out create mode 100644 cabal-testsuite/PackageTests/Target/cabal.everything.out diff --git a/cabal-testsuite/PackageTests/Target/cabal.all-enable-benches.out b/cabal-testsuite/PackageTests/Target/cabal.all-enable-benches.out new file mode 100644 index 00000000000..5042a36880c --- /dev/null +++ b/cabal-testsuite/PackageTests/Target/cabal.all-enable-benches.out @@ -0,0 +1,14 @@ +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Fully qualified target forms: + - a:bench:a-bench + - a:exe:a-exe + - a:lib:a + - a:lib:a-sublib + - b:bench:b-bench + - b:exe:b-exe + - b:lib:b + - b:lib:b-sublib diff --git a/cabal-testsuite/PackageTests/Target/cabal.all-enable-tests.out b/cabal-testsuite/PackageTests/Target/cabal.all-enable-tests.out new file mode 100644 index 00000000000..08d397182c9 --- /dev/null +++ b/cabal-testsuite/PackageTests/Target/cabal.all-enable-tests.out @@ -0,0 +1,14 @@ +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Fully qualified target forms: + - a:exe:a-exe + - a:lib:a + - a:lib:a-sublib + - a:test:a-test + - b:exe:b-exe + - b:lib:b + - b:lib:b-sublib + - b:test:b-test diff --git a/cabal-testsuite/PackageTests/Target/cabal.everything.out b/cabal-testsuite/PackageTests/Target/cabal.everything.out new file mode 100644 index 00000000000..05b2d5a7aa7 --- /dev/null +++ b/cabal-testsuite/PackageTests/Target/cabal.everything.out @@ -0,0 +1,16 @@ +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Fully qualified target forms: + - a:bench:a-bench + - a:exe:a-exe + - a:lib:a + - a:lib:a-sublib + - a:test:a-test + - b:bench:b-bench + - b:exe:b-exe + - b:lib:b + - b:lib:b-sublib + - b:test:b-test diff --git a/cabal-testsuite/PackageTests/Target/cabal.test.hs b/cabal-testsuite/PackageTests/Target/cabal.test.hs index 4a163d18dcd..68a35266bfc 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.test.hs +++ b/cabal-testsuite/PackageTests/Target/cabal.test.hs @@ -9,6 +9,18 @@ main = do cabal "clean" [] cabal "v2-target" ["all"] + cabalTest' "all-enable-tests" $ do + cabal "clean" [] + cabal "v2-target" ["all", "--enable-tests"] + + cabalTest' "all-enable-benches" $ do + cabal "clean" [] + cabal "v2-target" ["all", "--enable-benchmarks"] + + cabalTest' "everything" $ do + cabal "clean" [] + cabal "v2-target" ["all", "--enable-tests", "--enable-benchmarks"] + cabalTest' "all-exes" $ do cabal "clean" [] cabal "v2-target" ["all:exes"] From 628d7cb011fef601cc7e0892a16dbb240e562453 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 2 Jan 2025 05:43:36 -0500 Subject: [PATCH 20/39] Warn that package targets display libs and exes --- cabal-install/src/Distribution/Client/CmdTarget.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/cabal-install/src/Distribution/Client/CmdTarget.hs b/cabal-install/src/Distribution/Client/CmdTarget.hs index 8f56cc39bdb..e3aff47909e 100644 --- a/cabal-install/src/Distribution/Client/CmdTarget.hs +++ b/cabal-install/src/Distribution/Client/CmdTarget.hs @@ -62,6 +62,7 @@ targetCommand = vcat [ intro , vcat $ punctuate (text "\n") [targetForms, ctypes, Pretty.empty] + , caution ] , commandNotes = Just $ \pname -> render $ examples pname , commandDefaultFlags = defaultNixStyleFlags () @@ -102,6 +103,13 @@ targetCommand = ] ] + caution = + text . wrapText $ + "For a package, all, module or filepath target, cabal target [TARGETS] \ + \ will *only* show 'libs' and 'exes' of the [TARGETS]. To also show \ + \ tests and benchmarks, enable them with '--enable-tests' and \ + \ '--enable-benchmarks'." + examples pname = vcat [ text "Examples" Pretty.<> colon From 789f414197b7c62c0a7ea289fb4597bc45fbbce0 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 2 Jan 2025 05:53:34 -0500 Subject: [PATCH 21/39] Add package target tests --- .../Target/cabal.package-target.out | 20 +++++++++++++++++++ .../PackageTests/Target/cabal.test.hs | 6 ++++++ 2 files changed, 26 insertions(+) create mode 100644 cabal-testsuite/PackageTests/Target/cabal.package-target.out diff --git a/cabal-testsuite/PackageTests/Target/cabal.package-target.out b/cabal-testsuite/PackageTests/Target/cabal.package-target.out new file mode 100644 index 00000000000..a1ca57e51b7 --- /dev/null +++ b/cabal-testsuite/PackageTests/Target/cabal.package-target.out @@ -0,0 +1,20 @@ +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Fully qualified target forms: + - a:exe:a-exe + - a:lib:a + - a:lib:a-sublib +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Fully qualified target forms: + - a:bench:a-bench + - a:exe:a-exe + - a:lib:a + - a:lib:a-sublib + - a:test:a-test diff --git a/cabal-testsuite/PackageTests/Target/cabal.test.hs b/cabal-testsuite/PackageTests/Target/cabal.test.hs index 68a35266bfc..a1a89730ef1 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.test.hs +++ b/cabal-testsuite/PackageTests/Target/cabal.test.hs @@ -32,3 +32,9 @@ main = do cabalTest' "all-benches" $ do cabal "clean" [] cabal "v2-target" ["all:benches"] + + cabalTest' "package-target" $ do + cabal "clean" [] + cabal "v2-target" ["a"] + cabal "clean" [] + cabal "v2-target" ["a", "--enable-tests", "--enable-benchmarks"] From 644856c3a2665758cb5cdc11692c6da3560f77cf Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 2 Jan 2025 05:55:21 -0500 Subject: [PATCH 22/39] Add path target tests --- .../PackageTests/Target/cabal.path-target.out | 20 +++++++++++++++++++ .../PackageTests/Target/cabal.test.hs | 6 ++++++ 2 files changed, 26 insertions(+) create mode 100644 cabal-testsuite/PackageTests/Target/cabal.path-target.out diff --git a/cabal-testsuite/PackageTests/Target/cabal.path-target.out b/cabal-testsuite/PackageTests/Target/cabal.path-target.out new file mode 100644 index 00000000000..a1ca57e51b7 --- /dev/null +++ b/cabal-testsuite/PackageTests/Target/cabal.path-target.out @@ -0,0 +1,20 @@ +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Fully qualified target forms: + - a:exe:a-exe + - a:lib:a + - a:lib:a-sublib +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Fully qualified target forms: + - a:bench:a-bench + - a:exe:a-exe + - a:lib:a + - a:lib:a-sublib + - a:test:a-test diff --git a/cabal-testsuite/PackageTests/Target/cabal.test.hs b/cabal-testsuite/PackageTests/Target/cabal.test.hs index a1a89730ef1..e2f33c5b541 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.test.hs +++ b/cabal-testsuite/PackageTests/Target/cabal.test.hs @@ -38,3 +38,9 @@ main = do cabal "v2-target" ["a"] cabal "clean" [] cabal "v2-target" ["a", "--enable-tests", "--enable-benchmarks"] + + cabalTest' "path-target" $ do + cabal "clean" [] + cabal "v2-target" ["dir-a/"] + cabal "clean" [] + cabal "v2-target" ["dir-a/", "--enable-tests", "--enable-benchmarks"] From 9b9195b3f100902c003c622efe634fd0ffe60307 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 2 Jan 2025 05:58:13 -0500 Subject: [PATCH 23/39] Add component target tests --- .../Target/cabal.component-target-bench.out | 21 ++++++++++ .../Target/cabal.component-target-exe.out | 21 ++++++++++ .../Target/cabal.component-target-lib.out | 21 ++++++++++ .../Target/cabal.component-target-test.out | 21 ++++++++++ .../Target/cabal.ctype-target.out | 29 +++++++++++++ .../PackageTests/Target/cabal.test.hs | 42 +++++++++++++++++++ 6 files changed, 155 insertions(+) create mode 100644 cabal-testsuite/PackageTests/Target/cabal.component-target-bench.out create mode 100644 cabal-testsuite/PackageTests/Target/cabal.component-target-exe.out create mode 100644 cabal-testsuite/PackageTests/Target/cabal.component-target-lib.out create mode 100644 cabal-testsuite/PackageTests/Target/cabal.component-target-test.out create mode 100644 cabal-testsuite/PackageTests/Target/cabal.ctype-target.out diff --git a/cabal-testsuite/PackageTests/Target/cabal.component-target-bench.out b/cabal-testsuite/PackageTests/Target/cabal.component-target-bench.out new file mode 100644 index 00000000000..961be723106 --- /dev/null +++ b/cabal-testsuite/PackageTests/Target/cabal.component-target-bench.out @@ -0,0 +1,21 @@ +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Fully qualified target forms: + - a:bench:a-bench +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Fully qualified target forms: + - a:bench:a-bench +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Fully qualified target forms: + - a:bench:a-bench diff --git a/cabal-testsuite/PackageTests/Target/cabal.component-target-exe.out b/cabal-testsuite/PackageTests/Target/cabal.component-target-exe.out new file mode 100644 index 00000000000..7bacc434e1a --- /dev/null +++ b/cabal-testsuite/PackageTests/Target/cabal.component-target-exe.out @@ -0,0 +1,21 @@ +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Fully qualified target forms: + - a:exe:a-exe +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Fully qualified target forms: + - a:exe:a-exe +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Fully qualified target forms: + - a:exe:a-exe diff --git a/cabal-testsuite/PackageTests/Target/cabal.component-target-lib.out b/cabal-testsuite/PackageTests/Target/cabal.component-target-lib.out new file mode 100644 index 00000000000..ad4b0d79ce1 --- /dev/null +++ b/cabal-testsuite/PackageTests/Target/cabal.component-target-lib.out @@ -0,0 +1,21 @@ +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Fully qualified target forms: + - a:lib:a +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Fully qualified target forms: + - a:lib:a +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Fully qualified target forms: + - a:lib:a diff --git a/cabal-testsuite/PackageTests/Target/cabal.component-target-test.out b/cabal-testsuite/PackageTests/Target/cabal.component-target-test.out new file mode 100644 index 00000000000..9038eeb4995 --- /dev/null +++ b/cabal-testsuite/PackageTests/Target/cabal.component-target-test.out @@ -0,0 +1,21 @@ +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Fully qualified target forms: + - a:test:a-test +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Fully qualified target forms: + - a:test:a-test +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Fully qualified target forms: + - a:test:a-test diff --git a/cabal-testsuite/PackageTests/Target/cabal.ctype-target.out b/cabal-testsuite/PackageTests/Target/cabal.ctype-target.out new file mode 100644 index 00000000000..f81d3d20480 --- /dev/null +++ b/cabal-testsuite/PackageTests/Target/cabal.ctype-target.out @@ -0,0 +1,29 @@ +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Fully qualified target forms: + - a:lib:a + - a:lib:a-sublib +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Fully qualified target forms: + - a:exe:a-exe +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Fully qualified target forms: + - a:test:a-test +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Fully qualified target forms: + - a:bench:a-bench diff --git a/cabal-testsuite/PackageTests/Target/cabal.test.hs b/cabal-testsuite/PackageTests/Target/cabal.test.hs index e2f33c5b541..fe876ef84bd 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.test.hs +++ b/cabal-testsuite/PackageTests/Target/cabal.test.hs @@ -44,3 +44,45 @@ main = do cabal "v2-target" ["dir-a/"] cabal "clean" [] cabal "v2-target" ["dir-a/", "--enable-tests", "--enable-benchmarks"] + + cabalTest' "component-target-lib" $ do + cabal "clean" [] + cabal "v2-target" ["a:lib:a"] + cabal "clean" [] + cabal "v2-target" ["lib:a"] + cabal "clean" [] + cabal "v2-target" ["a:a"] + + cabalTest' "component-target-exe" $ do + cabal "clean" [] + cabal "v2-target" ["a:exe:a-exe"] + cabal "clean" [] + cabal "v2-target" ["exe:a-exe"] + cabal "clean" [] + cabal "v2-target" ["a:a-exe"] + + cabalTest' "component-target-bench" $ do + cabal "clean" [] + cabal "v2-target" ["a:bench:a-bench"] + cabal "clean" [] + cabal "v2-target" ["bench:a-bench"] + cabal "clean" [] + cabal "v2-target" ["a:a-bench"] + + cabalTest' "component-target-test" $ do + cabal "clean" [] + cabal "v2-target" ["a:test:a-test"] + cabal "clean" [] + cabal "v2-target" ["test:a-test"] + cabal "clean" [] + cabal "v2-target" ["a:a-test"] + + cabalTest' "ctype-target" $ do + cabal "clean" [] + cabal "v2-target" ["a:libs"] + cabal "clean" [] + cabal "v2-target" ["a:exes"] + cabal "clean" [] + cabal "v2-target" ["a:tests"] + cabal "clean" [] + cabal "v2-target" ["a:benches"] From e1212232635976ee507d713600e8d92aba1226ea Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 2 Jan 2025 06:11:51 -0500 Subject: [PATCH 24/39] Add c package with only a library --- .../PackageTests/Target/cabal.all-enable-benches.out | 1 + .../PackageTests/Target/cabal.all-enable-tests.out | 1 + cabal-testsuite/PackageTests/Target/cabal.default-all.out | 1 + cabal-testsuite/PackageTests/Target/cabal.everything.out | 1 + cabal-testsuite/PackageTests/Target/cabal.explicit-all.out | 1 + cabal-testsuite/PackageTests/Target/cabal.project | 2 +- cabal-testsuite/PackageTests/Target/dir-c/c.cabal | 7 +++++++ 7 files changed, 13 insertions(+), 1 deletion(-) create mode 100644 cabal-testsuite/PackageTests/Target/dir-c/c.cabal diff --git a/cabal-testsuite/PackageTests/Target/cabal.all-enable-benches.out b/cabal-testsuite/PackageTests/Target/cabal.all-enable-benches.out index 5042a36880c..12f685ce5ba 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.all-enable-benches.out +++ b/cabal-testsuite/PackageTests/Target/cabal.all-enable-benches.out @@ -12,3 +12,4 @@ Fully qualified target forms: - b:exe:b-exe - b:lib:b - b:lib:b-sublib + - c:lib:c diff --git a/cabal-testsuite/PackageTests/Target/cabal.all-enable-tests.out b/cabal-testsuite/PackageTests/Target/cabal.all-enable-tests.out index 08d397182c9..9bf8f9ec199 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.all-enable-tests.out +++ b/cabal-testsuite/PackageTests/Target/cabal.all-enable-tests.out @@ -12,3 +12,4 @@ Fully qualified target forms: - b:lib:b - b:lib:b-sublib - b:test:b-test + - c:lib:c diff --git a/cabal-testsuite/PackageTests/Target/cabal.default-all.out b/cabal-testsuite/PackageTests/Target/cabal.default-all.out index e40ae5fee18..0465b906156 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.default-all.out +++ b/cabal-testsuite/PackageTests/Target/cabal.default-all.out @@ -10,3 +10,4 @@ Fully qualified target forms: - b:exe:b-exe - b:lib:b - b:lib:b-sublib + - c:lib:c diff --git a/cabal-testsuite/PackageTests/Target/cabal.everything.out b/cabal-testsuite/PackageTests/Target/cabal.everything.out index 05b2d5a7aa7..10c1ae4c312 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.everything.out +++ b/cabal-testsuite/PackageTests/Target/cabal.everything.out @@ -14,3 +14,4 @@ Fully qualified target forms: - b:lib:b - b:lib:b-sublib - b:test:b-test + - c:lib:c diff --git a/cabal-testsuite/PackageTests/Target/cabal.explicit-all.out b/cabal-testsuite/PackageTests/Target/cabal.explicit-all.out index e40ae5fee18..0465b906156 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.explicit-all.out +++ b/cabal-testsuite/PackageTests/Target/cabal.explicit-all.out @@ -10,3 +10,4 @@ Fully qualified target forms: - b:exe:b-exe - b:lib:b - b:lib:b-sublib + - c:lib:c diff --git a/cabal-testsuite/PackageTests/Target/cabal.project b/cabal-testsuite/PackageTests/Target/cabal.project index bdab35c5b01..5cad90c8210 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.project +++ b/cabal-testsuite/PackageTests/Target/cabal.project @@ -1 +1 @@ -packages: dir-a dir-b +packages: dir-a dir-b dir-c diff --git a/cabal-testsuite/PackageTests/Target/dir-c/c.cabal b/cabal-testsuite/PackageTests/Target/dir-c/c.cabal new file mode 100644 index 00000000000..875f7a9fc69 --- /dev/null +++ b/cabal-testsuite/PackageTests/Target/dir-c/c.cabal @@ -0,0 +1,7 @@ +name: c +version: 0.1 +license: BSD3 +cabal-version: >= 1.8 +build-type: Simple + +library From c87ae019df2c69de4208cb61f3da892f369616cb Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 2 Jan 2025 06:14:39 -0500 Subject: [PATCH 25/39] Add tests for missing ctypes --- .../Target/cabal.missing-target.out | 21 +++++++++++++++++++ .../PackageTests/Target/cabal.test.hs | 8 +++++++ 2 files changed, 29 insertions(+) create mode 100644 cabal-testsuite/PackageTests/Target/cabal.missing-target.out diff --git a/cabal-testsuite/PackageTests/Target/cabal.missing-target.out b/cabal-testsuite/PackageTests/Target/cabal.missing-target.out new file mode 100644 index 00000000000..a9475f042f1 --- /dev/null +++ b/cabal-testsuite/PackageTests/Target/cabal.missing-target.out @@ -0,0 +1,21 @@ +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Error: [Cabal-7127] +Cannot target the executables in the package c-0.1 because it does not contain any executables. Check the .cabal file for the package and make sure that it properly declares the components that you expect. +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Error: [Cabal-7127] +Cannot target the test suites in the package c-0.1 because it does not contain any test suites. Check the .cabal file for the package and make sure that it properly declares the components that you expect. +# cabal clean +# cabal v2-target +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... +Error: [Cabal-7127] +Cannot target the benchmarks in the package c-0.1 because it does not contain any benchmarks. Check the .cabal file for the package and make sure that it properly declares the components that you expect. diff --git a/cabal-testsuite/PackageTests/Target/cabal.test.hs b/cabal-testsuite/PackageTests/Target/cabal.test.hs index fe876ef84bd..f4d4a1c9f59 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.test.hs +++ b/cabal-testsuite/PackageTests/Target/cabal.test.hs @@ -86,3 +86,11 @@ main = do cabal "v2-target" ["a:tests"] cabal "clean" [] cabal "v2-target" ["a:benches"] + + cabalTest' "missing-target" $ do + cabal "clean" [] + fails $ cabal "v2-target" ["c:exes"] + cabal "clean" [] + fails $ cabal "v2-target" ["c:tests"] + cabal "clean" [] + fails $ cabal "v2-target" ["c:benches"] From ee7dfc877ac42bef7a9c2208b82984518c04a756 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 2 Jan 2025 06:19:40 -0500 Subject: [PATCH 26/39] Exclude new-target from other commands --- cabal-install/src/Distribution/Client/Setup.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs index 8e5494477cd..b839b20eb54 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/cabal-install/src/Distribution/Client/Setup.hs @@ -303,6 +303,7 @@ globalCommand commands = , "path" , "new-build" , "new-configure" + , "new-target" , "new-repl" , "new-freeze" , "new-run" From 6110042c9ddb5f2e8e358c96f27ee3b2fda33067 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 2 Jan 2025 06:21:39 -0500 Subject: [PATCH 27/39] Move target command to configuration group --- cabal-install/src/Distribution/Client/Setup.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs index b839b20eb54..78fcf7c2e1f 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/cabal-install/src/Distribution/Client/Setup.hs @@ -382,9 +382,9 @@ globalCommand commands = , addCmd "gen-bounds" , addCmd "outdated" , addCmd "path" + , addCmd "target" , par , startGroup "project building and installing" - , addCmd "target" , addCmd "build" , addCmd "install" , addCmd "haddock" From 661d744f6db741d4458d96b090f956417ef3837b Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 2 Jan 2025 06:25:46 -0500 Subject: [PATCH 28/39] Add target command docs --- doc/cabal-commands.rst | 1 + 1 file changed, 1 insertion(+) diff --git a/doc/cabal-commands.rst b/doc/cabal-commands.rst index 6a1d9e6e695..5391c46b344 100644 --- a/doc/cabal-commands.rst +++ b/doc/cabal-commands.rst @@ -36,6 +36,7 @@ Commands gen-bounds Generate dependency bounds. outdated Check for outdated dependencies. path Query for simple project information. + target Disclose selected targets. [project building and installing] build Compile targets within the project. From b904125fa2db44b5f6dc79124c341e97c10927eb Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 2 Jan 2025 07:15:01 -0500 Subject: [PATCH 29/39] Add cabal target docs --- doc/cabal-commands.rst | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) diff --git a/doc/cabal-commands.rst b/doc/cabal-commands.rst index 5391c46b344..d13c8bc2da1 100644 --- a/doc/cabal-commands.rst +++ b/doc/cabal-commands.rst @@ -213,6 +213,8 @@ Arguments and flags common to some or all commands are: Already generated `build-info.json` files will be removed since they would be stale otherwise. +.. _target-forms: + Target Forms ------------ @@ -735,6 +737,40 @@ Scripting example: $ ls $(cabal path --installdir) ... +cabal target +^^^^^^^^^^^^ + +``cabal target [TARGETS]`` discloses fully-qualified targets from a selection of +targets and is useful for discovering targets in a project for use with other +commands taking [TARGETS]. This command can also check if a :ref:`target +form` is unique as some commands require a unique TARGET. + +Any target forms except for a script target can be used with ``cabal target``. + +.. code-block:: console + + $ cabal target all:tests + ... + Fully qualified target forms: + - Cabal-tests:test:check-tests + - Cabal-tests:test:custom-setup-tests + - Cabal-tests:test:hackage-tests + - Cabal-tests:test:no-thunks-test + - Cabal-tests:test:parser-tests + - Cabal-tests:test:rpmvercmp + - Cabal-tests:test:unit-tests + - cabal-benchmarks:test:cabal-benchmarks + - cabal-install-solver:test:unit-tests + - cabal-install:test:integration-tests2 + - cabal-install:test:long-tests + - cabal-install:test:mem-use-tests + - cabal-install:test:unit-tests + - solver-benchmarks:test:unit-tests + +For a package, all, module or filepath target, cabal target [TARGETS] will +**only** show ``libs`` and ``exes`` of the [TARGETS]. To also show tests and +benchmarks, enable them with ``--enable-tests`` and ``--enable-benchmarks``. + .. _command-group-build: Project building and installing From 7523e9239a5d8685eb598e907d9ef1790930fc98 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 2 Jan 2025 07:20:34 -0500 Subject: [PATCH 30/39] A significant change --- changelog.d/pr-9744.md | 1 + 1 file changed, 1 insertion(+) diff --git a/changelog.d/pr-9744.md b/changelog.d/pr-9744.md index 4bfc590f042..747f305a556 100644 --- a/changelog.d/pr-9744.md +++ b/changelog.d/pr-9744.md @@ -3,6 +3,7 @@ synopsis: Discovery targets in a project packages: [cabal-install] prs: 9744 issues: [4070,8953] +significance: significant --- Adds a `cabal target` command for discovering, disclosing and checking selected From 3c6e626d6f111688a2c7f7af8cc745b7fcbc1836 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 2 Jan 2025 07:24:10 -0500 Subject: [PATCH 31/39] Drop cleans from tests --- .../PackageTests/Target/cabal.all-benches.out | 1 - .../Target/cabal.all-enable-benches.out | 1 - .../Target/cabal.all-enable-tests.out | 1 - .../PackageTests/Target/cabal.all-exes.out | 1 - .../PackageTests/Target/cabal.all-tests.out | 1 - .../Target/cabal.component-target-bench.out | 5 --- .../Target/cabal.component-target-exe.out | 5 --- .../Target/cabal.component-target-lib.out | 5 --- .../Target/cabal.component-target-test.out | 5 --- .../Target/cabal.ctype-target.out | 7 ----- .../PackageTests/Target/cabal.default-all.out | 1 - .../PackageTests/Target/cabal.everything.out | 1 - .../Target/cabal.explicit-all.out | 1 - .../Target/cabal.missing-target.out | 5 --- .../Target/cabal.package-target.out | 2 -- .../PackageTests/Target/cabal.path-target.out | 2 -- .../PackageTests/Target/cabal.test.hs | 31 ------------------- 17 files changed, 75 deletions(-) diff --git a/cabal-testsuite/PackageTests/Target/cabal.all-benches.out b/cabal-testsuite/PackageTests/Target/cabal.all-benches.out index e2926fcf115..621261f013b 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.all-benches.out +++ b/cabal-testsuite/PackageTests/Target/cabal.all-benches.out @@ -1,4 +1,3 @@ -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project diff --git a/cabal-testsuite/PackageTests/Target/cabal.all-enable-benches.out b/cabal-testsuite/PackageTests/Target/cabal.all-enable-benches.out index 12f685ce5ba..fae48570673 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.all-enable-benches.out +++ b/cabal-testsuite/PackageTests/Target/cabal.all-enable-benches.out @@ -1,4 +1,3 @@ -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project diff --git a/cabal-testsuite/PackageTests/Target/cabal.all-enable-tests.out b/cabal-testsuite/PackageTests/Target/cabal.all-enable-tests.out index 9bf8f9ec199..ed8c530e14a 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.all-enable-tests.out +++ b/cabal-testsuite/PackageTests/Target/cabal.all-enable-tests.out @@ -1,4 +1,3 @@ -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project diff --git a/cabal-testsuite/PackageTests/Target/cabal.all-exes.out b/cabal-testsuite/PackageTests/Target/cabal.all-exes.out index fea2396d5ee..6c4eb45c1da 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.all-exes.out +++ b/cabal-testsuite/PackageTests/Target/cabal.all-exes.out @@ -1,4 +1,3 @@ -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project diff --git a/cabal-testsuite/PackageTests/Target/cabal.all-tests.out b/cabal-testsuite/PackageTests/Target/cabal.all-tests.out index 6d6faa5d17f..1ffbaeefca2 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.all-tests.out +++ b/cabal-testsuite/PackageTests/Target/cabal.all-tests.out @@ -1,4 +1,3 @@ -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project diff --git a/cabal-testsuite/PackageTests/Target/cabal.component-target-bench.out b/cabal-testsuite/PackageTests/Target/cabal.component-target-bench.out index 961be723106..77b7ae1940b 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.component-target-bench.out +++ b/cabal-testsuite/PackageTests/Target/cabal.component-target-bench.out @@ -1,21 +1,16 @@ -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project Resolving dependencies... Fully qualified target forms: - a:bench:a-bench -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project -Resolving dependencies... Fully qualified target forms: - a:bench:a-bench -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project -Resolving dependencies... Fully qualified target forms: - a:bench:a-bench diff --git a/cabal-testsuite/PackageTests/Target/cabal.component-target-exe.out b/cabal-testsuite/PackageTests/Target/cabal.component-target-exe.out index 7bacc434e1a..db06ee2ea2a 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.component-target-exe.out +++ b/cabal-testsuite/PackageTests/Target/cabal.component-target-exe.out @@ -1,21 +1,16 @@ -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project Resolving dependencies... Fully qualified target forms: - a:exe:a-exe -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project -Resolving dependencies... Fully qualified target forms: - a:exe:a-exe -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project -Resolving dependencies... Fully qualified target forms: - a:exe:a-exe diff --git a/cabal-testsuite/PackageTests/Target/cabal.component-target-lib.out b/cabal-testsuite/PackageTests/Target/cabal.component-target-lib.out index ad4b0d79ce1..ce44bff40f3 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.component-target-lib.out +++ b/cabal-testsuite/PackageTests/Target/cabal.component-target-lib.out @@ -1,21 +1,16 @@ -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project Resolving dependencies... Fully qualified target forms: - a:lib:a -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project -Resolving dependencies... Fully qualified target forms: - a:lib:a -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project -Resolving dependencies... Fully qualified target forms: - a:lib:a diff --git a/cabal-testsuite/PackageTests/Target/cabal.component-target-test.out b/cabal-testsuite/PackageTests/Target/cabal.component-target-test.out index 9038eeb4995..82ed0b891c8 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.component-target-test.out +++ b/cabal-testsuite/PackageTests/Target/cabal.component-target-test.out @@ -1,21 +1,16 @@ -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project Resolving dependencies... Fully qualified target forms: - a:test:a-test -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project -Resolving dependencies... Fully qualified target forms: - a:test:a-test -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project -Resolving dependencies... Fully qualified target forms: - a:test:a-test diff --git a/cabal-testsuite/PackageTests/Target/cabal.ctype-target.out b/cabal-testsuite/PackageTests/Target/cabal.ctype-target.out index f81d3d20480..ba56efa6e60 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.ctype-target.out +++ b/cabal-testsuite/PackageTests/Target/cabal.ctype-target.out @@ -1,4 +1,3 @@ -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project @@ -6,24 +5,18 @@ Resolving dependencies... Fully qualified target forms: - a:lib:a - a:lib:a-sublib -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project -Resolving dependencies... Fully qualified target forms: - a:exe:a-exe -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project -Resolving dependencies... Fully qualified target forms: - a:test:a-test -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project -Resolving dependencies... Fully qualified target forms: - a:bench:a-bench diff --git a/cabal-testsuite/PackageTests/Target/cabal.default-all.out b/cabal-testsuite/PackageTests/Target/cabal.default-all.out index 0465b906156..4b058b57f2a 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.default-all.out +++ b/cabal-testsuite/PackageTests/Target/cabal.default-all.out @@ -1,4 +1,3 @@ -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project diff --git a/cabal-testsuite/PackageTests/Target/cabal.everything.out b/cabal-testsuite/PackageTests/Target/cabal.everything.out index 10c1ae4c312..49b2dea466e 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.everything.out +++ b/cabal-testsuite/PackageTests/Target/cabal.everything.out @@ -1,4 +1,3 @@ -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project diff --git a/cabal-testsuite/PackageTests/Target/cabal.explicit-all.out b/cabal-testsuite/PackageTests/Target/cabal.explicit-all.out index 0465b906156..4b058b57f2a 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.explicit-all.out +++ b/cabal-testsuite/PackageTests/Target/cabal.explicit-all.out @@ -1,4 +1,3 @@ -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project diff --git a/cabal-testsuite/PackageTests/Target/cabal.missing-target.out b/cabal-testsuite/PackageTests/Target/cabal.missing-target.out index a9475f042f1..973cc5d97f1 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.missing-target.out +++ b/cabal-testsuite/PackageTests/Target/cabal.missing-target.out @@ -1,21 +1,16 @@ -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project Resolving dependencies... Error: [Cabal-7127] Cannot target the executables in the package c-0.1 because it does not contain any executables. Check the .cabal file for the package and make sure that it properly declares the components that you expect. -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project -Resolving dependencies... Error: [Cabal-7127] Cannot target the test suites in the package c-0.1 because it does not contain any test suites. Check the .cabal file for the package and make sure that it properly declares the components that you expect. -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project -Resolving dependencies... Error: [Cabal-7127] Cannot target the benchmarks in the package c-0.1 because it does not contain any benchmarks. Check the .cabal file for the package and make sure that it properly declares the components that you expect. diff --git a/cabal-testsuite/PackageTests/Target/cabal.package-target.out b/cabal-testsuite/PackageTests/Target/cabal.package-target.out index a1ca57e51b7..2a621cd91f7 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.package-target.out +++ b/cabal-testsuite/PackageTests/Target/cabal.package-target.out @@ -1,4 +1,3 @@ -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project @@ -7,7 +6,6 @@ Fully qualified target forms: - a:exe:a-exe - a:lib:a - a:lib:a-sublib -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project diff --git a/cabal-testsuite/PackageTests/Target/cabal.path-target.out b/cabal-testsuite/PackageTests/Target/cabal.path-target.out index a1ca57e51b7..2a621cd91f7 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.path-target.out +++ b/cabal-testsuite/PackageTests/Target/cabal.path-target.out @@ -1,4 +1,3 @@ -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project @@ -7,7 +6,6 @@ Fully qualified target forms: - a:exe:a-exe - a:lib:a - a:lib:a-sublib -# cabal clean # cabal v2-target Configuration is affected by the following files: - cabal.project diff --git a/cabal-testsuite/PackageTests/Target/cabal.test.hs b/cabal-testsuite/PackageTests/Target/cabal.test.hs index f4d4a1c9f59..4307b5ecfb6 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.test.hs +++ b/cabal-testsuite/PackageTests/Target/cabal.test.hs @@ -2,95 +2,64 @@ import Test.Cabal.Prelude main = do cabalTest' "default-all" $ do - cabal "clean" [] cabal "v2-target" [] cabalTest' "explicit-all" $ do - cabal "clean" [] cabal "v2-target" ["all"] cabalTest' "all-enable-tests" $ do - cabal "clean" [] cabal "v2-target" ["all", "--enable-tests"] cabalTest' "all-enable-benches" $ do - cabal "clean" [] cabal "v2-target" ["all", "--enable-benchmarks"] cabalTest' "everything" $ do - cabal "clean" [] cabal "v2-target" ["all", "--enable-tests", "--enable-benchmarks"] cabalTest' "all-exes" $ do - cabal "clean" [] cabal "v2-target" ["all:exes"] cabalTest' "all-tests" $ do - cabal "clean" [] cabal "v2-target" ["all:tests"] cabalTest' "all-benches" $ do - cabal "clean" [] cabal "v2-target" ["all:benches"] cabalTest' "package-target" $ do - cabal "clean" [] cabal "v2-target" ["a"] - cabal "clean" [] cabal "v2-target" ["a", "--enable-tests", "--enable-benchmarks"] cabalTest' "path-target" $ do - cabal "clean" [] cabal "v2-target" ["dir-a/"] - cabal "clean" [] cabal "v2-target" ["dir-a/", "--enable-tests", "--enable-benchmarks"] cabalTest' "component-target-lib" $ do - cabal "clean" [] cabal "v2-target" ["a:lib:a"] - cabal "clean" [] cabal "v2-target" ["lib:a"] - cabal "clean" [] cabal "v2-target" ["a:a"] cabalTest' "component-target-exe" $ do - cabal "clean" [] cabal "v2-target" ["a:exe:a-exe"] - cabal "clean" [] cabal "v2-target" ["exe:a-exe"] - cabal "clean" [] cabal "v2-target" ["a:a-exe"] cabalTest' "component-target-bench" $ do - cabal "clean" [] cabal "v2-target" ["a:bench:a-bench"] - cabal "clean" [] cabal "v2-target" ["bench:a-bench"] - cabal "clean" [] cabal "v2-target" ["a:a-bench"] cabalTest' "component-target-test" $ do - cabal "clean" [] cabal "v2-target" ["a:test:a-test"] - cabal "clean" [] cabal "v2-target" ["test:a-test"] - cabal "clean" [] cabal "v2-target" ["a:a-test"] cabalTest' "ctype-target" $ do - cabal "clean" [] cabal "v2-target" ["a:libs"] - cabal "clean" [] cabal "v2-target" ["a:exes"] - cabal "clean" [] cabal "v2-target" ["a:tests"] - cabal "clean" [] cabal "v2-target" ["a:benches"] cabalTest' "missing-target" $ do - cabal "clean" [] fails $ cabal "v2-target" ["c:exes"] - cabal "clean" [] fails $ cabal "v2-target" ["c:tests"] - cabal "clean" [] fails $ cabal "v2-target" ["c:benches"] From 30a513710e6edb18d834b6ec6cad40c7164d1ec4 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 2 Jan 2025 07:36:09 -0500 Subject: [PATCH 32/39] Use noticeDoc to preserve indent --- .../src/Distribution/Client/CmdTarget.hs | 4 +-- doc/cabal-commands.rst | 28 +++++++++---------- 2 files changed, 16 insertions(+), 16 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdTarget.hs b/cabal-install/src/Distribution/Client/CmdTarget.hs index e3aff47909e..93554c2cc09 100644 --- a/cabal-install/src/Distribution/Client/CmdTarget.hs +++ b/cabal-install/src/Distribution/Client/CmdTarget.hs @@ -37,7 +37,7 @@ import Distribution.Simple.Command ) import Distribution.Simple.Flag (fromFlagOrDefault) import Distribution.Simple.Utils - ( notice + ( noticeDoc , safeHead , wrapText ) @@ -185,7 +185,7 @@ reportBuildTargetProblems verbosity = reportTargetProblems verbosity "target" printTargetForms :: Verbosity -> TargetsMap -> ElaboratedInstallPlan -> IO () printTargetForms verbosity targets elaboratedPlan = - notice verbosity . render $ + noticeDoc verbosity $ vcat [ text "Fully qualified target forms" Pretty.<> colon , nest 1 $ vcat [text "-" <+> text tf | tf <- targetForms] diff --git a/doc/cabal-commands.rst b/doc/cabal-commands.rst index d13c8bc2da1..fffc50fbec5 100644 --- a/doc/cabal-commands.rst +++ b/doc/cabal-commands.rst @@ -752,20 +752,20 @@ Any target forms except for a script target can be used with ``cabal target``. $ cabal target all:tests ... Fully qualified target forms: - - Cabal-tests:test:check-tests - - Cabal-tests:test:custom-setup-tests - - Cabal-tests:test:hackage-tests - - Cabal-tests:test:no-thunks-test - - Cabal-tests:test:parser-tests - - Cabal-tests:test:rpmvercmp - - Cabal-tests:test:unit-tests - - cabal-benchmarks:test:cabal-benchmarks - - cabal-install-solver:test:unit-tests - - cabal-install:test:integration-tests2 - - cabal-install:test:long-tests - - cabal-install:test:mem-use-tests - - cabal-install:test:unit-tests - - solver-benchmarks:test:unit-tests + - Cabal-tests:test:check-tests + - Cabal-tests:test:custom-setup-tests + - Cabal-tests:test:hackage-tests + - Cabal-tests:test:no-thunks-test + - Cabal-tests:test:parser-tests + - Cabal-tests:test:rpmvercmp + - Cabal-tests:test:unit-tests + - cabal-benchmarks:test:cabal-benchmarks + - cabal-install-solver:test:unit-tests + - cabal-install:test:integration-tests2 + - cabal-install:test:long-tests + - cabal-install:test:mem-use-tests + - cabal-install:test:unit-tests + - solver-benchmarks:test:unit-tests For a package, all, module or filepath target, cabal target [TARGETS] will **only** show ``libs`` and ``exes`` of the [TARGETS]. To also show tests and From ef588c80a1c24fdf793f04007b77198b667bfabe Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Fri, 3 Jan 2025 08:16:30 -0500 Subject: [PATCH 33/39] Satisfy fourmolu --- cabal-install/src/Distribution/Client/CmdTarget.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdTarget.hs b/cabal-install/src/Distribution/Client/CmdTarget.hs index 93554c2cc09..6302a1f8806 100644 --- a/cabal-install/src/Distribution/Client/CmdTarget.hs +++ b/cabal-install/src/Distribution/Client/CmdTarget.hs @@ -104,11 +104,11 @@ targetCommand = ] caution = - text . wrapText $ - "For a package, all, module or filepath target, cabal target [TARGETS] \ - \ will *only* show 'libs' and 'exes' of the [TARGETS]. To also show \ - \ tests and benchmarks, enable them with '--enable-tests' and \ - \ '--enable-benchmarks'." + text . wrapText $ + "For a package, all, module or filepath target, cabal target [TARGETS] \ + \ will *only* show 'libs' and 'exes' of the [TARGETS]. To also show \ + \ tests and benchmarks, enable them with '--enable-tests' and \ + \ '--enable-benchmarks'." examples pname = vcat From 2b0090281d2c78470939ab21540416604563e180 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sat, 4 Jan 2025 08:32:08 -0500 Subject: [PATCH 34/39] Show the number of matches found matching query --- cabal-install/src/Distribution/Client/CmdTarget.hs | 13 ++++++++++--- .../PackageTests/Target/cabal.all-benches.out | 1 + .../Target/cabal.all-enable-benches.out | 1 + .../PackageTests/Target/cabal.all-enable-tests.out | 1 + .../PackageTests/Target/cabal.all-exes.out | 1 + .../PackageTests/Target/cabal.all-tests.out | 1 + .../Target/cabal.component-target-bench.out | 3 +++ .../Target/cabal.component-target-exe.out | 3 +++ .../Target/cabal.component-target-lib.out | 3 +++ .../Target/cabal.component-target-test.out | 3 +++ .../PackageTests/Target/cabal.ctype-target.out | 4 ++++ .../PackageTests/Target/cabal.default-all.out | 1 + .../PackageTests/Target/cabal.everything.out | 1 + .../PackageTests/Target/cabal.explicit-all.out | 1 + .../PackageTests/Target/cabal.package-target.out | 2 ++ .../PackageTests/Target/cabal.path-target.out | 2 ++ 16 files changed, 38 insertions(+), 3 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdTarget.hs b/cabal-install/src/Distribution/Client/CmdTarget.hs index 6302a1f8806..c97be3a1f4d 100644 --- a/cabal-install/src/Distribution/Client/CmdTarget.hs +++ b/cabal-install/src/Distribution/Client/CmdTarget.hs @@ -170,7 +170,7 @@ targetAction flags@NixStyleFlags{..} ts globalFlags = do Nothing targetSelectors - printTargetForms verbosity targets elaboratedPlan + printTargetForms verbosity targetStrings targets elaboratedPlan where verbosity = fromFlagOrDefault normal (configVerbosity configFlags) targetStrings = if null ts then ["all"] else ts @@ -183,14 +183,21 @@ targetAction flags@NixStyleFlags{..} ts globalFlags = do reportBuildTargetProblems :: Verbosity -> [TargetProblem'] -> IO a reportBuildTargetProblems verbosity = reportTargetProblems verbosity "target" -printTargetForms :: Verbosity -> TargetsMap -> ElaboratedInstallPlan -> IO () -printTargetForms verbosity targets elaboratedPlan = +printTargetForms :: Verbosity -> [String] -> TargetsMap -> ElaboratedInstallPlan -> IO () +printTargetForms verbosity targetStrings targets elaboratedPlan = noticeDoc verbosity $ vcat [ text "Fully qualified target forms" Pretty.<> colon , nest 1 $ vcat [text "-" <+> text tf | tf <- targetForms] + , found ] where + found = + let n = length targets + t = if n == 1 then "target" else "targets" + query = intercalate ", " targetStrings + in text "Found" <+> int n <+> text t <+> text "matching" <+> text query Pretty.<> char '.' + localPkgs = [x | Configured x@ElaboratedConfiguredPackage{elabLocalToProject = True} <- InstallPlan.toList elaboratedPlan] diff --git a/cabal-testsuite/PackageTests/Target/cabal.all-benches.out b/cabal-testsuite/PackageTests/Target/cabal.all-benches.out index 621261f013b..ea70119f019 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.all-benches.out +++ b/cabal-testsuite/PackageTests/Target/cabal.all-benches.out @@ -5,3 +5,4 @@ Resolving dependencies... Fully qualified target forms: - a:bench:a-bench - b:bench:b-bench +Found 2 targets matching all:benches. diff --git a/cabal-testsuite/PackageTests/Target/cabal.all-enable-benches.out b/cabal-testsuite/PackageTests/Target/cabal.all-enable-benches.out index fae48570673..76e0c88fe29 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.all-enable-benches.out +++ b/cabal-testsuite/PackageTests/Target/cabal.all-enable-benches.out @@ -12,3 +12,4 @@ Fully qualified target forms: - b:lib:b - b:lib:b-sublib - c:lib:c +Found 9 targets matching all. diff --git a/cabal-testsuite/PackageTests/Target/cabal.all-enable-tests.out b/cabal-testsuite/PackageTests/Target/cabal.all-enable-tests.out index ed8c530e14a..de04e17ca32 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.all-enable-tests.out +++ b/cabal-testsuite/PackageTests/Target/cabal.all-enable-tests.out @@ -12,3 +12,4 @@ Fully qualified target forms: - b:lib:b-sublib - b:test:b-test - c:lib:c +Found 9 targets matching all. diff --git a/cabal-testsuite/PackageTests/Target/cabal.all-exes.out b/cabal-testsuite/PackageTests/Target/cabal.all-exes.out index 6c4eb45c1da..c9c362a5f7b 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.all-exes.out +++ b/cabal-testsuite/PackageTests/Target/cabal.all-exes.out @@ -5,3 +5,4 @@ Resolving dependencies... Fully qualified target forms: - a:exe:a-exe - b:exe:b-exe +Found 2 targets matching all:exes. diff --git a/cabal-testsuite/PackageTests/Target/cabal.all-tests.out b/cabal-testsuite/PackageTests/Target/cabal.all-tests.out index 1ffbaeefca2..7511696f48a 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.all-tests.out +++ b/cabal-testsuite/PackageTests/Target/cabal.all-tests.out @@ -5,3 +5,4 @@ Resolving dependencies... Fully qualified target forms: - a:test:a-test - b:test:b-test +Found 2 targets matching all:tests. diff --git a/cabal-testsuite/PackageTests/Target/cabal.component-target-bench.out b/cabal-testsuite/PackageTests/Target/cabal.component-target-bench.out index 77b7ae1940b..9ec0e6f0705 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.component-target-bench.out +++ b/cabal-testsuite/PackageTests/Target/cabal.component-target-bench.out @@ -4,13 +4,16 @@ Configuration is affected by the following files: Resolving dependencies... Fully qualified target forms: - a:bench:a-bench +Found 1 target matching a:bench:a-bench. # cabal v2-target Configuration is affected by the following files: - cabal.project Fully qualified target forms: - a:bench:a-bench +Found 1 target matching bench:a-bench. # cabal v2-target Configuration is affected by the following files: - cabal.project Fully qualified target forms: - a:bench:a-bench +Found 1 target matching a:a-bench. diff --git a/cabal-testsuite/PackageTests/Target/cabal.component-target-exe.out b/cabal-testsuite/PackageTests/Target/cabal.component-target-exe.out index db06ee2ea2a..84f1841fa2c 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.component-target-exe.out +++ b/cabal-testsuite/PackageTests/Target/cabal.component-target-exe.out @@ -4,13 +4,16 @@ Configuration is affected by the following files: Resolving dependencies... Fully qualified target forms: - a:exe:a-exe +Found 1 target matching a:exe:a-exe. # cabal v2-target Configuration is affected by the following files: - cabal.project Fully qualified target forms: - a:exe:a-exe +Found 1 target matching exe:a-exe. # cabal v2-target Configuration is affected by the following files: - cabal.project Fully qualified target forms: - a:exe:a-exe +Found 1 target matching a:a-exe. diff --git a/cabal-testsuite/PackageTests/Target/cabal.component-target-lib.out b/cabal-testsuite/PackageTests/Target/cabal.component-target-lib.out index ce44bff40f3..63925d3dffd 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.component-target-lib.out +++ b/cabal-testsuite/PackageTests/Target/cabal.component-target-lib.out @@ -4,13 +4,16 @@ Configuration is affected by the following files: Resolving dependencies... Fully qualified target forms: - a:lib:a +Found 1 target matching a:lib:a. # cabal v2-target Configuration is affected by the following files: - cabal.project Fully qualified target forms: - a:lib:a +Found 1 target matching lib:a. # cabal v2-target Configuration is affected by the following files: - cabal.project Fully qualified target forms: - a:lib:a +Found 1 target matching a:a. diff --git a/cabal-testsuite/PackageTests/Target/cabal.component-target-test.out b/cabal-testsuite/PackageTests/Target/cabal.component-target-test.out index 82ed0b891c8..890e8e0ea39 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.component-target-test.out +++ b/cabal-testsuite/PackageTests/Target/cabal.component-target-test.out @@ -4,13 +4,16 @@ Configuration is affected by the following files: Resolving dependencies... Fully qualified target forms: - a:test:a-test +Found 1 target matching a:test:a-test. # cabal v2-target Configuration is affected by the following files: - cabal.project Fully qualified target forms: - a:test:a-test +Found 1 target matching test:a-test. # cabal v2-target Configuration is affected by the following files: - cabal.project Fully qualified target forms: - a:test:a-test +Found 1 target matching a:a-test. diff --git a/cabal-testsuite/PackageTests/Target/cabal.ctype-target.out b/cabal-testsuite/PackageTests/Target/cabal.ctype-target.out index ba56efa6e60..98c0e43d833 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.ctype-target.out +++ b/cabal-testsuite/PackageTests/Target/cabal.ctype-target.out @@ -5,18 +5,22 @@ Resolving dependencies... Fully qualified target forms: - a:lib:a - a:lib:a-sublib +Found 2 targets matching a:libs. # cabal v2-target Configuration is affected by the following files: - cabal.project Fully qualified target forms: - a:exe:a-exe +Found 1 target matching a:exes. # cabal v2-target Configuration is affected by the following files: - cabal.project Fully qualified target forms: - a:test:a-test +Found 1 target matching a:tests. # cabal v2-target Configuration is affected by the following files: - cabal.project Fully qualified target forms: - a:bench:a-bench +Found 1 target matching a:benches. diff --git a/cabal-testsuite/PackageTests/Target/cabal.default-all.out b/cabal-testsuite/PackageTests/Target/cabal.default-all.out index 4b058b57f2a..3c387ebf42e 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.default-all.out +++ b/cabal-testsuite/PackageTests/Target/cabal.default-all.out @@ -10,3 +10,4 @@ Fully qualified target forms: - b:lib:b - b:lib:b-sublib - c:lib:c +Found 7 targets matching all. diff --git a/cabal-testsuite/PackageTests/Target/cabal.everything.out b/cabal-testsuite/PackageTests/Target/cabal.everything.out index 49b2dea466e..c3cc5659a55 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.everything.out +++ b/cabal-testsuite/PackageTests/Target/cabal.everything.out @@ -14,3 +14,4 @@ Fully qualified target forms: - b:lib:b-sublib - b:test:b-test - c:lib:c +Found 11 targets matching all. diff --git a/cabal-testsuite/PackageTests/Target/cabal.explicit-all.out b/cabal-testsuite/PackageTests/Target/cabal.explicit-all.out index 4b058b57f2a..3c387ebf42e 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.explicit-all.out +++ b/cabal-testsuite/PackageTests/Target/cabal.explicit-all.out @@ -10,3 +10,4 @@ Fully qualified target forms: - b:lib:b - b:lib:b-sublib - c:lib:c +Found 7 targets matching all. diff --git a/cabal-testsuite/PackageTests/Target/cabal.package-target.out b/cabal-testsuite/PackageTests/Target/cabal.package-target.out index 2a621cd91f7..8b122c97a69 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.package-target.out +++ b/cabal-testsuite/PackageTests/Target/cabal.package-target.out @@ -6,6 +6,7 @@ Fully qualified target forms: - a:exe:a-exe - a:lib:a - a:lib:a-sublib +Found 3 targets matching a. # cabal v2-target Configuration is affected by the following files: - cabal.project @@ -16,3 +17,4 @@ Fully qualified target forms: - a:lib:a - a:lib:a-sublib - a:test:a-test +Found 5 targets matching a. diff --git a/cabal-testsuite/PackageTests/Target/cabal.path-target.out b/cabal-testsuite/PackageTests/Target/cabal.path-target.out index 2a621cd91f7..4e4bc9cec20 100644 --- a/cabal-testsuite/PackageTests/Target/cabal.path-target.out +++ b/cabal-testsuite/PackageTests/Target/cabal.path-target.out @@ -6,6 +6,7 @@ Fully qualified target forms: - a:exe:a-exe - a:lib:a - a:lib:a-sublib +Found 3 targets matching dir-a/. # cabal v2-target Configuration is affected by the following files: - cabal.project @@ -16,3 +17,4 @@ Fully qualified target forms: - a:lib:a - a:lib:a-sublib - a:test:a-test +Found 5 targets matching dir-a/. From fa6623dd90adb7ac4c6b9b12b7c88495d67065b9 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sat, 4 Jan 2025 12:19:54 -0500 Subject: [PATCH 35/39] Change synopsis of command, target verb --- cabal-install/src/Distribution/Client/CmdTarget.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal-install/src/Distribution/Client/CmdTarget.hs b/cabal-install/src/Distribution/Client/CmdTarget.hs index c97be3a1f4d..90ad709e88b 100644 --- a/cabal-install/src/Distribution/Client/CmdTarget.hs +++ b/cabal-install/src/Distribution/Client/CmdTarget.hs @@ -55,7 +55,7 @@ targetCommand :: CommandUI (NixStyleFlags ()) targetCommand = CommandUI { commandName = "v2-target" - , commandSynopsis = "Disclose selected targets." + , commandSynopsis = "Target a subset of all targets." , commandUsage = usageAlternatives "v2-target" ["[TARGETS]"] , commandDescription = Just . const . render $ From a9443e940f62a48ae50f9b805620c1ece68c0c31 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 8 Jan 2025 10:50:00 -0500 Subject: [PATCH 36/39] Remove disclosed, use show, WARN and NOTE --- .../src/Distribution/Client/CmdTarget.hs | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdTarget.hs b/cabal-install/src/Distribution/Client/CmdTarget.hs index 90ad709e88b..19086f5886a 100644 --- a/cabal-install/src/Distribution/Client/CmdTarget.hs +++ b/cabal-install/src/Distribution/Client/CmdTarget.hs @@ -63,6 +63,7 @@ targetCommand = [ intro , vcat $ punctuate (text "\n") [targetForms, ctypes, Pretty.empty] , caution + , unique ] , commandNotes = Just $ \pname -> render $ examples pname , commandDefaultFlags = defaultNixStyleFlags () @@ -72,9 +73,10 @@ targetCommand = intro = text . wrapText $ "Discover targets in a project for use with other commands taking [TARGETS].\n\n" - ++ "Discloses fully-qualified targets from a selection of target form" - ++ " [TARGETS] (or 'all' if none given). Can also check if a target form is" - ++ " unique as some commands require a unique TARGET." + ++ "This command, like many others, takes [TARGETS]. Taken together, these will" + ++ " select for a set of targets in the project. When none are supplied, the" + ++ " commands acts as if 'all' was supplied." + ++ " Targets in the returned subset are shown sorted and fully-qualified." targetForms = vcat @@ -105,11 +107,18 @@ targetCommand = caution = text . wrapText $ - "For a package, all, module or filepath target, cabal target [TARGETS] \ + "WARNING: For a package, all, module or filepath target, cabal target [TARGETS] \ \ will *only* show 'libs' and 'exes' of the [TARGETS]. To also show \ \ tests and benchmarks, enable them with '--enable-tests' and \ \ '--enable-benchmarks'." + unique = + text . wrapText $ + "NOTE: For commands expecting a unique TARGET, a fully-qualified target is the safe \ + \ way to go but it may be convenient to type out a shorter TARGET. For example, if the \ + \ set of 'cabal target all:exes' has one item then 'cabal list-bin all:exes' will \ + \ work too." + examples pname = vcat [ text "Examples" Pretty.<> colon From 9be7d5e976e631e3dfe34c3bb0ce19b6ce87002e Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 9 Jan 2025 15:44:36 -0500 Subject: [PATCH 37/39] Typo command singular --- cabal-install/src/Distribution/Client/CmdTarget.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal-install/src/Distribution/Client/CmdTarget.hs b/cabal-install/src/Distribution/Client/CmdTarget.hs index 19086f5886a..b8948ef5721 100644 --- a/cabal-install/src/Distribution/Client/CmdTarget.hs +++ b/cabal-install/src/Distribution/Client/CmdTarget.hs @@ -75,7 +75,7 @@ targetCommand = "Discover targets in a project for use with other commands taking [TARGETS].\n\n" ++ "This command, like many others, takes [TARGETS]. Taken together, these will" ++ " select for a set of targets in the project. When none are supplied, the" - ++ " commands acts as if 'all' was supplied." + ++ " command acts as if 'all' was supplied." ++ " Targets in the returned subset are shown sorted and fully-qualified." targetForms = From c673faf2128a87269f2b67786f3acee83ba1412a Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 9 Jan 2025 15:47:42 -0500 Subject: [PATCH 38/39] Bring the command docs inline with --help docs --- doc/cabal-commands.rst | 31 ++++++++++++++++++++++--------- 1 file changed, 22 insertions(+), 9 deletions(-) diff --git a/doc/cabal-commands.rst b/doc/cabal-commands.rst index fffc50fbec5..3b4d7ae4bff 100644 --- a/doc/cabal-commands.rst +++ b/doc/cabal-commands.rst @@ -36,7 +36,7 @@ Commands gen-bounds Generate dependency bounds. outdated Check for outdated dependencies. path Query for simple project information. - target Disclose selected targets. + target Target a subset of all targets. [project building and installing] build Compile targets within the project. @@ -740,12 +740,16 @@ Scripting example: cabal target ^^^^^^^^^^^^ -``cabal target [TARGETS]`` discloses fully-qualified targets from a selection of -targets and is useful for discovering targets in a project for use with other -commands taking [TARGETS]. This command can also check if a :ref:`target -form` is unique as some commands require a unique TARGET. +This command is useful for discovering targets in a project for use with other +commands taking ``[TARGETS]``. -Any target forms except for a script target can be used with ``cabal target``. +Any :ref:`target form` except for a script target can be used with +``cabal target``. + +This command, like many others, takes ``[TARGETS]``. Taken together, these will +select for a set of targets in the project. When none are supplied, the command +acts as if ``all`` was supplied. Targets in the returned subset are shown sorted +and fully-qualified. .. code-block:: console @@ -767,9 +771,18 @@ Any target forms except for a script target can be used with ``cabal target``. - cabal-install:test:unit-tests - solver-benchmarks:test:unit-tests -For a package, all, module or filepath target, cabal target [TARGETS] will -**only** show ``libs`` and ``exes`` of the [TARGETS]. To also show tests and -benchmarks, enable them with ``--enable-tests`` and ``--enable-benchmarks``. +.. warning:: + + For a package, all, module or filepath target, ``cabal target [TARGETS]`` will + **only** show ``libs`` and ``exes`` of the ``[TARGETS]``. To also show tests and + benchmarks, enable them with ``--enable-tests`` and ``--enable-benchmarks``. + +.. note:: + + For commands expecting a unique ``TARGET``, a fully-qualified target is the safe + way to go but it may be convenient to type out a shorter ``TARGET``. For + example, if the set of ``cabal target all:exes`` has one item then ``cabal + list-bin all:exes`` will work too. .. _command-group-build: From 213585837b8d6e6379b36097e9b462dc054a3d67 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Fri, 10 Jan 2025 07:05:18 -0500 Subject: [PATCH 39/39] Remove disclosing from changelog --- changelog.d/pr-9744.md | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/changelog.d/pr-9744.md b/changelog.d/pr-9744.md index 747f305a556..6f149d82162 100644 --- a/changelog.d/pr-9744.md +++ b/changelog.d/pr-9744.md @@ -1,11 +1,18 @@ --- -synopsis: Discovery targets in a project +synopsis: Discover targets in a project packages: [cabal-install] prs: 9744 issues: [4070,8953] significance: significant --- -Adds a `cabal target` command for discovering, disclosing and checking selected -targets. The returned list shows targets in fully-qualified form. These are -unambiguous and can be used with other commands expecting `[TARGETS]`. +Adds a `cabal target` command that is useful for discovering targets in a +project for use with other commands taking ``[TARGETS]``. + +Any target form except for a script target can be used with ``cabal target``. + +This command, like many others, takes ``[TARGETS]``. Taken together, these will +select for a set of targets in the project. When none are supplied, the command +acts as if ``all`` was supplied. Targets in the returned subset are shown sorted +and fully-qualified with package, component type and component name such as +`Cabal-tests:test:hackage-tests`.