From a2055660d3def010ecb0057fd88b87f8ebd1d127 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sat, 1 Aug 2026 21:39:14 -0400 Subject: [PATCH 01/85] Use optparse-applicative for build command --- cabal-install/cabal-install.cabal | 1 + .../src/Distribution/Client/CmdBuild.hs | 136 +++++++++++++++++- cabal-install/src/Distribution/Client/Main.hs | 23 ++- 3 files changed, 158 insertions(+), 2 deletions(-) diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 3de8bccf6fc..33eb707a3e1 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -256,6 +256,7 @@ library , HTTP >= 4000.1.5 && < 4000.6 , mtl >= 2.0 && < 2.4 , network-uri >= 2.6.2.0 && < 2.7 + , optparse-applicative >= 0.18 && < 0.19 , pretty >= 1.1 && < 1.2 , process >= 1.6.29.0 && < 1.7 , random >= 1.2 && < 1.4 diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 7314187b815..b85ab621386 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -1,8 +1,12 @@ +{-# LANGUAGE LambdaCase #-} + -- | cabal-install CLI command: build module Distribution.Client.CmdBuild ( -- * The @build@ CLI and action buildCommand , buildAction + , parseBuildCommand + , isBuildCommandName , BuildFlags (..) , defaultBuildFlags @@ -25,6 +29,7 @@ import Distribution.Client.TargetProblem ) import qualified Data.Map as Map +import Data.Monoid (Endo (..), appEndo) import Distribution.Client.Errors import Distribution.Client.NixStyleOptions ( NixStyleFlags (..) @@ -43,7 +48,12 @@ import Distribution.Client.Setup , yesNoOpt ) import Distribution.Simple.Command - ( CommandUI (..) + ( CommandParse (..) + , CommandUI (..) + , OptDescr (..) + , OptionField (..) + , ShowOrParseArgs (ParseArgs) + , commandParseArgs , option , usageAlternatives ) @@ -56,6 +66,10 @@ import Distribution.Verbosity ( normal ) +import Distribution.ReadE (runReadE) + +import qualified Options.Applicative as O + buildCommand :: CommandUI (NixStyleFlags BuildFlags) buildCommand = CommandUI @@ -236,3 +250,123 @@ reportBuildTargetProblems verbosity problems = reportCannotPruneDependencies :: Verbosity -> CannotPruneDependencies -> IO a reportCannotPruneDependencies verbosity = dieWithException verbosity . ReportCannotPruneDependencies . renderCannotPruneDependencies + +buildCommandNames :: [String] +buildCommandNames = ["build", "new-build", commandName buildCommand] + +isBuildCommandName :: String -> Bool +isBuildCommandName name = name `elem` buildCommandNames + +buildListOptions :: [String] +buildListOptions = + case commandParseArgs buildCommand False ["--list-options"] of + CommandList opts -> opts + _ -> [] + +parseBuildCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) +parseBuildCommand invokedName cmdArgs = + case O.execParserPure O.defaultPrefs (buildParserInfo invokedName) cmdArgs of + O.Success parsed -> + if parsedListOptions parsed + then CommandList buildListOptions + else + let flags = appEndo (parsedFlagEdits parsed) (commandDefaultFlags buildCommand) + in CommandReadyToGo (buildAction flags (parsedTargets parsed)) + O.Failure failure -> + let (msg, exitCode) = O.renderFailure failure ("cabal " ++ invokedName) + in if exitCode == ExitSuccess + then CommandHelp (const msg) + else CommandErrors [msg] + O.CompletionInvoked _ -> + CommandErrors ["Shell completion is not supported by this parser path."] + +buildParserInfo :: String -> O.ParserInfo ParsedBuildCommand +buildParserInfo invokedName = + O.info + (parsedBuildCommandParser O.<**> O.helper) + ( O.fullDesc + <> O.progDesc (commandSynopsis buildCommand) + <> O.header ("cabal " ++ invokedName) + ) + +data ParsedBuildCommand = ParsedBuildCommand + { parsedFlagEdits :: Endo (NixStyleFlags BuildFlags) + , parsedTargets :: [String] + , parsedListOptions :: Bool + } + +data BuildItem + = BuildItemFlag (Endo (NixStyleFlags BuildFlags)) + | BuildItemTarget String + | BuildItemListOptions + +parsedBuildCommandParser :: O.Parser ParsedBuildCommand +parsedBuildCommandParser = toParsed <$> O.many buildItemParser + where + toParsed items = + let edits = [e | BuildItemFlag e <- items] + targets = [t | BuildItemTarget t <- items] + listOptionsSeen = any isListOptions items + in ParsedBuildCommand + { parsedFlagEdits = mconcat edits + , parsedTargets = targets + , parsedListOptions = listOptionsSeen + } + + isListOptions BuildItemListOptions = True + isListOptions _ = False + +buildItemParser :: O.Parser BuildItem +buildItemParser = + O.asum + ( buildOptionParsers + ++ [ BuildItemListOptions + <$ O.flag' + () + (O.long "list-options" <> O.help "Print a list of command line flags") + , BuildItemTarget <$> O.strArgument (O.metavar "TARGET") + ] + ) + +buildOptionParsers :: [O.Parser BuildItem] +buildOptionParsers = + concatMap optionFieldParsers (commandOptions buildCommand ParseArgs) + +optionFieldParsers :: OptionField (NixStyleFlags BuildFlags) -> [O.Parser BuildItem] +optionFieldParsers (OptionField _ descrs) = concatMap optDescrParsers descrs + +optDescrParsers :: OptDescr (NixStyleFlags BuildFlags) -> [O.Parser BuildItem] +optDescrParsers = \case + ReqArg desc optFlags placeHolder reader _show -> + [ BuildItemFlag . Endo + <$> O.option + (O.eitherReader (runReadE reader)) + (optionMods optFlags <> O.metavar placeHolder <> O.help desc) + ] + OptArg desc optFlags placeHolder reader (_defaultText, defaultFn) _show -> + [ BuildItemFlag . Endo + <$> ( O.option + (O.eitherReader (runReadE reader)) + (optionMods optFlags <> O.metavar placeHolder <> O.help desc) + <|> O.flag' defaultFn (flagMods optFlags <> O.internal) + ) + ] + ChoiceOpt choices -> + [ BuildItemFlag (Endo setFn) + <$ O.flag' () (flagMods optFlags <> O.help desc) + | (desc, optFlags, setFn, _get) <- choices + ] + BoolOpt desc trueFlags falseFlags setFn _get -> + [ BuildItemFlag (Endo (setFn True)) + <$ O.flag' () (flagMods trueFlags <> O.help desc) + , BuildItemFlag (Endo (setFn False)) + <$ O.flag' () (flagMods falseFlags <> O.help desc) + ] + +optionMods :: (String, [String]) -> O.Mod O.OptionFields a +optionMods (shortFlags, longFlags) = + mconcat (map O.short shortFlags) <> mconcat (map O.long longFlags) + +flagMods :: (String, [String]) -> O.Mod O.FlagFields a +flagMods (shortFlags, longFlags) = + mconcat (map O.short shortFlags) <> mconcat (map O.long longFlags) diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index dc41e483a5e..e6dcb6051a8 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -199,6 +199,7 @@ import Distribution.Simple.Command , CommandUI (..) , commandAddAction , commandFromSpec + , commandParseArgs , commandShowOptions , commandsRunWithFallback , defaultCommandFallback @@ -344,7 +345,7 @@ warnIfAssertionsAreEnabled = mainWorker :: [String] -> IO () mainWorker args = do topHandler (isUserException (Proxy @(VerboseException CabalInstallException))) $ do - command <- commandsRunWithFallback (globalCommand commands) commands delegateToExternal args + command <- commandsRunBuildOptparseFirst args case command of CommandHelp help -> printGlobalHelp help CommandList opts -> printOptionsList opts @@ -376,6 +377,24 @@ mainWorker args = do warnIfAssertionsAreEnabled action globalFlags where + commandsRunBuildOptparseFirst :: [String] -> IO (CommandParse (GlobalFlags, CommandParse Action)) + commandsRunBuildOptparseFirst argv = + case parseBuildWithOptparse argv of + Just parsed -> pure parsed + Nothing -> commandsRunWithFallback globalCmd commands delegateToExternal argv + + parseBuildWithOptparse :: [String] -> Maybe (CommandParse (GlobalFlags, CommandParse Action)) + parseBuildWithOptparse argv = + case commandParseArgs globalCmd True argv of + CommandReadyToGo (mkGlobalFlags, cmdArgs0) -> + case cmdArgs0 of + (cmdName : cmdArgs) + | CmdBuild.isBuildCommandName cmdName -> + let globalFlags = mkGlobalFlags (commandDefaultFlags globalCmd) + in Just $ CommandReadyToGo (globalFlags, CmdBuild.parseBuildCommand cmdName cmdArgs) + _ -> Nothing + _ -> Nothing + delegateToExternal :: [Command Action] -> String @@ -454,6 +473,8 @@ mainWorker args = do | cabalGitInfo == cabalInstallGitInfo = "(in-tree)" | otherwise = cabalGitInfo + globalCmd = globalCommand commands + commands = map commandFromSpec commandSpecs commandSpecs = [ regularCmd listCommand listAction From 06dbf34d5a46b316723341a9c7977cd889374953 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sat, 1 Aug 2026 21:56:26 -0400 Subject: [PATCH 02/85] Intro and examples, no flags in usage --- .../src/Distribution/Client/CmdBuild.hs | 55 +++++++++++++++---- 1 file changed, 43 insertions(+), 12 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index b85ab621386..5f71558bea4 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -30,6 +30,7 @@ import Distribution.Client.TargetProblem import qualified Data.Map as Map import Data.Monoid (Endo (..), appEndo) +import qualified Data.Text as T import Distribution.Client.Errors import Distribution.Client.NixStyleOptions ( NixStyleFlags (..) @@ -90,27 +91,27 @@ buildCommand = ++ "'cabal.project.local' and other files." , commandNotes = Just $ \pname -> "Examples:\n" - ++ " " + ++ " - " ++ pname ++ " v2-build\n" - ++ " Build the package in the current directory " + ++ " Build the package in the current directory " ++ "or all packages in the project\n" - ++ " " + ++ " - " ++ pname ++ " v2-build pkgname\n" - ++ " Build the package named pkgname in the project\n" - ++ " " + ++ " Build the package named pkgname in the project\n" + ++ " - " ++ pname ++ " v2-build ./pkgfoo\n" - ++ " Build the package in the ./pkgfoo directory\n" - ++ " " + ++ " Build the package in the ./pkgfoo directory\n" + ++ " - " ++ pname ++ " v2-build cname\n" - ++ " Build the component named cname in the project\n" - ++ " " + ++ " Build the component named cname in the project\n" + ++ " - " ++ pname ++ " v2-build cname --enable-profiling\n" - ++ " Build the component in profiling mode " + ++ " Build the component in profiling mode " ++ "(including dependencies as needed)\n" , commandDefaultFlags = defaultNixStyleFlags defaultBuildFlags , commandOptions = @@ -263,6 +264,13 @@ buildListOptions = CommandList opts -> opts _ -> [] +buildHelpText :: String -> String -> String +buildHelpText invokedName pname = + case commandParseArgs buildCommand False ["--help"] of + CommandHelp mkHelp -> + T.unpack . T.replace (T.pack "v2-build") (T.pack invokedName) . T.pack $ mkHelp pname + _ -> "Usage: " <> pname <> " " <> invokedName <> " [TARGETS] [FLAGS]\n" + parseBuildCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) parseBuildCommand invokedName cmdArgs = case O.execParserPure O.defaultPrefs (buildParserInfo invokedName) cmdArgs of @@ -275,7 +283,7 @@ parseBuildCommand invokedName cmdArgs = O.Failure failure -> let (msg, exitCode) = O.renderFailure failure ("cabal " ++ invokedName) in if exitCode == ExitSuccess - then CommandHelp (const msg) + then CommandHelp (buildHelpText invokedName) else CommandErrors [msg] O.CompletionInvoked _ -> CommandErrors ["Shell completion is not supported by this parser path."] @@ -285,10 +293,33 @@ buildParserInfo invokedName = O.info (parsedBuildCommandParser O.<**> O.helper) ( O.fullDesc - <> O.progDesc (commandSynopsis buildCommand) + <> O.progDesc (buildHelpDescription) <> O.header ("cabal " ++ invokedName) + <> O.footer (buildExamplesSection invokedName) ) +buildHelpDescription :: String +buildHelpDescription = + case commandDescription buildCommand of + Nothing -> commandSynopsis buildCommand + Just mkDescription -> mkDescription "cabal" + +buildExamplesSection :: String -> String +buildExamplesSection invokedName = + unlines + [ "Examples:" + , " - " <> invokedName + , " Build the package in the current directory or all packages in the project" + , " - " <> invokedName <> " pkgname" + , " Build the package named pkgname in the project" + , " - " <> invokedName <> " ./pkgfoo" + , " Build the package in the ./pkgfoo directory" + , " - " <> invokedName <> " cname" + , " Build the component named cname in the project" + , " - " <> invokedName <> " cname --enable-profiling" + , " Build the component in profiling mode (including dependencies as needed)" + ] + data ParsedBuildCommand = ParsedBuildCommand { parsedFlagEdits :: Endo (NixStyleFlags BuildFlags) , parsedTargets :: [String] From ee50592651bdc0a93e2acd9bd45b2fd8d4ec0cc5 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sat, 1 Aug 2026 22:24:21 -0400 Subject: [PATCH 03/85] Group options --- .../src/Distribution/Client/CmdBuild.hs | 144 +++++++++++- .../Distribution/Client/NixStyleOptions.hs | 207 ++++++++++++++++++ 2 files changed, 346 insertions(+), 5 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 5f71558bea4..d84cb53ea20 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -31,12 +31,31 @@ import Distribution.Client.TargetProblem import qualified Data.Map as Map import Data.Monoid (Endo (..), appEndo) import qualified Data.Text as T +import qualified System.Console.GetOpt as GetOpt import Distribution.Client.Errors import Distribution.Client.NixStyleOptions ( NixStyleFlags (..) , cfgVerbosity , defaultNixStyleFlags , nixStyleOptions + , removeBenchOptions + , removeCompilerOptions + , removeConfigureOptions + , removeCoverageOptions + , removeExeOptions + , removeHaddockOptions + , removeIncludeOptions + , removeInstallOptions + , removeIrrelevantOptions + , removeLibOptions + , removeLoggingOptions + , removeOutputOptions + , removePhaseOptions + , removeProgOptions + , removeProfilingOptions + , removeSolvingOptions + , removeTestOptions + , removeUnsupportedOptions ) import Distribution.Client.ScriptUtils ( AcceptNoTargets (..) @@ -53,7 +72,7 @@ import Distribution.Simple.Command , CommandUI (..) , OptDescr (..) , OptionField (..) - , ShowOrParseArgs (ParseArgs) + , ShowOrParseArgs (ParseArgs, ShowArgs) , commandParseArgs , option , usageAlternatives @@ -264,12 +283,127 @@ buildListOptions = CommandList opts -> opts _ -> [] +type BuildOptionField = OptionField (NixStyleFlags BuildFlags) + buildHelpText :: String -> String -> String buildHelpText invokedName pname = - case commandParseArgs buildCommand False ["--help"] of - CommandHelp mkHelp -> - T.unpack . T.replace (T.pack "v2-build") (T.pack invokedName) . T.pack $ mkHelp pname - _ -> "Usage: " <> pname <> " " <> invokedName <> " [TARGETS] [FLAGS]\n" + commandSynopsis buildCommand + <> "\n\n" + <> replaceBuildAlias invokedName (commandUsage buildCommand pname) + <> maybe "" (('\n' :) . ($ pname)) (commandDescription buildCommand) + <> "\n" + <> "Flags for build:" + <> GetOpt.usageInfo "" (commonHelpOptions ++ concatMap optionFieldToGetOpt buildUngroupedOptions) + <> concatMap renderGroup buildOptionGroups + <> maybe "" (('\n' :) . replaceBuildAlias invokedName . ($ pname)) (commandNotes buildCommand) + where + commonHelpOptions :: [GetOpt.OptDescr ()] + commonHelpOptions = + [GetOpt.Option ['h'] ["help"] (GetOpt.NoArg ()) "Show this help text"] + + renderGroup :: (String, [BuildOptionField]) -> String + renderGroup (title, options) + | null options = "" + | otherwise = "\n" <> title <> ":" <> GetOpt.usageInfo "" (concatMap optionFieldToGetOpt options) + +buildOptionGroups :: [(String, [BuildOptionField])] +buildOptionGroups = + [ ("Unsupported options", unsupported) + , ("Install layout options", install) + , ("Irrelevant options", irrelevant) + , ("Haddock options", haddock) + , ("Test options", test) + , ("Benchmark options", bench) + , ("Profiling options", profiling) + , ("Dependency solving options", solving) + , ("Executable build options", exe) + , ("Library build options", lib) + , ("Coverage options", coverage) + , ("Output and artifact options", output) + , ("Configure-phase options", configure) + , ("Build phase control options", phase) + , ("Compiler and parallelism options", compiler) + , ("Logging and reporting options", logging) + , ("Include and linker path options", includePaths) + , ("Program override options", prog) + ] + where + opts0 = commandOptions buildCommand ShowArgs + + (unsupported, opts1) = splitBy removeUnsupportedOptions opts0 + (install, opts2) = splitBy removeInstallOptions opts1 + (irrelevant, opts3) = splitBy removeIrrelevantOptions opts2 + (haddock, opts4) = splitBy removeHaddockOptions opts3 + (test, opts5) = splitBy removeTestOptions opts4 + (bench, opts6) = splitBy removeBenchOptions opts5 + (profiling, opts7) = splitBy removeProfilingOptions opts6 + (solving, opts8) = splitBy removeSolvingOptions opts7 + (exe, opts9) = splitBy removeExeOptions opts8 + (lib, opts10) = splitBy removeLibOptions opts9 + (coverage, opts11) = splitBy removeCoverageOptions opts10 + (output, opts12) = splitBy removeOutputOptions opts11 + (configure, opts13) = splitBy removeConfigureOptions opts12 + (phase, opts14) = splitBy removePhaseOptions opts13 + (compiler, opts15) = splitBy removeCompilerOptions opts14 + (logging, opts16) = splitBy removeLoggingOptions opts15 + (includePaths, opts17) = splitBy removeIncludeOptions opts16 + (prog, _opts18) = splitBy removeProgOptions opts17 + +buildUngroupedOptions :: [BuildOptionField] +buildUngroupedOptions = + opts18 + where + opts0 = commandOptions buildCommand ShowArgs + (_, opts1) = splitBy removeUnsupportedOptions opts0 + (_, opts2) = splitBy removeInstallOptions opts1 + (_, opts3) = splitBy removeIrrelevantOptions opts2 + (_, opts4) = splitBy removeHaddockOptions opts3 + (_, opts5) = splitBy removeTestOptions opts4 + (_, opts6) = splitBy removeBenchOptions opts5 + (_, opts7) = splitBy removeProfilingOptions opts6 + (_, opts8) = splitBy removeSolvingOptions opts7 + (_, opts9) = splitBy removeExeOptions opts8 + (_, opts10) = splitBy removeLibOptions opts9 + (_, opts11) = splitBy removeCoverageOptions opts10 + (_, opts12) = splitBy removeOutputOptions opts11 + (_, opts13) = splitBy removeConfigureOptions opts12 + (_, opts14) = splitBy removePhaseOptions opts13 + (_, opts15) = splitBy removeCompilerOptions opts14 + (_, opts16) = splitBy removeLoggingOptions opts15 + (_, opts17) = splitBy removeIncludeOptions opts16 + (_, opts18) = splitBy removeProgOptions opts17 + +splitBy + :: (BuildOptionField -> Bool) + -> [BuildOptionField] + -> ([BuildOptionField], [BuildOptionField]) +splitBy keepPred = partition (not . keepPred) + +optionFieldToGetOpt :: BuildOptionField -> [GetOpt.OptDescr ()] +optionFieldToGetOpt (OptionField _ descrs) = concatMap optDescrToGetOpt descrs + +optDescrToGetOpt :: OptDescr (NixStyleFlags BuildFlags) -> [GetOpt.OptDescr ()] +optDescrToGetOpt = \case + ReqArg desc (shortFlags, longFlags) placeHolder _reader _showFlag -> + [GetOpt.Option shortFlags longFlags (GetOpt.ReqArg (const ()) placeHolder) desc] + OptArg desc (shortFlags, longFlags) placeHolder _reader (_defaultValue, _defaultSetter) _showFlag -> + [GetOpt.Option shortFlags longFlags (GetOpt.OptArg (const ()) placeHolder) desc] + ChoiceOpt choices -> + [ GetOpt.Option shortFlags longFlags (GetOpt.NoArg ()) desc + | (desc, (shortFlags, longFlags), _setFn, _getFn) <- choices + ] + BoolOpt desc (shortTrue, longTrue) (shortFalse, longFalse) _setFn _getFn + | null shortFalse && null longFalse -> + [GetOpt.Option shortTrue longTrue (GetOpt.NoArg ()) desc] + | null shortTrue && null longTrue -> + [GetOpt.Option shortFalse longFalse (GetOpt.NoArg ()) desc] + | otherwise -> + [ GetOpt.Option shortTrue longTrue (GetOpt.NoArg ()) ("Enable " <> desc) + , GetOpt.Option shortFalse longFalse (GetOpt.NoArg ()) ("Disable " <> desc) + ] + +replaceBuildAlias :: String -> String -> String +replaceBuildAlias invokedName = T.unpack . T.replace (T.pack "v2-build") (T.pack invokedName) . T.pack parseBuildCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) parseBuildCommand invokedName cmdArgs = diff --git a/cabal-install/src/Distribution/Client/NixStyleOptions.hs b/cabal-install/src/Distribution/Client/NixStyleOptions.hs index 6201df0d316..dac12b8c71e 100644 --- a/cabal-install/src/Distribution/Client/NixStyleOptions.hs +++ b/cabal-install/src/Distribution/Client/NixStyleOptions.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE ViewPatterns #-} + -- | Command line options for nix-style / v2 commands. -- -- The commands take a lot of the same options, which affect how install plan @@ -8,6 +10,26 @@ module Distribution.Client.NixStyleOptions , defaultNixStyleFlags , updNixStyleCommonSetupFlags , cfgVerbosity + + -- * Option filtering/grouping predicates + , removeUnsupportedOptions + , removeInstallOptions + , removeIrrelevantOptions + , removeHaddockOptions + , removeTestOptions + , removeBenchOptions + , removeProfilingOptions + , removeSolvingOptions + , removeExeOptions + , removeLibOptions + , removeCoverageOptions + , removeOutputOptions + , removeConfigureOptions + , removePhaseOptions + , removeCompilerOptions + , removeLoggingOptions + , removeIncludeOptions + , removeProgOptions ) where import Distribution.Client.Compat.Prelude @@ -40,6 +62,7 @@ import Distribution.Client.Setup , liftOptions , testOptions ) +import Distribution.Simple.Utils (isInfixOf) import Distribution.Verbosity (VerbosityFlags, defaultVerbosityHandles, mkVerbosity) data NixStyleFlags a = NixStyleFlags @@ -162,3 +185,187 @@ cfgVerbosity :: VerbosityFlags -> NixStyleFlags a -> Verbosity cfgVerbosity v flags = mkVerbosity defaultVerbosityHandles $ fromFlagOrDefault v (setupVerbosity . configCommonFlags $ configFlags flags) + +removeUnsupportedOptions :: OptionField a -> Bool +removeUnsupportedOptions = + (\(optionName -> o) -> not ("root-cmd" == o || "allow-boot-library-installs" == o)) + +removeInstallOptions :: OptionField a -> Bool +removeInstallOptions = + ( \(optionName -> o) -> + not + ( "dir" `isSuffixOf` o + || "reinstall" `isInfixOf` o + || "run-tests" == o + || "root-cmd" == o + || "allow-boot-library-installs" == o + || "program-prefix" == o + || "program-suffix" == o + || "ipid" == o + || "cid" == o + || "user" == o + || "global" == o + || "prefix" == o + ) + ) + +removeIrrelevantOptions :: OptionField a -> Bool +removeIrrelevantOptions = (\(optionName -> o) -> not ("per-component" `isSuffixOf` o)) + +removeHaddockOptions :: OptionField a -> Bool +removeHaddockOptions = + ( \(optionName -> o) -> + not + ( "haddock" `isPrefixOf` o + || "documentation" `isSuffixOf` o + || "doc-index-file" == o + ) + ) + +removeTestOptions :: OptionField a -> Bool +removeTestOptions = (\(optionName -> o) -> not ("test" `isPrefixOf` o)) + +removeBenchOptions :: OptionField a -> Bool +removeBenchOptions = (\(optionName -> o) -> not ("bench" `isPrefixOf` o)) + +removeProfilingOptions :: OptionField a -> Bool +removeProfilingOptions = (\(optionName -> o) -> not ("profiling" `isInfixOf` o)) + +removeSolvingOptions :: OptionField a -> Bool +removeSolvingOptions = + ( \(optionName -> o) -> + not + ( "max-backjumps" == o + || "conflicts" `isInfixOf` o + || "goals" `isInfixOf` o + || "index-state" == o + || "upgrade-dependencies" == o + || "reject-unconstrained-dependencies" == o + || "prefer-oldest" == o + || "allow-older" == o + || "allow-newer" == o + || "preference" == o + || "shadow-installed-packages" == o + || "ignore-build-tools" == o + || "solver" == o + || "only-dependencies" == o + || "dependencies-only" == o + || "minimize-conflict-set" == o + || "allow-depending-on-private-libs" == o + ) + ) + +removeExeOptions :: OptionField a -> Bool +removeExeOptions = + ( \(optionName -> o) -> + not + ( "executable" `isInfixOf` o + || "split" `isInfixOf` o + || "stripping" `isInfixOf` o + ) + ) + +removeLibOptions :: OptionField a -> Bool +removeLibOptions = + ( \(optionName -> o) -> + not + ( "vanilla" `isSuffixOf` o + || "shared" `isSuffixOf` o + || "static" `isSuffixOf` o + || "bytecode" `isSuffixOf` o + || "ghci" `isSuffixOf` o + ) + ) + +removeCoverageOptions :: OptionField a -> Bool +removeCoverageOptions = + ( \(optionName -> o) -> + not + ( "coverage" `isSuffixOf` o + || "coverage" `isPrefixOf` o + ) + ) + +removeOutputOptions :: OptionField a -> Bool +removeOutputOptions = + ( \(optionName -> o) -> + not + ( "build-info" `isSuffixOf` o + || "debug-info" `isSuffixOf` o + || "deterministic" `isSuffixOf` o + || "relocatable" `isSuffixOf` o + || "write-ghc-environment-files" == o + ) + ) + +removeConfigureOptions :: OptionField a -> Bool +removeConfigureOptions = + ( \(optionName -> o) -> + not + ( "append" `isSuffixOf` o + || "backup" `isSuffixOf` o + || "configure-option" == o + ) + ) + +removePhaseOptions :: OptionField a -> Bool +removePhaseOptions = + ( \(optionName -> o) -> + not + ( "only-configure" == o + || "only-download" == o + || "dry-run" == o + ) + ) + +removeCompilerOptions :: OptionField a -> Bool +removeCompilerOptions = + ( \(optionName -> o) -> + not + ( "ghc" == o + || "ghcjs" == o + || "uhc" == o + || "with-compiler" == o + || "cabal-lib-version" == o + || "optimization" `isSuffixOf` o + || "semaphore" == o + || "jobs" == o + || "keep-going" == o + || "offline" == o + ) + ) + +removeLoggingOptions :: OptionField a -> Bool +removeLoggingOptions = + ( \(optionName -> o) -> + not + ( "verbose" == o + || "keep-temp-files" == o + || "build-summary" == o + || "build-log" == o + || "build-timings" == o + || "remote-build-reporting" == o + || "report-planning-failure" == o + ) + ) + +removeIncludeOptions :: OptionField a -> Bool +removeIncludeOptions = + ( \(optionName -> o) -> + not + ( "extra-include-dirs" == o + || "extra-lib-dirs" == o + || "extra-framework-dirs" == o + || "extra-prog-path" == o + || "disable-response-files" == o + ) + ) + +removeProgOptions :: OptionField a -> Bool +removeProgOptions = + ( \(optionName -> o) -> + not + ( "with-PROG" == o + || "PROG-option" `isPrefixOf` o + ) + ) From 9838aa277160827fc5293a7b1ab180a2e7da5f3b Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 2 Aug 2026 13:52:37 -0400 Subject: [PATCH 04/85] Colorize sections --- cabal-install/src/Distribution/Client/CmdBuild.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index d84cb53ea20..e8c93cf83e9 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -292,7 +292,7 @@ buildHelpText invokedName pname = <> replaceBuildAlias invokedName (commandUsage buildCommand pname) <> maybe "" (('\n' :) . ($ pname)) (commandDescription buildCommand) <> "\n" - <> "Flags for build:" + <> colorizeHeader "Flags for build:" <> GetOpt.usageInfo "" (commonHelpOptions ++ concatMap optionFieldToGetOpt buildUngroupedOptions) <> concatMap renderGroup buildOptionGroups <> maybe "" (('\n' :) . replaceBuildAlias invokedName . ($ pname)) (commandNotes buildCommand) @@ -304,7 +304,7 @@ buildHelpText invokedName pname = renderGroup :: (String, [BuildOptionField]) -> String renderGroup (title, options) | null options = "" - | otherwise = "\n" <> title <> ":" <> GetOpt.usageInfo "" (concatMap optionFieldToGetOpt options) + | otherwise = "\n" <> colorizeHeader (title <> ":") <> GetOpt.usageInfo "" (concatMap optionFieldToGetOpt options) buildOptionGroups :: [(String, [BuildOptionField])] buildOptionGroups = @@ -405,6 +405,9 @@ optDescrToGetOpt = \case replaceBuildAlias :: String -> String -> String replaceBuildAlias invokedName = T.unpack . T.replace (T.pack "v2-build") (T.pack invokedName) . T.pack +colorizeHeader :: String -> String +colorizeHeader text = "\ESC[32m" <> text <> "\ESC[0m" + parseBuildCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) parseBuildCommand invokedName cmdArgs = case O.execParserPure O.defaultPrefs (buildParserInfo invokedName) cmdArgs of From 6c3668753ee3540fa120427aca4b5cd0d52cd90c Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 2 Aug 2026 13:54:39 -0400 Subject: [PATCH 05/85] Colorize Usage: and Examples: --- cabal-install/src/Distribution/Client/CmdBuild.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index e8c93cf83e9..3aad0825ec7 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -289,13 +289,13 @@ buildHelpText :: String -> String -> String buildHelpText invokedName pname = commandSynopsis buildCommand <> "\n\n" - <> replaceBuildAlias invokedName (commandUsage buildCommand pname) + <> colorizeUsageHeader (replaceBuildAlias invokedName (commandUsage buildCommand pname)) <> maybe "" (('\n' :) . ($ pname)) (commandDescription buildCommand) <> "\n" <> colorizeHeader "Flags for build:" <> GetOpt.usageInfo "" (commonHelpOptions ++ concatMap optionFieldToGetOpt buildUngroupedOptions) <> concatMap renderGroup buildOptionGroups - <> maybe "" (('\n' :) . replaceBuildAlias invokedName . ($ pname)) (commandNotes buildCommand) + <> maybe "" (('\n' :) . colorizeExamplesHeader . replaceBuildAlias invokedName . ($ pname)) (commandNotes buildCommand) where commonHelpOptions :: [GetOpt.OptDescr ()] commonHelpOptions = @@ -408,6 +408,12 @@ replaceBuildAlias invokedName = T.unpack . T.replace (T.pack "v2-build") (T.pack colorizeHeader :: String -> String colorizeHeader text = "\ESC[32m" <> text <> "\ESC[0m" +colorizeUsageHeader :: String -> String +colorizeUsageHeader = T.unpack . T.replace (T.pack "Usage:") (T.pack $ colorizeHeader "Usage:") . T.pack + +colorizeExamplesHeader :: String -> String +colorizeExamplesHeader = T.unpack . T.replace (T.pack "Examples:") (T.pack $ colorizeHeader "Examples:") . T.pack + parseBuildCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) parseBuildCommand invokedName cmdArgs = case O.execParserPure O.defaultPrefs (buildParserInfo invokedName) cmdArgs of From e4167cb26ca13f1fa02153d6caa52e729e316907 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 2 Aug 2026 14:06:50 -0400 Subject: [PATCH 06/85] Common starting column for flag help text --- .../src/Distribution/Client/CmdBuild.hs | 59 ++++++++++++++++++- 1 file changed, 57 insertions(+), 2 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 3aad0825ec7..833a22bfee4 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -293,7 +293,8 @@ buildHelpText invokedName pname = <> maybe "" (('\n' :) . ($ pname)) (commandDescription buildCommand) <> "\n" <> colorizeHeader "Flags for build:" - <> GetOpt.usageInfo "" (commonHelpOptions ++ concatMap optionFieldToGetOpt buildUngroupedOptions) + <> "\n" + <> renderOptionRows maxFlagColumnWidth descColumn (commonHelpOptions ++ concatMap optionFieldToGetOpt buildUngroupedOptions) <> concatMap renderGroup buildOptionGroups <> maybe "" (('\n' :) . colorizeExamplesHeader . replaceBuildAlias invokedName . ($ pname)) (commandNotes buildCommand) where @@ -301,10 +302,32 @@ buildHelpText invokedName pname = commonHelpOptions = [GetOpt.Option ['h'] ["help"] (GetOpt.NoArg ()) "Show this help text"] + maxFlagColumnWidth :: Int + maxFlagColumnWidth = 56 + + descColumn :: Int + descColumn = + min maxFlagColumnWidth + ( maximum + ( 0 + : map + (length . fst . getOptToColumns) + ( commonHelpOptions + ++ concatMap optionFieldToGetOpt buildUngroupedOptions + ++ concatMap (concatMap optionFieldToGetOpt . snd) buildOptionGroups + ) + ) + ) + + 2 + renderGroup :: (String, [BuildOptionField]) -> String renderGroup (title, options) | null options = "" - | otherwise = "\n" <> colorizeHeader (title <> ":") <> GetOpt.usageInfo "" (concatMap optionFieldToGetOpt options) + | otherwise = + "\n" + <> colorizeHeader (title <> ":") + <> "\n" + <> renderOptionRows maxFlagColumnWidth descColumn (concatMap optionFieldToGetOpt options) buildOptionGroups :: [(String, [BuildOptionField])] buildOptionGroups = @@ -379,6 +402,38 @@ splitBy -> ([BuildOptionField], [BuildOptionField]) splitBy keepPred = partition (not . keepPred) +renderOptionRows :: Int -> Int -> [GetOpt.OptDescr ()] -> String +renderOptionRows maxFlagColumnWidth descColumn = concatMap renderOption + where + renderOption opt = + let (flagColumn, description) = getOptToColumns opt + padding = max 1 (descColumn - length flagColumn) + descriptionIndent = replicate (2 + descColumn) ' ' + in + if length flagColumn <= maxFlagColumnWidth + then " " <> flagColumn <> replicate padding ' ' <> description <> "\n" + else " " <> flagColumn <> "\n" <> descriptionIndent <> description <> "\n" + +getOptToColumns :: GetOpt.OptDescr () -> (String, String) +getOptToColumns (GetOpt.Option shortFlags longFlags argDescr description) = + (intercalate ", " (renderShortFlags ++ renderLongFlags), description) + where + renderShortFlags = map renderShortFlag shortFlags + + renderShortFlag shortFlag = + case argDescr of + GetOpt.NoArg _ -> "-" <> [shortFlag] + GetOpt.ReqArg _ metaVar -> "-" <> [shortFlag] <> " " <> metaVar + GetOpt.OptArg _ metaVar -> "-" <> [shortFlag] <> "[" <> metaVar <> "]" + + renderLongFlags = map renderLongFlag longFlags + + renderLongFlag longFlag = + case argDescr of + GetOpt.NoArg _ -> "--" <> longFlag + GetOpt.ReqArg _ metaVar -> "--" <> longFlag <> "=" <> metaVar + GetOpt.OptArg _ metaVar -> "--" <> longFlag <> "[=" <> metaVar <> "]" + optionFieldToGetOpt :: BuildOptionField -> [GetOpt.OptDescr ()] optionFieldToGetOpt (OptionField _ descrs) = concatMap optDescrToGetOpt descrs From 2ffe51a9c142df71d211f22741679be026e93a66 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 2 Aug 2026 14:09:08 -0400 Subject: [PATCH 07/85] Reduce the maxFlagColumnWidth --- cabal-install/src/Distribution/Client/CmdBuild.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 833a22bfee4..219ba4c7467 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -303,7 +303,7 @@ buildHelpText invokedName pname = [GetOpt.Option ['h'] ["help"] (GetOpt.NoArg ()) "Show this help text"] maxFlagColumnWidth :: Int - maxFlagColumnWidth = 56 + maxFlagColumnWidth = 50 descColumn :: Int descColumn = From 990fe71771a3a7ec674ca436704acad9811f04a3 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 2 Aug 2026 14:13:56 -0400 Subject: [PATCH 08/85] Don't let wrapping help wrap into flag columns --- .../src/Distribution/Client/CmdBuild.hs | 54 ++++++++++++++++--- 1 file changed, 46 insertions(+), 8 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 219ba4c7467..3ff853bcd54 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -294,7 +294,7 @@ buildHelpText invokedName pname = <> "\n" <> colorizeHeader "Flags for build:" <> "\n" - <> renderOptionRows maxFlagColumnWidth descColumn (commonHelpOptions ++ concatMap optionFieldToGetOpt buildUngroupedOptions) + <> renderOptionRows maxFlagColumnWidth descColumn helpOutputWidth (commonHelpOptions ++ concatMap optionFieldToGetOpt buildUngroupedOptions) <> concatMap renderGroup buildOptionGroups <> maybe "" (('\n' :) . colorizeExamplesHeader . replaceBuildAlias invokedName . ($ pname)) (commandNotes buildCommand) where @@ -305,6 +305,9 @@ buildHelpText invokedName pname = maxFlagColumnWidth :: Int maxFlagColumnWidth = 50 + helpOutputWidth :: Int + helpOutputWidth = 100 + descColumn :: Int descColumn = min maxFlagColumnWidth @@ -327,7 +330,7 @@ buildHelpText invokedName pname = "\n" <> colorizeHeader (title <> ":") <> "\n" - <> renderOptionRows maxFlagColumnWidth descColumn (concatMap optionFieldToGetOpt options) + <> renderOptionRows maxFlagColumnWidth descColumn helpOutputWidth (concatMap optionFieldToGetOpt options) buildOptionGroups :: [(String, [BuildOptionField])] buildOptionGroups = @@ -402,17 +405,52 @@ splitBy -> ([BuildOptionField], [BuildOptionField]) splitBy keepPred = partition (not . keepPred) -renderOptionRows :: Int -> Int -> [GetOpt.OptDescr ()] -> String -renderOptionRows maxFlagColumnWidth descColumn = concatMap renderOption +renderOptionRows :: Int -> Int -> Int -> [GetOpt.OptDescr ()] -> String +renderOptionRows maxFlagColumnWidth descColumn helpOutputWidth = concatMap renderOption where + descriptionIndent = replicate (2 + descColumn) ' ' + descriptionWidth = max 20 (helpOutputWidth - (2 + descColumn)) + renderOption opt = let (flagColumn, description) = getOptToColumns opt - padding = max 1 (descColumn - length flagColumn) - descriptionIndent = replicate (2 + descColumn) ' ' + wrappedDescription = wrapDescription descriptionWidth description in if length flagColumn <= maxFlagColumnWidth - then " " <> flagColumn <> replicate padding ' ' <> description <> "\n" - else " " <> flagColumn <> "\n" <> descriptionIndent <> description <> "\n" + then renderInline flagColumn wrappedDescription + else renderStacked flagColumn wrappedDescription + + renderInline flagColumn descriptionLines = + let padding = max 1 (descColumn - length flagColumn) + in case descriptionLines of + [] -> " " <> flagColumn <> "\n" + firstLineText : continuation -> + let firstLine = " " <> flagColumn <> replicate padding ' ' <> firstLineText <> "\n" + continuationLines = [descriptionIndent <> line <> "\n" | line <- continuation] + in firstLine <> concat continuationLines + + renderStacked flagColumn descriptionLines = + " " + <> flagColumn + <> "\n" + <> concat [descriptionIndent <> line <> "\n" | line <- descriptionLines] + +wrapDescription :: Int -> String -> [String] +wrapDescription width description = + case concatMap wrapParagraph (lines description) of + [] -> [""] + wrapped -> wrapped + where + wrapParagraph paragraph + | null ws = [""] + | otherwise = reverse (foldl' step [""] ws) + where + ws = words paragraph + + step (current : previous) word + | null current = word : previous + | length current + 1 + length word <= width = (current <> " " <> word) : previous + | otherwise = word : current : previous + step [] _ = [] getOptToColumns :: GetOpt.OptDescr () -> (String, String) getOptToColumns (GetOpt.Option shortFlags longFlags argDescr description) = From 03cc352670e87cd60f2922cfda77d19c07295f73 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 2 Aug 2026 14:15:35 -0400 Subject: [PATCH 09/85] Reduce flag columns to 30 --- cabal-install/src/Distribution/Client/CmdBuild.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 3ff853bcd54..938101bfdc4 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -303,7 +303,7 @@ buildHelpText invokedName pname = [GetOpt.Option ['h'] ["help"] (GetOpt.NoArg ()) "Show this help text"] maxFlagColumnWidth :: Int - maxFlagColumnWidth = 50 + maxFlagColumnWidth = 30 helpOutputWidth :: Int helpOutputWidth = 100 From a5227bd3ed93436ff8fb701feb1139aa71ca03ab Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 2 Aug 2026 14:19:19 -0400 Subject: [PATCH 10/85] Add bullet points for help text --- .../src/Distribution/Client/CmdBuild.hs | 23 +++++++++++++------ 1 file changed, 16 insertions(+), 7 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 938101bfdc4..4b9ae9ed4e3 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -408,8 +408,10 @@ splitBy keepPred = partition (not . keepPred) renderOptionRows :: Int -> Int -> Int -> [GetOpt.OptDescr ()] -> String renderOptionRows maxFlagColumnWidth descColumn helpOutputWidth = concatMap renderOption where + descriptionMarker = "• " + markerPadding = replicate (length descriptionMarker) ' ' descriptionIndent = replicate (2 + descColumn) ' ' - descriptionWidth = max 20 (helpOutputWidth - (2 + descColumn)) + descriptionWidth = max 20 (helpOutputWidth - (2 + descColumn) - length descriptionMarker) renderOption opt = let (flagColumn, description) = getOptToColumns opt @@ -424,15 +426,22 @@ renderOptionRows maxFlagColumnWidth descColumn helpOutputWidth = concatMap rende in case descriptionLines of [] -> " " <> flagColumn <> "\n" firstLineText : continuation -> - let firstLine = " " <> flagColumn <> replicate padding ' ' <> firstLineText <> "\n" - continuationLines = [descriptionIndent <> line <> "\n" | line <- continuation] + let firstLine = " " <> flagColumn <> replicate padding ' ' <> descriptionMarker <> firstLineText <> "\n" + continuationLines = [descriptionIndent <> markerPadding <> line <> "\n" | line <- continuation] in firstLine <> concat continuationLines renderStacked flagColumn descriptionLines = - " " - <> flagColumn - <> "\n" - <> concat [descriptionIndent <> line <> "\n" | line <- descriptionLines] + case descriptionLines of + [] -> " " <> flagColumn <> "\n" + firstLineText : continuation -> + " " + <> flagColumn + <> "\n" + <> descriptionIndent + <> descriptionMarker + <> firstLineText + <> "\n" + <> concat [descriptionIndent <> markerPadding <> line <> "\n" | line <- continuation] wrapDescription :: Int -> String -> [String] wrapDescription width description = From 98ff99f3f374c25e9d00ab93f6a580570f19a569 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Mon, 3 Aug 2026 15:03:49 -0400 Subject: [PATCH 11/85] Capitalise first char of help, warn if not already --- .../src/Distribution/Client/CmdBuild.hs | 78 +++++++++++++++---- 1 file changed, 62 insertions(+), 16 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 4b9ae9ed4e3..16af9026b3f 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -29,6 +29,7 @@ import Distribution.Client.TargetProblem ) import qualified Data.Map as Map +import Data.Char (isLower) import Data.Monoid (Endo (..), appEndo) import qualified Data.Text as T import qualified System.Console.GetOpt as GetOpt @@ -294,8 +295,9 @@ buildHelpText invokedName pname = <> "\n" <> colorizeHeader "Flags for build:" <> "\n" - <> renderOptionRows maxFlagColumnWidth descColumn helpOutputWidth (commonHelpOptions ++ concatMap optionFieldToGetOpt buildUngroupedOptions) - <> concatMap renderGroup buildOptionGroups + <> ungroupedRows + <> groupedRows + <> warningSection <> maybe "" (('\n' :) . colorizeExamplesHeader . replaceBuildAlias invokedName . ($ pname)) (commandNotes buildCommand) where commonHelpOptions :: [GetOpt.OptDescr ()] @@ -323,14 +325,36 @@ buildHelpText invokedName pname = ) + 2 - renderGroup :: (String, [BuildOptionField]) -> String + (ungroupedRows, ungroupedWarnings) = + renderOptionRows maxFlagColumnWidth descColumn helpOutputWidth (commonHelpOptions ++ concatMap optionFieldToGetOpt buildUngroupedOptions) + + renderedGroups = map renderGroup buildOptionGroups + + groupedRows = concatMap fst renderedGroups + + groupedWarnings = concatMap snd renderedGroups + + warningSection = + case ungroupedWarnings ++ groupedWarnings of + [] -> "" + warnings -> + "\n" + <> "Warnings:\n" + <> concat [" - " <> warning <> "\n" | warning <- warnings] + + renderGroup :: (String, [BuildOptionField]) -> (String, [String]) renderGroup (title, options) - | null options = "" + | null options = ("", []) | otherwise = - "\n" - <> colorizeHeader (title <> ":") - <> "\n" - <> renderOptionRows maxFlagColumnWidth descColumn helpOutputWidth (concatMap optionFieldToGetOpt options) + let (rows, warnings) = + renderOptionRows maxFlagColumnWidth descColumn helpOutputWidth (concatMap optionFieldToGetOpt options) + in + ( "\n" + <> colorizeHeader (title <> ":") + <> "\n" + <> rows + , warnings + ) buildOptionGroups :: [(String, [BuildOptionField])] buildOptionGroups = @@ -405,21 +429,32 @@ splitBy -> ([BuildOptionField], [BuildOptionField]) splitBy keepPred = partition (not . keepPred) -renderOptionRows :: Int -> Int -> Int -> [GetOpt.OptDescr ()] -> String -renderOptionRows maxFlagColumnWidth descColumn helpOutputWidth = concatMap renderOption +renderOptionRows :: Int -> Int -> Int -> [GetOpt.OptDescr ()] -> (String, [String]) +renderOptionRows maxFlagColumnWidth descColumn helpOutputWidth options = + let rendered = [renderOption (index == 0) opt | (index, opt) <- zip [0 :: Int ..] options] + in (concatMap fst rendered, concatMap snd rendered) where descriptionMarker = "• " markerPadding = replicate (length descriptionMarker) ' ' descriptionIndent = replicate (2 + descColumn) ' ' descriptionWidth = max 20 (helpOutputWidth - (2 + descColumn) - length descriptionMarker) - renderOption opt = + renderOption isFirstInGroup opt = let (flagColumn, description) = getOptToColumns opt - wrappedDescription = wrapDescription descriptionWidth description - in - if length flagColumn <= maxFlagColumnWidth - then renderInline flagColumn wrappedDescription - else renderStacked flagColumn wrappedDescription + (capitalizedDescription, wasAutoCapitalized) = capitalizeDescription description + wrappedDescription = wrapDescription descriptionWidth capitalizedDescription + isStacked = length flagColumn > maxFlagColumnWidth + spacer = if isStacked && not isFirstInGroup then "\n" else "" + warning = + if wasAutoCapitalized + then ["Auto-capitalized help text for " <> flagColumn] + else [] + renderedRow = + spacer + <> if isStacked + then renderStacked flagColumn wrappedDescription + else renderInline flagColumn wrappedDescription + in (renderedRow, warning) renderInline flagColumn descriptionLines = let padding = max 1 (descColumn - length flagColumn) @@ -461,6 +496,17 @@ wrapDescription width description = | otherwise = word : current : previous step [] _ = [] +capitalizeDescription :: String -> (String, Bool) +capitalizeDescription = go [] + where + go acc [] = (reverse acc, False) + go acc (ch : rest) + | isAlpha ch = + if isLower ch + then (reverse acc <> (toUpper ch : rest), True) + else (reverse acc <> (ch : rest), False) + | otherwise = go (ch : acc) rest + getOptToColumns :: GetOpt.OptDescr () -> (String, String) getOptToColumns (GetOpt.Option shortFlags longFlags argDescr description) = (intercalate ", " (renderShortFlags ++ renderLongFlags), description) From cb07505bcb56e057ff087a158e6149a455b008d1 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Mon, 3 Aug 2026 15:05:15 -0400 Subject: [PATCH 12/85] Warnings section in red --- cabal-install/src/Distribution/Client/CmdBuild.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 16af9026b3f..d4448974dbe 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -339,7 +339,8 @@ buildHelpText invokedName pname = [] -> "" warnings -> "\n" - <> "Warnings:\n" + <> colorizeWarningHeader "Warnings:" + <> "\n" <> concat [" - " <> warning <> "\n" | warning <- warnings] renderGroup :: (String, [BuildOptionField]) -> (String, [String]) @@ -556,6 +557,9 @@ replaceBuildAlias invokedName = T.unpack . T.replace (T.pack "v2-build") (T.pack colorizeHeader :: String -> String colorizeHeader text = "\ESC[32m" <> text <> "\ESC[0m" +colorizeWarningHeader :: String -> String +colorizeWarningHeader text = "\ESC[31m" <> text <> "\ESC[0m" + colorizeUsageHeader :: String -> String colorizeUsageHeader = T.unpack . T.replace (T.pack "Usage:") (T.pack $ colorizeHeader "Usage:") . T.pack From 6f9c2a334c9336e76a55c129cb43bcc563c61d61 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Mon, 3 Aug 2026 15:08:04 -0400 Subject: [PATCH 13/85] Also make red auto-capitalized first char --- .../src/Distribution/Client/CmdBuild.hs | 25 +++++++++++++++++-- 1 file changed, 23 insertions(+), 2 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index d4448974dbe..9492556d7e3 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -444,6 +444,10 @@ renderOptionRows maxFlagColumnWidth descColumn helpOutputWidth options = let (flagColumn, description) = getOptToColumns opt (capitalizedDescription, wasAutoCapitalized) = capitalizeDescription description wrappedDescription = wrapDescription descriptionWidth capitalizedDescription + displayDescription = + if wasAutoCapitalized + then colorizeFirstAlphaRed wrappedDescription + else wrappedDescription isStacked = length flagColumn > maxFlagColumnWidth spacer = if isStacked && not isFirstInGroup then "\n" else "" warning = @@ -453,8 +457,8 @@ renderOptionRows maxFlagColumnWidth descColumn helpOutputWidth options = renderedRow = spacer <> if isStacked - then renderStacked flagColumn wrappedDescription - else renderInline flagColumn wrappedDescription + then renderStacked flagColumn displayDescription + else renderInline flagColumn displayDescription in (renderedRow, warning) renderInline flagColumn descriptionLines = @@ -508,6 +512,23 @@ capitalizeDescription = go [] else (reverse acc <> (ch : rest), False) | otherwise = go (ch : acc) rest +colorizeFirstAlphaRed :: [String] -> [String] +colorizeFirstAlphaRed = go + where + go [] = [] + go (line : rest) = + case colorizeFirstAlphaInLine line of + Nothing -> line : go rest + Just colored -> colored : rest + + colorizeFirstAlphaInLine :: String -> Maybe String + colorizeFirstAlphaInLine = scan [] + where + scan _ [] = Nothing + scan acc (ch : cs) + | isAlpha ch = Just (reverse acc <> colorizeWarningHeader [ch] <> cs) + | otherwise = scan (ch : acc) cs + getOptToColumns :: GetOpt.OptDescr () -> (String, String) getOptToColumns (GetOpt.Option shortFlags longFlags argDescr description) = (intercalate ", " (renderShortFlags ++ renderLongFlags), description) From d3bc2b23db0f3175cc21f085c382722be112c311 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Mon, 3 Aug 2026 15:44:36 -0400 Subject: [PATCH 14/85] Add module CommandUIOptParse --- cabal-install/cabal-install.cabal | 1 + .../src/Distribution/Client/CmdBuild.hs | 280 +++--------------- .../Distribution/Client/CommandUIOptParse.hs | 225 ++++++++++++++ 3 files changed, 271 insertions(+), 235 deletions(-) create mode 100644 cabal-install/src/Distribution/Client/CommandUIOptParse.hs diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 33eb707a3e1..2190fbe696a 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -106,6 +106,7 @@ library Distribution.Client.CmdClean Distribution.Client.CmdConfigure Distribution.Client.CmdErrorMessages + Distribution.Client.CommandUIOptParse Distribution.Client.CmdExec Distribution.Client.CmdFreeze Distribution.Client.CmdHaddock diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 9492556d7e3..d05304c3e43 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE LambdaCase #-} - -- | cabal-install CLI command: build module Distribution.Client.CmdBuild ( -- * The @build@ CLI and action @@ -29,10 +27,10 @@ import Distribution.Client.TargetProblem ) import qualified Data.Map as Map -import Data.Char (isLower) import Data.Monoid (Endo (..), appEndo) import qualified Data.Text as T import qualified System.Console.GetOpt as GetOpt +import qualified Distribution.Client.CommandUIOptParse as CommandUIOpt import Distribution.Client.Errors import Distribution.Client.NixStyleOptions ( NixStyleFlags (..) @@ -71,8 +69,7 @@ import Distribution.Client.Setup import Distribution.Simple.Command ( CommandParse (..) , CommandUI (..) - , OptDescr (..) - , OptionField (..) + , OptionField , ShowOrParseArgs (ParseArgs, ShowArgs) , commandParseArgs , option @@ -87,8 +84,6 @@ import Distribution.Verbosity ( normal ) -import Distribution.ReadE (runReadE) - import qualified Options.Applicative as O buildCommand :: CommandUI (NixStyleFlags BuildFlags) @@ -316,17 +311,17 @@ buildHelpText invokedName pname = ( maximum ( 0 : map - (length . fst . getOptToColumns) + (length . fst . CommandUIOpt.getOptToColumns) ( commonHelpOptions - ++ concatMap optionFieldToGetOpt buildUngroupedOptions - ++ concatMap (concatMap optionFieldToGetOpt . snd) buildOptionGroups + ++ concatMap CommandUIOpt.optionFieldToGetOpt buildUngroupedOptions + ++ concatMap (concatMap CommandUIOpt.optionFieldToGetOpt . snd) buildOptionGroups ) ) ) + 2 (ungroupedRows, ungroupedWarnings) = - renderOptionRows maxFlagColumnWidth descColumn helpOutputWidth (commonHelpOptions ++ concatMap optionFieldToGetOpt buildUngroupedOptions) + CommandUIOpt.renderOptionRows colorizeWarningHeader maxFlagColumnWidth descColumn helpOutputWidth (commonHelpOptions ++ concatMap CommandUIOpt.optionFieldToGetOpt buildUngroupedOptions) renderedGroups = map renderGroup buildOptionGroups @@ -348,7 +343,7 @@ buildHelpText invokedName pname = | null options = ("", []) | otherwise = let (rows, warnings) = - renderOptionRows maxFlagColumnWidth descColumn helpOutputWidth (concatMap optionFieldToGetOpt options) + CommandUIOpt.renderOptionRows colorizeWarningHeader maxFlagColumnWidth descColumn helpOutputWidth (concatMap CommandUIOpt.optionFieldToGetOpt options) in ( "\n" <> colorizeHeader (title <> ":") @@ -381,196 +376,50 @@ buildOptionGroups = where opts0 = commandOptions buildCommand ShowArgs - (unsupported, opts1) = splitBy removeUnsupportedOptions opts0 - (install, opts2) = splitBy removeInstallOptions opts1 - (irrelevant, opts3) = splitBy removeIrrelevantOptions opts2 - (haddock, opts4) = splitBy removeHaddockOptions opts3 - (test, opts5) = splitBy removeTestOptions opts4 - (bench, opts6) = splitBy removeBenchOptions opts5 - (profiling, opts7) = splitBy removeProfilingOptions opts6 - (solving, opts8) = splitBy removeSolvingOptions opts7 - (exe, opts9) = splitBy removeExeOptions opts8 - (lib, opts10) = splitBy removeLibOptions opts9 - (coverage, opts11) = splitBy removeCoverageOptions opts10 - (output, opts12) = splitBy removeOutputOptions opts11 - (configure, opts13) = splitBy removeConfigureOptions opts12 - (phase, opts14) = splitBy removePhaseOptions opts13 - (compiler, opts15) = splitBy removeCompilerOptions opts14 - (logging, opts16) = splitBy removeLoggingOptions opts15 - (includePaths, opts17) = splitBy removeIncludeOptions opts16 - (prog, _opts18) = splitBy removeProgOptions opts17 + (unsupported, opts1) = CommandUIOpt.splitBy removeUnsupportedOptions opts0 + (install, opts2) = CommandUIOpt.splitBy removeInstallOptions opts1 + (irrelevant, opts3) = CommandUIOpt.splitBy removeIrrelevantOptions opts2 + (haddock, opts4) = CommandUIOpt.splitBy removeHaddockOptions opts3 + (test, opts5) = CommandUIOpt.splitBy removeTestOptions opts4 + (bench, opts6) = CommandUIOpt.splitBy removeBenchOptions opts5 + (profiling, opts7) = CommandUIOpt.splitBy removeProfilingOptions opts6 + (solving, opts8) = CommandUIOpt.splitBy removeSolvingOptions opts7 + (exe, opts9) = CommandUIOpt.splitBy removeExeOptions opts8 + (lib, opts10) = CommandUIOpt.splitBy removeLibOptions opts9 + (coverage, opts11) = CommandUIOpt.splitBy removeCoverageOptions opts10 + (output, opts12) = CommandUIOpt.splitBy removeOutputOptions opts11 + (configure, opts13) = CommandUIOpt.splitBy removeConfigureOptions opts12 + (phase, opts14) = CommandUIOpt.splitBy removePhaseOptions opts13 + (compiler, opts15) = CommandUIOpt.splitBy removeCompilerOptions opts14 + (logging, opts16) = CommandUIOpt.splitBy removeLoggingOptions opts15 + (includePaths, opts17) = CommandUIOpt.splitBy removeIncludeOptions opts16 + (prog, _opts18) = CommandUIOpt.splitBy removeProgOptions opts17 buildUngroupedOptions :: [BuildOptionField] buildUngroupedOptions = opts18 where opts0 = commandOptions buildCommand ShowArgs - (_, opts1) = splitBy removeUnsupportedOptions opts0 - (_, opts2) = splitBy removeInstallOptions opts1 - (_, opts3) = splitBy removeIrrelevantOptions opts2 - (_, opts4) = splitBy removeHaddockOptions opts3 - (_, opts5) = splitBy removeTestOptions opts4 - (_, opts6) = splitBy removeBenchOptions opts5 - (_, opts7) = splitBy removeProfilingOptions opts6 - (_, opts8) = splitBy removeSolvingOptions opts7 - (_, opts9) = splitBy removeExeOptions opts8 - (_, opts10) = splitBy removeLibOptions opts9 - (_, opts11) = splitBy removeCoverageOptions opts10 - (_, opts12) = splitBy removeOutputOptions opts11 - (_, opts13) = splitBy removeConfigureOptions opts12 - (_, opts14) = splitBy removePhaseOptions opts13 - (_, opts15) = splitBy removeCompilerOptions opts14 - (_, opts16) = splitBy removeLoggingOptions opts15 - (_, opts17) = splitBy removeIncludeOptions opts16 - (_, opts18) = splitBy removeProgOptions opts17 - -splitBy - :: (BuildOptionField -> Bool) - -> [BuildOptionField] - -> ([BuildOptionField], [BuildOptionField]) -splitBy keepPred = partition (not . keepPred) - -renderOptionRows :: Int -> Int -> Int -> [GetOpt.OptDescr ()] -> (String, [String]) -renderOptionRows maxFlagColumnWidth descColumn helpOutputWidth options = - let rendered = [renderOption (index == 0) opt | (index, opt) <- zip [0 :: Int ..] options] - in (concatMap fst rendered, concatMap snd rendered) - where - descriptionMarker = "• " - markerPadding = replicate (length descriptionMarker) ' ' - descriptionIndent = replicate (2 + descColumn) ' ' - descriptionWidth = max 20 (helpOutputWidth - (2 + descColumn) - length descriptionMarker) - - renderOption isFirstInGroup opt = - let (flagColumn, description) = getOptToColumns opt - (capitalizedDescription, wasAutoCapitalized) = capitalizeDescription description - wrappedDescription = wrapDescription descriptionWidth capitalizedDescription - displayDescription = - if wasAutoCapitalized - then colorizeFirstAlphaRed wrappedDescription - else wrappedDescription - isStacked = length flagColumn > maxFlagColumnWidth - spacer = if isStacked && not isFirstInGroup then "\n" else "" - warning = - if wasAutoCapitalized - then ["Auto-capitalized help text for " <> flagColumn] - else [] - renderedRow = - spacer - <> if isStacked - then renderStacked flagColumn displayDescription - else renderInline flagColumn displayDescription - in (renderedRow, warning) - - renderInline flagColumn descriptionLines = - let padding = max 1 (descColumn - length flagColumn) - in case descriptionLines of - [] -> " " <> flagColumn <> "\n" - firstLineText : continuation -> - let firstLine = " " <> flagColumn <> replicate padding ' ' <> descriptionMarker <> firstLineText <> "\n" - continuationLines = [descriptionIndent <> markerPadding <> line <> "\n" | line <- continuation] - in firstLine <> concat continuationLines - - renderStacked flagColumn descriptionLines = - case descriptionLines of - [] -> " " <> flagColumn <> "\n" - firstLineText : continuation -> - " " - <> flagColumn - <> "\n" - <> descriptionIndent - <> descriptionMarker - <> firstLineText - <> "\n" - <> concat [descriptionIndent <> markerPadding <> line <> "\n" | line <- continuation] + (_, opts1) = CommandUIOpt.splitBy removeUnsupportedOptions opts0 + (_, opts2) = CommandUIOpt.splitBy removeInstallOptions opts1 + (_, opts3) = CommandUIOpt.splitBy removeIrrelevantOptions opts2 + (_, opts4) = CommandUIOpt.splitBy removeHaddockOptions opts3 + (_, opts5) = CommandUIOpt.splitBy removeTestOptions opts4 + (_, opts6) = CommandUIOpt.splitBy removeBenchOptions opts5 + (_, opts7) = CommandUIOpt.splitBy removeProfilingOptions opts6 + (_, opts8) = CommandUIOpt.splitBy removeSolvingOptions opts7 + (_, opts9) = CommandUIOpt.splitBy removeExeOptions opts8 + (_, opts10) = CommandUIOpt.splitBy removeLibOptions opts9 + (_, opts11) = CommandUIOpt.splitBy removeCoverageOptions opts10 + (_, opts12) = CommandUIOpt.splitBy removeOutputOptions opts11 + (_, opts13) = CommandUIOpt.splitBy removeConfigureOptions opts12 + (_, opts14) = CommandUIOpt.splitBy removePhaseOptions opts13 + (_, opts15) = CommandUIOpt.splitBy removeCompilerOptions opts14 + (_, opts16) = CommandUIOpt.splitBy removeLoggingOptions opts15 + (_, opts17) = CommandUIOpt.splitBy removeIncludeOptions opts16 + (_, opts18) = CommandUIOpt.splitBy removeProgOptions opts17 + -wrapDescription :: Int -> String -> [String] -wrapDescription width description = - case concatMap wrapParagraph (lines description) of - [] -> [""] - wrapped -> wrapped - where - wrapParagraph paragraph - | null ws = [""] - | otherwise = reverse (foldl' step [""] ws) - where - ws = words paragraph - - step (current : previous) word - | null current = word : previous - | length current + 1 + length word <= width = (current <> " " <> word) : previous - | otherwise = word : current : previous - step [] _ = [] - -capitalizeDescription :: String -> (String, Bool) -capitalizeDescription = go [] - where - go acc [] = (reverse acc, False) - go acc (ch : rest) - | isAlpha ch = - if isLower ch - then (reverse acc <> (toUpper ch : rest), True) - else (reverse acc <> (ch : rest), False) - | otherwise = go (ch : acc) rest - -colorizeFirstAlphaRed :: [String] -> [String] -colorizeFirstAlphaRed = go - where - go [] = [] - go (line : rest) = - case colorizeFirstAlphaInLine line of - Nothing -> line : go rest - Just colored -> colored : rest - - colorizeFirstAlphaInLine :: String -> Maybe String - colorizeFirstAlphaInLine = scan [] - where - scan _ [] = Nothing - scan acc (ch : cs) - | isAlpha ch = Just (reverse acc <> colorizeWarningHeader [ch] <> cs) - | otherwise = scan (ch : acc) cs - -getOptToColumns :: GetOpt.OptDescr () -> (String, String) -getOptToColumns (GetOpt.Option shortFlags longFlags argDescr description) = - (intercalate ", " (renderShortFlags ++ renderLongFlags), description) - where - renderShortFlags = map renderShortFlag shortFlags - - renderShortFlag shortFlag = - case argDescr of - GetOpt.NoArg _ -> "-" <> [shortFlag] - GetOpt.ReqArg _ metaVar -> "-" <> [shortFlag] <> " " <> metaVar - GetOpt.OptArg _ metaVar -> "-" <> [shortFlag] <> "[" <> metaVar <> "]" - - renderLongFlags = map renderLongFlag longFlags - - renderLongFlag longFlag = - case argDescr of - GetOpt.NoArg _ -> "--" <> longFlag - GetOpt.ReqArg _ metaVar -> "--" <> longFlag <> "=" <> metaVar - GetOpt.OptArg _ metaVar -> "--" <> longFlag <> "[=" <> metaVar <> "]" - -optionFieldToGetOpt :: BuildOptionField -> [GetOpt.OptDescr ()] -optionFieldToGetOpt (OptionField _ descrs) = concatMap optDescrToGetOpt descrs - -optDescrToGetOpt :: OptDescr (NixStyleFlags BuildFlags) -> [GetOpt.OptDescr ()] -optDescrToGetOpt = \case - ReqArg desc (shortFlags, longFlags) placeHolder _reader _showFlag -> - [GetOpt.Option shortFlags longFlags (GetOpt.ReqArg (const ()) placeHolder) desc] - OptArg desc (shortFlags, longFlags) placeHolder _reader (_defaultValue, _defaultSetter) _showFlag -> - [GetOpt.Option shortFlags longFlags (GetOpt.OptArg (const ()) placeHolder) desc] - ChoiceOpt choices -> - [ GetOpt.Option shortFlags longFlags (GetOpt.NoArg ()) desc - | (desc, (shortFlags, longFlags), _setFn, _getFn) <- choices - ] - BoolOpt desc (shortTrue, longTrue) (shortFalse, longFalse) _setFn _getFn - | null shortFalse && null longFalse -> - [GetOpt.Option shortTrue longTrue (GetOpt.NoArg ()) desc] - | null shortTrue && null longTrue -> - [GetOpt.Option shortFalse longFalse (GetOpt.NoArg ()) desc] - | otherwise -> - [ GetOpt.Option shortTrue longTrue (GetOpt.NoArg ()) ("Enable " <> desc) - , GetOpt.Option shortFalse longFalse (GetOpt.NoArg ()) ("Disable " <> desc) - ] replaceBuildAlias :: String -> String -> String replaceBuildAlias invokedName = T.unpack . T.replace (T.pack "v2-build") (T.pack invokedName) . T.pack @@ -677,43 +526,4 @@ buildItemParser = buildOptionParsers :: [O.Parser BuildItem] buildOptionParsers = - concatMap optionFieldParsers (commandOptions buildCommand ParseArgs) - -optionFieldParsers :: OptionField (NixStyleFlags BuildFlags) -> [O.Parser BuildItem] -optionFieldParsers (OptionField _ descrs) = concatMap optDescrParsers descrs - -optDescrParsers :: OptDescr (NixStyleFlags BuildFlags) -> [O.Parser BuildItem] -optDescrParsers = \case - ReqArg desc optFlags placeHolder reader _show -> - [ BuildItemFlag . Endo - <$> O.option - (O.eitherReader (runReadE reader)) - (optionMods optFlags <> O.metavar placeHolder <> O.help desc) - ] - OptArg desc optFlags placeHolder reader (_defaultText, defaultFn) _show -> - [ BuildItemFlag . Endo - <$> ( O.option - (O.eitherReader (runReadE reader)) - (optionMods optFlags <> O.metavar placeHolder <> O.help desc) - <|> O.flag' defaultFn (flagMods optFlags <> O.internal) - ) - ] - ChoiceOpt choices -> - [ BuildItemFlag (Endo setFn) - <$ O.flag' () (flagMods optFlags <> O.help desc) - | (desc, optFlags, setFn, _get) <- choices - ] - BoolOpt desc trueFlags falseFlags setFn _get -> - [ BuildItemFlag (Endo (setFn True)) - <$ O.flag' () (flagMods trueFlags <> O.help desc) - , BuildItemFlag (Endo (setFn False)) - <$ O.flag' () (flagMods falseFlags <> O.help desc) - ] - -optionMods :: (String, [String]) -> O.Mod O.OptionFields a -optionMods (shortFlags, longFlags) = - mconcat (map O.short shortFlags) <> mconcat (map O.long longFlags) - -flagMods :: (String, [String]) -> O.Mod O.FlagFields a -flagMods (shortFlags, longFlags) = - mconcat (map O.short shortFlags) <> mconcat (map O.long longFlags) + map (BuildItemFlag <$>) (CommandUIOpt.optionFieldFlagParsers (commandOptions buildCommand ParseArgs)) diff --git a/cabal-install/src/Distribution/Client/CommandUIOptParse.hs b/cabal-install/src/Distribution/Client/CommandUIOptParse.hs new file mode 100644 index 00000000000..24f61a02759 --- /dev/null +++ b/cabal-install/src/Distribution/Client/CommandUIOptParse.hs @@ -0,0 +1,225 @@ +{-# LANGUAGE LambdaCase #-} + +module Distribution.Client.CommandUIOptParse + ( -- * Converting CommandUI options to optparse-applicative parsers + optionFieldFlagParsers + , optionFieldParser + , optDescrParser + , optionMods + , flagMods + + -- * Converting CommandUI options to GetOpt descriptions + , optionFieldToGetOpt + , optDescrToGetOpt + + -- * Help text layout helpers + , renderOptionRows + , getOptToColumns + , wrapDescription + , capitalizeDescription + + -- * Utility helpers + , splitBy + ) where + +import Distribution.Client.Compat.Prelude +import Prelude () + +import Data.Char (isLower) +import Data.Monoid (Endo (..)) +import qualified System.Console.GetOpt as GetOpt + +import Distribution.ReadE (runReadE) +import Distribution.Simple.Command + ( OptDescr (..) + , OptionField (..) + ) + +import qualified Options.Applicative as O + +optionFieldFlagParsers :: [OptionField flags] -> [O.Parser (Endo flags)] +optionFieldFlagParsers = concatMap optionFieldParser + +optionFieldParser :: OptionField flags -> [O.Parser (Endo flags)] +optionFieldParser (OptionField _ descrs) = concatMap optDescrParser descrs + +optDescrParser :: OptDescr flags -> [O.Parser (Endo flags)] +optDescrParser = \case + ReqArg desc optFlags placeHolder reader _show -> + [ Endo + <$> O.option + (O.eitherReader (runReadE reader)) + (optionMods optFlags <> O.metavar placeHolder <> O.help desc) + ] + OptArg desc optFlags placeHolder reader (_defaultText, defaultFn) _show -> + [ Endo + <$> ( O.option + (O.eitherReader (runReadE reader)) + (optionMods optFlags <> O.metavar placeHolder <> O.help desc) + <|> O.flag' defaultFn (flagMods optFlags <> O.internal) + ) + ] + ChoiceOpt choices -> + [ Endo setFn + <$ O.flag' () (flagMods optFlags <> O.help desc) + | (desc, optFlags, setFn, _get) <- choices + ] + BoolOpt desc trueFlags falseFlags setFn _get -> + [ Endo (setFn True) + <$ O.flag' () (flagMods trueFlags <> O.help desc) + , Endo (setFn False) + <$ O.flag' () (flagMods falseFlags <> O.help desc) + ] + +optionMods :: (String, [String]) -> O.Mod O.OptionFields a +optionMods (shortFlags, longFlags) = + mconcat (map O.short shortFlags) <> mconcat (map O.long longFlags) + +flagMods :: (String, [String]) -> O.Mod O.FlagFields a +flagMods (shortFlags, longFlags) = + mconcat (map O.short shortFlags) <> mconcat (map O.long longFlags) + +optionFieldToGetOpt :: OptionField flags -> [GetOpt.OptDescr ()] +optionFieldToGetOpt (OptionField _ descrs) = concatMap optDescrToGetOpt descrs + +optDescrToGetOpt :: OptDescr flags -> [GetOpt.OptDescr ()] +optDescrToGetOpt = \case + ReqArg desc (shortFlags, longFlags) placeHolder _reader _showFlag -> + [GetOpt.Option shortFlags longFlags (GetOpt.ReqArg (const ()) placeHolder) desc] + OptArg desc (shortFlags, longFlags) placeHolder _reader (_defaultValue, _defaultSetter) _showFlag -> + [GetOpt.Option shortFlags longFlags (GetOpt.OptArg (const ()) placeHolder) desc] + ChoiceOpt choices -> + [ GetOpt.Option shortFlags longFlags (GetOpt.NoArg ()) desc + | (desc, (shortFlags, longFlags), _setFn, _getFn) <- choices + ] + BoolOpt desc (shortTrue, longTrue) (shortFalse, longFalse) _setFn _getFn + | null shortFalse && null longFalse -> + [GetOpt.Option shortTrue longTrue (GetOpt.NoArg ()) desc] + | null shortTrue && null longTrue -> + [GetOpt.Option shortFalse longFalse (GetOpt.NoArg ()) desc] + | otherwise -> + [ GetOpt.Option shortTrue longTrue (GetOpt.NoArg ()) ("Enable " <> desc) + , GetOpt.Option shortFalse longFalse (GetOpt.NoArg ()) ("Disable " <> desc) + ] + +renderOptionRows :: (String -> String) -> Int -> Int -> Int -> [GetOpt.OptDescr ()] -> (String, [String]) +renderOptionRows colorizeWarning maxFlagColumnWidth descColumn helpOutputWidth options = + let rendered = [renderOption (index == 0) opt | (index, opt) <- zip [0 :: Int ..] options] + in (concatMap fst rendered, concatMap snd rendered) + where + descriptionMarker = "• " + markerPadding = replicate (length descriptionMarker) ' ' + descriptionIndent = replicate (2 + descColumn) ' ' + descriptionWidth = max 20 (helpOutputWidth - (2 + descColumn) - length descriptionMarker) + + renderOption isFirstInGroup opt = + let (flagColumn, description) = getOptToColumns opt + (capitalizedDescription, wasAutoCapitalized) = capitalizeDescription description + wrappedDescription = wrapDescription descriptionWidth capitalizedDescription + displayDescription = + if wasAutoCapitalized + then colorizeFirstAlpha wrappedDescription + else wrappedDescription + isStacked = length flagColumn > maxFlagColumnWidth + spacer = if isStacked && not isFirstInGroup then "\n" else "" + warning = + if wasAutoCapitalized + then ["Auto-capitalized help text for " <> flagColumn] + else [] + renderedRow = + spacer + <> if isStacked + then renderStacked flagColumn displayDescription + else renderInline flagColumn displayDescription + in (renderedRow, warning) + + colorizeFirstAlpha :: [String] -> [String] + colorizeFirstAlpha = go + where + go [] = [] + go (line : rest) = + case colorizeFirstAlphaInLine line of + Nothing -> line : go rest + Just colored -> colored : rest + + colorizeFirstAlphaInLine :: String -> Maybe String + colorizeFirstAlphaInLine = scan [] + where + scan _ [] = Nothing + scan acc (ch : cs) + | isAlpha ch = Just (reverse acc <> colorizeWarning [ch] <> cs) + | otherwise = scan (ch : acc) cs + + renderInline flagColumn descriptionLines = + let padding = max 1 (descColumn - length flagColumn) + in case descriptionLines of + [] -> " " <> flagColumn <> "\n" + firstLineText : continuation -> + let firstLine = " " <> flagColumn <> replicate padding ' ' <> descriptionMarker <> firstLineText <> "\n" + continuationLines = [descriptionIndent <> markerPadding <> line <> "\n" | line <- continuation] + in firstLine <> concat continuationLines + + renderStacked flagColumn descriptionLines = + case descriptionLines of + [] -> " " <> flagColumn <> "\n" + firstLineText : continuation -> + " " + <> flagColumn + <> "\n" + <> descriptionIndent + <> descriptionMarker + <> firstLineText + <> "\n" + <> concat [descriptionIndent <> markerPadding <> line <> "\n" | line <- continuation] + +wrapDescription :: Int -> String -> [String] +wrapDescription width description = + case concatMap wrapParagraph (lines description) of + [] -> [""] + wrapped -> wrapped + where + wrapParagraph paragraph + | null ws = [""] + | otherwise = reverse (foldl' step [""] ws) + where + ws = words paragraph + + step (current : previous) word + | null current = word : previous + | length current + 1 + length word <= width = (current <> " " <> word) : previous + | otherwise = word : current : previous + step [] _ = [] + +capitalizeDescription :: String -> (String, Bool) +capitalizeDescription = go [] + where + go acc [] = (reverse acc, False) + go acc (ch : rest) + | isAlpha ch = + if isLower ch + then (reverse acc <> (toUpper ch : rest), True) + else (reverse acc <> (ch : rest), False) + | otherwise = go (ch : acc) rest + +getOptToColumns :: GetOpt.OptDescr () -> (String, String) +getOptToColumns (GetOpt.Option shortFlags longFlags argDescr description) = + (intercalate ", " (renderShortFlags ++ renderLongFlags), description) + where + renderShortFlags = map renderShortFlag shortFlags + + renderShortFlag shortFlag = + case argDescr of + GetOpt.NoArg _ -> "-" <> [shortFlag] + GetOpt.ReqArg _ metaVar -> "-" <> [shortFlag] <> " " <> metaVar + GetOpt.OptArg _ metaVar -> "-" <> [shortFlag] <> "[" <> metaVar <> "]" + + renderLongFlags = map renderLongFlag longFlags + + renderLongFlag longFlag = + case argDescr of + GetOpt.NoArg _ -> "--" <> longFlag + GetOpt.ReqArg _ metaVar -> "--" <> longFlag <> "=" <> metaVar + GetOpt.OptArg _ metaVar -> "--" <> longFlag <> "[=" <> metaVar <> "]" + +splitBy :: (a -> Bool) -> [a] -> ([a], [a]) +splitBy keepPred = partition (not . keepPred) From e8de2047bd3ea3c108ce35148dc591fb46ae78a1 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 5 Aug 2026 08:37:31 -0400 Subject: [PATCH 15/85] Add doctest for buildCommandNames --- cabal-install/src/Distribution/Client/CmdBuild.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index d05304c3e43..682b0937ef3 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -267,6 +267,10 @@ reportCannotPruneDependencies :: Verbosity -> CannotPruneDependencies -> IO a reportCannotPruneDependencies verbosity = dieWithException verbosity . ReportCannotPruneDependencies . renderCannotPruneDependencies +-- | The command name and aliases for the @build@ command. +-- +-- >>> buildCommandNames +-- ["build","new-build","v2-build"] buildCommandNames :: [String] buildCommandNames = ["build", "new-build", commandName buildCommand] From d02100b341b5012d46599aeed16629c3d02d6723 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 5 Aug 2026 08:47:32 -0400 Subject: [PATCH 16/85] Follow hlint suggestion: redundant bracket --- cabal-install/src/Distribution/Client/CmdBuild.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 682b0937ef3..832e97a1c67 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -462,7 +462,7 @@ buildParserInfo invokedName = O.info (parsedBuildCommandParser O.<**> O.helper) ( O.fullDesc - <> O.progDesc (buildHelpDescription) + <> O.progDesc buildHelpDescription <> O.header ("cabal " ++ invokedName) <> O.footer (buildExamplesSection invokedName) ) From 81d6fbad7a6bed964a3c272c06eed5572295fbad Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 5 Aug 2026 08:49:37 -0400 Subject: [PATCH 17/85] Follow hlint suggestions --- .../Distribution/Client/NixStyleOptions.hs | 269 ++++++++---------- 1 file changed, 121 insertions(+), 148 deletions(-) diff --git a/cabal-install/src/Distribution/Client/NixStyleOptions.hs b/cabal-install/src/Distribution/Client/NixStyleOptions.hs index dac12b8c71e..73143a4ea8d 100644 --- a/cabal-install/src/Distribution/Client/NixStyleOptions.hs +++ b/cabal-install/src/Distribution/Client/NixStyleOptions.hs @@ -187,185 +187,158 @@ cfgVerbosity v flags = fromFlagOrDefault v (setupVerbosity . configCommonFlags $ configFlags flags) removeUnsupportedOptions :: OptionField a -> Bool -removeUnsupportedOptions = - (\(optionName -> o) -> not ("root-cmd" == o || "allow-boot-library-installs" == o)) +removeUnsupportedOptions (optionName -> o) = not ("root-cmd" == o || "allow-boot-library-installs" == o) removeInstallOptions :: OptionField a -> Bool -removeInstallOptions = - ( \(optionName -> o) -> - not - ( "dir" `isSuffixOf` o - || "reinstall" `isInfixOf` o - || "run-tests" == o - || "root-cmd" == o - || "allow-boot-library-installs" == o - || "program-prefix" == o - || "program-suffix" == o - || "ipid" == o - || "cid" == o - || "user" == o - || "global" == o - || "prefix" == o - ) - ) +removeInstallOptions (optionName -> o) = + not + ( "dir" `isSuffixOf` o + || "reinstall" `isInfixOf` o + || "run-tests" == o + || "root-cmd" == o + || "allow-boot-library-installs" == o + || "program-prefix" == o + || "program-suffix" == o + || "ipid" == o + || "cid" == o + || "user" == o + || "global" == o + || "prefix" == o + ) removeIrrelevantOptions :: OptionField a -> Bool -removeIrrelevantOptions = (\(optionName -> o) -> not ("per-component" `isSuffixOf` o)) +removeIrrelevantOptions (optionName -> o) = not ("per-component" `isSuffixOf` o) removeHaddockOptions :: OptionField a -> Bool -removeHaddockOptions = - ( \(optionName -> o) -> - not - ( "haddock" `isPrefixOf` o - || "documentation" `isSuffixOf` o - || "doc-index-file" == o - ) - ) +removeHaddockOptions (optionName -> o) = + not + ( "haddock" `isPrefixOf` o + || "documentation" `isSuffixOf` o + || "doc-index-file" == o + ) removeTestOptions :: OptionField a -> Bool -removeTestOptions = (\(optionName -> o) -> not ("test" `isPrefixOf` o)) +removeTestOptions (optionName -> o) = not ("test" `isPrefixOf` o) removeBenchOptions :: OptionField a -> Bool -removeBenchOptions = (\(optionName -> o) -> not ("bench" `isPrefixOf` o)) +removeBenchOptions (optionName -> o) = not ("bench" `isPrefixOf` o) removeProfilingOptions :: OptionField a -> Bool -removeProfilingOptions = (\(optionName -> o) -> not ("profiling" `isInfixOf` o)) +removeProfilingOptions (optionName -> o) = not ("profiling" `isInfixOf` o) removeSolvingOptions :: OptionField a -> Bool -removeSolvingOptions = - ( \(optionName -> o) -> - not - ( "max-backjumps" == o - || "conflicts" `isInfixOf` o - || "goals" `isInfixOf` o - || "index-state" == o - || "upgrade-dependencies" == o - || "reject-unconstrained-dependencies" == o - || "prefer-oldest" == o - || "allow-older" == o - || "allow-newer" == o - || "preference" == o - || "shadow-installed-packages" == o - || "ignore-build-tools" == o - || "solver" == o - || "only-dependencies" == o - || "dependencies-only" == o - || "minimize-conflict-set" == o - || "allow-depending-on-private-libs" == o - ) - ) +removeSolvingOptions (optionName -> o) = + not + ( "max-backjumps" == o + || "conflicts" `isInfixOf` o + || "goals" `isInfixOf` o + || "index-state" == o + || "upgrade-dependencies" == o + || "reject-unconstrained-dependencies" == o + || "prefer-oldest" == o + || "allow-older" == o + || "allow-newer" == o + || "preference" == o + || "shadow-installed-packages" == o + || "ignore-build-tools" == o + || "solver" == o + || "only-dependencies" == o + || "dependencies-only" == o + || "minimize-conflict-set" == o + || "allow-depending-on-private-libs" == o + ) removeExeOptions :: OptionField a -> Bool -removeExeOptions = - ( \(optionName -> o) -> - not - ( "executable" `isInfixOf` o - || "split" `isInfixOf` o - || "stripping" `isInfixOf` o - ) - ) +removeExeOptions (optionName -> o) = + not + ( "executable" `isInfixOf` o + || "split" `isInfixOf` o + || "stripping" `isInfixOf` o + ) removeLibOptions :: OptionField a -> Bool -removeLibOptions = - ( \(optionName -> o) -> - not - ( "vanilla" `isSuffixOf` o - || "shared" `isSuffixOf` o - || "static" `isSuffixOf` o - || "bytecode" `isSuffixOf` o - || "ghci" `isSuffixOf` o - ) - ) +removeLibOptions (optionName -> o) = + not + ( "vanilla" `isSuffixOf` o + || "shared" `isSuffixOf` o + || "static" `isSuffixOf` o + || "bytecode" `isSuffixOf` o + || "ghci" `isSuffixOf` o + ) removeCoverageOptions :: OptionField a -> Bool -removeCoverageOptions = - ( \(optionName -> o) -> - not - ( "coverage" `isSuffixOf` o - || "coverage" `isPrefixOf` o - ) - ) +removeCoverageOptions (optionName -> o) = + not + ( "coverage" `isSuffixOf` o + || "coverage" `isPrefixOf` o + ) removeOutputOptions :: OptionField a -> Bool -removeOutputOptions = - ( \(optionName -> o) -> - not - ( "build-info" `isSuffixOf` o - || "debug-info" `isSuffixOf` o - || "deterministic" `isSuffixOf` o - || "relocatable" `isSuffixOf` o - || "write-ghc-environment-files" == o - ) - ) +removeOutputOptions (optionName -> o) = + not + ( "build-info" `isSuffixOf` o + || "debug-info" `isSuffixOf` o + || "deterministic" `isSuffixOf` o + || "relocatable" `isSuffixOf` o + || "write-ghc-environment-files" == o + ) removeConfigureOptions :: OptionField a -> Bool -removeConfigureOptions = - ( \(optionName -> o) -> - not - ( "append" `isSuffixOf` o - || "backup" `isSuffixOf` o - || "configure-option" == o - ) - ) +removeConfigureOptions (optionName -> o) = + not + ( "append" `isSuffixOf` o + || "backup" `isSuffixOf` o + || "configure-option" == o + ) removePhaseOptions :: OptionField a -> Bool -removePhaseOptions = - ( \(optionName -> o) -> - not - ( "only-configure" == o - || "only-download" == o - || "dry-run" == o - ) - ) +removePhaseOptions (optionName -> o) = + not + ( "only-configure" == o + || "only-download" == o + || "dry-run" == o + ) removeCompilerOptions :: OptionField a -> Bool -removeCompilerOptions = - ( \(optionName -> o) -> - not - ( "ghc" == o - || "ghcjs" == o - || "uhc" == o - || "with-compiler" == o - || "cabal-lib-version" == o - || "optimization" `isSuffixOf` o - || "semaphore" == o - || "jobs" == o - || "keep-going" == o - || "offline" == o - ) - ) +removeCompilerOptions (optionName -> o) = + not + ( "ghc" == o + || "ghcjs" == o + || "uhc" == o + || "with-compiler" == o + || "cabal-lib-version" == o + || "optimization" `isSuffixOf` o + || "semaphore" == o + || "jobs" == o + || "keep-going" == o + || "offline" == o + ) removeLoggingOptions :: OptionField a -> Bool -removeLoggingOptions = - ( \(optionName -> o) -> - not - ( "verbose" == o - || "keep-temp-files" == o - || "build-summary" == o - || "build-log" == o - || "build-timings" == o - || "remote-build-reporting" == o - || "report-planning-failure" == o - ) - ) +removeLoggingOptions (optionName -> o) = + not + ( "verbose" == o + || "keep-temp-files" == o + || "build-summary" == o + || "build-log" == o + || "build-timings" == o + || "remote-build-reporting" == o + || "report-planning-failure" == o + ) removeIncludeOptions :: OptionField a -> Bool -removeIncludeOptions = - ( \(optionName -> o) -> - not - ( "extra-include-dirs" == o - || "extra-lib-dirs" == o - || "extra-framework-dirs" == o - || "extra-prog-path" == o - || "disable-response-files" == o - ) - ) +removeIncludeOptions (optionName -> o) = + not + ( "extra-include-dirs" == o + || "extra-lib-dirs" == o + || "extra-framework-dirs" == o + || "extra-prog-path" == o + || "disable-response-files" == o + ) removeProgOptions :: OptionField a -> Bool -removeProgOptions = - ( \(optionName -> o) -> - not - ( "with-PROG" == o - || "PROG-option" `isPrefixOf` o - ) - ) +removeProgOptions (optionName -> o) = + not + ( "with-PROG" == o + || "PROG-option" `isPrefixOf` o + ) From 92f1adcc3b3636bcff633a9e65e76f5fed16701a Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 5 Aug 2026 09:06:25 -0400 Subject: [PATCH 18/85] Rename remove.*Options to keep.*Options --- .../src/Distribution/Client/CmdBuild.hs | 108 +++---- .../Distribution/Client/NixStyleOptions.hs | 288 ++++++++---------- 2 files changed, 185 insertions(+), 211 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 832e97a1c67..6a077bfac20 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -37,24 +37,24 @@ import Distribution.Client.NixStyleOptions , cfgVerbosity , defaultNixStyleFlags , nixStyleOptions - , removeBenchOptions - , removeCompilerOptions - , removeConfigureOptions - , removeCoverageOptions - , removeExeOptions - , removeHaddockOptions - , removeIncludeOptions - , removeInstallOptions - , removeIrrelevantOptions - , removeLibOptions - , removeLoggingOptions - , removeOutputOptions - , removePhaseOptions - , removeProgOptions - , removeProfilingOptions - , removeSolvingOptions - , removeTestOptions - , removeUnsupportedOptions + , keepBenchOptions + , keepCompilerOptions + , keepConfigureOptions + , keepCoverageOptions + , keepExeOptions + , keepHaddockOptions + , keepIncludeOptions + , keepInstallOptions + , keepIrrelevantOptions + , keepLibOptions + , keepLoggingOptions + , keepOutputOptions + , keepPhaseOptions + , keepProgOptions + , keepProfilingOptions + , keepSolvingOptions + , keepTestOptions + , keepUnsupportedOptions ) import Distribution.Client.ScriptUtils ( AcceptNoTargets (..) @@ -380,48 +380,48 @@ buildOptionGroups = where opts0 = commandOptions buildCommand ShowArgs - (unsupported, opts1) = CommandUIOpt.splitBy removeUnsupportedOptions opts0 - (install, opts2) = CommandUIOpt.splitBy removeInstallOptions opts1 - (irrelevant, opts3) = CommandUIOpt.splitBy removeIrrelevantOptions opts2 - (haddock, opts4) = CommandUIOpt.splitBy removeHaddockOptions opts3 - (test, opts5) = CommandUIOpt.splitBy removeTestOptions opts4 - (bench, opts6) = CommandUIOpt.splitBy removeBenchOptions opts5 - (profiling, opts7) = CommandUIOpt.splitBy removeProfilingOptions opts6 - (solving, opts8) = CommandUIOpt.splitBy removeSolvingOptions opts7 - (exe, opts9) = CommandUIOpt.splitBy removeExeOptions opts8 - (lib, opts10) = CommandUIOpt.splitBy removeLibOptions opts9 - (coverage, opts11) = CommandUIOpt.splitBy removeCoverageOptions opts10 - (output, opts12) = CommandUIOpt.splitBy removeOutputOptions opts11 - (configure, opts13) = CommandUIOpt.splitBy removeConfigureOptions opts12 - (phase, opts14) = CommandUIOpt.splitBy removePhaseOptions opts13 - (compiler, opts15) = CommandUIOpt.splitBy removeCompilerOptions opts14 - (logging, opts16) = CommandUIOpt.splitBy removeLoggingOptions opts15 - (includePaths, opts17) = CommandUIOpt.splitBy removeIncludeOptions opts16 - (prog, _opts18) = CommandUIOpt.splitBy removeProgOptions opts17 + (unsupported, opts1) = CommandUIOpt.splitBy (not . keepUnsupportedOptions) opts0 + (install, opts2) = CommandUIOpt.splitBy (not . keepInstallOptions) opts1 + (irrelevant, opts3) = CommandUIOpt.splitBy (not . keepIrrelevantOptions) opts2 + (haddock, opts4) = CommandUIOpt.splitBy (not . keepHaddockOptions) opts3 + (test, opts5) = CommandUIOpt.splitBy (not . keepTestOptions) opts4 + (bench, opts6) = CommandUIOpt.splitBy (not . keepBenchOptions) opts5 + (profiling, opts7) = CommandUIOpt.splitBy (not . keepProfilingOptions) opts6 + (solving, opts8) = CommandUIOpt.splitBy (not . keepSolvingOptions) opts7 + (exe, opts9) = CommandUIOpt.splitBy (not . keepExeOptions) opts8 + (lib, opts10) = CommandUIOpt.splitBy (not . keepLibOptions) opts9 + (coverage, opts11) = CommandUIOpt.splitBy (not . keepCoverageOptions) opts10 + (output, opts12) = CommandUIOpt.splitBy (not . keepOutputOptions) opts11 + (configure, opts13) = CommandUIOpt.splitBy (not . keepConfigureOptions) opts12 + (phase, opts14) = CommandUIOpt.splitBy (not . keepPhaseOptions) opts13 + (compiler, opts15) = CommandUIOpt.splitBy (not . keepCompilerOptions) opts14 + (logging, opts16) = CommandUIOpt.splitBy (not . keepLoggingOptions) opts15 + (includePaths, opts17) = CommandUIOpt.splitBy (not . keepIncludeOptions) opts16 + (prog, _opts18) = CommandUIOpt.splitBy (not . keepProgOptions) opts17 buildUngroupedOptions :: [BuildOptionField] buildUngroupedOptions = opts18 where opts0 = commandOptions buildCommand ShowArgs - (_, opts1) = CommandUIOpt.splitBy removeUnsupportedOptions opts0 - (_, opts2) = CommandUIOpt.splitBy removeInstallOptions opts1 - (_, opts3) = CommandUIOpt.splitBy removeIrrelevantOptions opts2 - (_, opts4) = CommandUIOpt.splitBy removeHaddockOptions opts3 - (_, opts5) = CommandUIOpt.splitBy removeTestOptions opts4 - (_, opts6) = CommandUIOpt.splitBy removeBenchOptions opts5 - (_, opts7) = CommandUIOpt.splitBy removeProfilingOptions opts6 - (_, opts8) = CommandUIOpt.splitBy removeSolvingOptions opts7 - (_, opts9) = CommandUIOpt.splitBy removeExeOptions opts8 - (_, opts10) = CommandUIOpt.splitBy removeLibOptions opts9 - (_, opts11) = CommandUIOpt.splitBy removeCoverageOptions opts10 - (_, opts12) = CommandUIOpt.splitBy removeOutputOptions opts11 - (_, opts13) = CommandUIOpt.splitBy removeConfigureOptions opts12 - (_, opts14) = CommandUIOpt.splitBy removePhaseOptions opts13 - (_, opts15) = CommandUIOpt.splitBy removeCompilerOptions opts14 - (_, opts16) = CommandUIOpt.splitBy removeLoggingOptions opts15 - (_, opts17) = CommandUIOpt.splitBy removeIncludeOptions opts16 - (_, opts18) = CommandUIOpt.splitBy removeProgOptions opts17 + (_, opts1) = CommandUIOpt.splitBy (not . keepUnsupportedOptions) opts0 + (_, opts2) = CommandUIOpt.splitBy (not . keepInstallOptions) opts1 + (_, opts3) = CommandUIOpt.splitBy (not . keepIrrelevantOptions) opts2 + (_, opts4) = CommandUIOpt.splitBy (not . keepHaddockOptions) opts3 + (_, opts5) = CommandUIOpt.splitBy (not . keepTestOptions) opts4 + (_, opts6) = CommandUIOpt.splitBy (not . keepBenchOptions) opts5 + (_, opts7) = CommandUIOpt.splitBy (not . keepProfilingOptions) opts6 + (_, opts8) = CommandUIOpt.splitBy (not . keepSolvingOptions) opts7 + (_, opts9) = CommandUIOpt.splitBy (not . keepExeOptions) opts8 + (_, opts10) = CommandUIOpt.splitBy (not . keepLibOptions) opts9 + (_, opts11) = CommandUIOpt.splitBy (not . keepCoverageOptions) opts10 + (_, opts12) = CommandUIOpt.splitBy (not . keepOutputOptions) opts11 + (_, opts13) = CommandUIOpt.splitBy (not . keepConfigureOptions) opts12 + (_, opts14) = CommandUIOpt.splitBy (not . keepPhaseOptions) opts13 + (_, opts15) = CommandUIOpt.splitBy (not . keepCompilerOptions) opts14 + (_, opts16) = CommandUIOpt.splitBy (not . keepLoggingOptions) opts15 + (_, opts17) = CommandUIOpt.splitBy (not . keepIncludeOptions) opts16 + (_, opts18) = CommandUIOpt.splitBy (not . keepProgOptions) opts17 diff --git a/cabal-install/src/Distribution/Client/NixStyleOptions.hs b/cabal-install/src/Distribution/Client/NixStyleOptions.hs index 73143a4ea8d..63ea3d6ded0 100644 --- a/cabal-install/src/Distribution/Client/NixStyleOptions.hs +++ b/cabal-install/src/Distribution/Client/NixStyleOptions.hs @@ -12,24 +12,24 @@ module Distribution.Client.NixStyleOptions , cfgVerbosity -- * Option filtering/grouping predicates - , removeUnsupportedOptions - , removeInstallOptions - , removeIrrelevantOptions - , removeHaddockOptions - , removeTestOptions - , removeBenchOptions - , removeProfilingOptions - , removeSolvingOptions - , removeExeOptions - , removeLibOptions - , removeCoverageOptions - , removeOutputOptions - , removeConfigureOptions - , removePhaseOptions - , removeCompilerOptions - , removeLoggingOptions - , removeIncludeOptions - , removeProgOptions + , keepUnsupportedOptions + , keepInstallOptions + , keepIrrelevantOptions + , keepHaddockOptions + , keepTestOptions + , keepBenchOptions + , keepProfilingOptions + , keepSolvingOptions + , keepExeOptions + , keepLibOptions + , keepCoverageOptions + , keepOutputOptions + , keepConfigureOptions + , keepPhaseOptions + , keepCompilerOptions + , keepLoggingOptions + , keepIncludeOptions + , keepProgOptions ) where import Distribution.Client.Compat.Prelude @@ -186,159 +186,133 @@ cfgVerbosity v flags = mkVerbosity defaultVerbosityHandles $ fromFlagOrDefault v (setupVerbosity . configCommonFlags $ configFlags flags) -removeUnsupportedOptions :: OptionField a -> Bool -removeUnsupportedOptions (optionName -> o) = not ("root-cmd" == o || "allow-boot-library-installs" == o) +keepUnsupportedOptions :: OptionField a -> Bool +keepUnsupportedOptions (optionName -> o) = "root-cmd" == o || "allow-boot-library-installs" == o -removeInstallOptions :: OptionField a -> Bool -removeInstallOptions (optionName -> o) = - not - ( "dir" `isSuffixOf` o - || "reinstall" `isInfixOf` o - || "run-tests" == o - || "root-cmd" == o - || "allow-boot-library-installs" == o - || "program-prefix" == o - || "program-suffix" == o - || "ipid" == o - || "cid" == o - || "user" == o - || "global" == o - || "prefix" == o - ) +keepInstallOptions :: OptionField a -> Bool +keepInstallOptions (optionName -> o) = + "dir" `isSuffixOf` o + || "reinstall" `isInfixOf` o + || "run-tests" == o + || "root-cmd" == o + || "allow-boot-library-installs" == o + || "program-prefix" == o + || "program-suffix" == o + || "ipid" == o + || "cid" == o + || "user" == o + || "global" == o + || "prefix" == o -removeIrrelevantOptions :: OptionField a -> Bool -removeIrrelevantOptions (optionName -> o) = not ("per-component" `isSuffixOf` o) +keepIrrelevantOptions :: OptionField a -> Bool +keepIrrelevantOptions (optionName -> o) = "per-component" `isSuffixOf` o -removeHaddockOptions :: OptionField a -> Bool -removeHaddockOptions (optionName -> o) = - not - ( "haddock" `isPrefixOf` o - || "documentation" `isSuffixOf` o - || "doc-index-file" == o - ) +keepHaddockOptions :: OptionField a -> Bool +keepHaddockOptions (optionName -> o) = + "haddock" `isPrefixOf` o + || "documentation" `isSuffixOf` o + || "doc-index-file" == o -removeTestOptions :: OptionField a -> Bool -removeTestOptions (optionName -> o) = not ("test" `isPrefixOf` o) +keepTestOptions :: OptionField a -> Bool +keepTestOptions (optionName -> o) = "test" `isPrefixOf` o -removeBenchOptions :: OptionField a -> Bool -removeBenchOptions (optionName -> o) = not ("bench" `isPrefixOf` o) +keepBenchOptions :: OptionField a -> Bool +keepBenchOptions (optionName -> o) = "bench" `isPrefixOf` o -removeProfilingOptions :: OptionField a -> Bool -removeProfilingOptions (optionName -> o) = not ("profiling" `isInfixOf` o) +keepProfilingOptions :: OptionField a -> Bool +keepProfilingOptions (optionName -> o) = "profiling" `isInfixOf` o -removeSolvingOptions :: OptionField a -> Bool -removeSolvingOptions (optionName -> o) = - not - ( "max-backjumps" == o - || "conflicts" `isInfixOf` o - || "goals" `isInfixOf` o - || "index-state" == o - || "upgrade-dependencies" == o - || "reject-unconstrained-dependencies" == o - || "prefer-oldest" == o - || "allow-older" == o - || "allow-newer" == o - || "preference" == o - || "shadow-installed-packages" == o - || "ignore-build-tools" == o - || "solver" == o - || "only-dependencies" == o - || "dependencies-only" == o - || "minimize-conflict-set" == o - || "allow-depending-on-private-libs" == o - ) +keepSolvingOptions :: OptionField a -> Bool +keepSolvingOptions (optionName -> o) = + "max-backjumps" == o + || "conflicts" `isInfixOf` o + || "goals" `isInfixOf` o + || "index-state" == o + || "upgrade-dependencies" == o + || "reject-unconstrained-dependencies" == o + || "prefer-oldest" == o + || "allow-older" == o + || "allow-newer" == o + || "preference" == o + || "shadow-installed-packages" == o + || "ignore-build-tools" == o + || "solver" == o + || "only-dependencies" == o + || "dependencies-only" == o + || "minimize-conflict-set" == o + || "allow-depending-on-private-libs" == o -removeExeOptions :: OptionField a -> Bool -removeExeOptions (optionName -> o) = - not - ( "executable" `isInfixOf` o - || "split" `isInfixOf` o - || "stripping" `isInfixOf` o - ) +keepExeOptions :: OptionField a -> Bool +keepExeOptions (optionName -> o) = + "executable" `isInfixOf` o + || "split" `isInfixOf` o + || "stripping" `isInfixOf` o -removeLibOptions :: OptionField a -> Bool -removeLibOptions (optionName -> o) = - not - ( "vanilla" `isSuffixOf` o - || "shared" `isSuffixOf` o - || "static" `isSuffixOf` o - || "bytecode" `isSuffixOf` o - || "ghci" `isSuffixOf` o - ) +keepLibOptions :: OptionField a -> Bool +keepLibOptions (optionName -> o) = + "vanilla" `isSuffixOf` o + || "shared" `isSuffixOf` o + || "static" `isSuffixOf` o + || "bytecode" `isSuffixOf` o + || "ghci" `isSuffixOf` o -removeCoverageOptions :: OptionField a -> Bool -removeCoverageOptions (optionName -> o) = - not - ( "coverage" `isSuffixOf` o - || "coverage" `isPrefixOf` o - ) +keepCoverageOptions :: OptionField a -> Bool +keepCoverageOptions (optionName -> o) = + "coverage" `isSuffixOf` o + || "coverage" `isPrefixOf` o -removeOutputOptions :: OptionField a -> Bool -removeOutputOptions (optionName -> o) = - not - ( "build-info" `isSuffixOf` o - || "debug-info" `isSuffixOf` o - || "deterministic" `isSuffixOf` o - || "relocatable" `isSuffixOf` o - || "write-ghc-environment-files" == o - ) +keepOutputOptions :: OptionField a -> Bool +keepOutputOptions (optionName -> o) = + "build-info" `isSuffixOf` o + || "debug-info" `isSuffixOf` o + || "deterministic" `isSuffixOf` o + || "relocatable" `isSuffixOf` o + || "write-ghc-environment-files" == o -removeConfigureOptions :: OptionField a -> Bool -removeConfigureOptions (optionName -> o) = - not - ( "append" `isSuffixOf` o - || "backup" `isSuffixOf` o - || "configure-option" == o - ) +keepConfigureOptions :: OptionField a -> Bool +keepConfigureOptions (optionName -> o) = + "append" `isSuffixOf` o + || "backup" `isSuffixOf` o + || "configure-option" == o -removePhaseOptions :: OptionField a -> Bool -removePhaseOptions (optionName -> o) = - not - ( "only-configure" == o - || "only-download" == o - || "dry-run" == o - ) +keepPhaseOptions :: OptionField a -> Bool +keepPhaseOptions (optionName -> o) = + "only-configure" == o + || "only-download" == o + || "dry-run" == o -removeCompilerOptions :: OptionField a -> Bool -removeCompilerOptions (optionName -> o) = - not - ( "ghc" == o - || "ghcjs" == o - || "uhc" == o - || "with-compiler" == o - || "cabal-lib-version" == o - || "optimization" `isSuffixOf` o - || "semaphore" == o - || "jobs" == o - || "keep-going" == o - || "offline" == o - ) +keepCompilerOptions :: OptionField a -> Bool +keepCompilerOptions (optionName -> o) = + "ghc" == o + || "ghcjs" == o + || "uhc" == o + || "with-compiler" == o + || "cabal-lib-version" == o + || "optimization" `isSuffixOf` o + || "semaphore" == o + || "jobs" == o + || "keep-going" == o + || "offline" == o -removeLoggingOptions :: OptionField a -> Bool -removeLoggingOptions (optionName -> o) = - not - ( "verbose" == o - || "keep-temp-files" == o - || "build-summary" == o - || "build-log" == o - || "build-timings" == o - || "remote-build-reporting" == o - || "report-planning-failure" == o - ) +keepLoggingOptions :: OptionField a -> Bool +keepLoggingOptions (optionName -> o) = + "verbose" == o + || "keep-temp-files" == o + || "build-summary" == o + || "build-log" == o + || "build-timings" == o + || "remote-build-reporting" == o + || "report-planning-failure" == o -removeIncludeOptions :: OptionField a -> Bool -removeIncludeOptions (optionName -> o) = - not - ( "extra-include-dirs" == o - || "extra-lib-dirs" == o - || "extra-framework-dirs" == o - || "extra-prog-path" == o - || "disable-response-files" == o - ) +keepIncludeOptions :: OptionField a -> Bool +keepIncludeOptions (optionName -> o) = + "extra-include-dirs" == o + || "extra-lib-dirs" == o + || "extra-framework-dirs" == o + || "extra-prog-path" == o + || "disable-response-files" == o -removeProgOptions :: OptionField a -> Bool -removeProgOptions (optionName -> o) = - not - ( "with-PROG" == o - || "PROG-option" `isPrefixOf` o - ) +keepProgOptions :: OptionField a -> Bool +keepProgOptions (optionName -> o) = + "with-PROG" == o + || "PROG-option" `isPrefixOf` o From c7fcfebe6f12bbc6561c6871c1943b5d50189614 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 5 Aug 2026 09:23:12 -0400 Subject: [PATCH 19/85] Add -Wno-unused-packages to cabal-testsuite --- cabal.project | 3 +++ 1 file changed, 3 insertions(+) diff --git a/cabal.project b/cabal.project index f2a31a35ec3..6d1d8b2c04a 100644 --- a/cabal.project +++ b/cabal.project @@ -15,3 +15,6 @@ package Cabal package semaphore-compat flags: -build-testing + +package cabal-testsuite + ghc-options: -Wno-unused-packages From f7590ecd19a0b5d8a395c953131d45d8aa9fa4ec Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 5 Aug 2026 09:23:57 -0400 Subject: [PATCH 20/85] Add splitByKeep --- .../src/Distribution/Client/CmdBuild.hs | 72 +++++++++---------- .../Distribution/Client/CommandUIOptParse.hs | 4 ++ 2 files changed, 40 insertions(+), 36 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 6a077bfac20..5403dcb021e 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -380,48 +380,48 @@ buildOptionGroups = where opts0 = commandOptions buildCommand ShowArgs - (unsupported, opts1) = CommandUIOpt.splitBy (not . keepUnsupportedOptions) opts0 - (install, opts2) = CommandUIOpt.splitBy (not . keepInstallOptions) opts1 - (irrelevant, opts3) = CommandUIOpt.splitBy (not . keepIrrelevantOptions) opts2 - (haddock, opts4) = CommandUIOpt.splitBy (not . keepHaddockOptions) opts3 - (test, opts5) = CommandUIOpt.splitBy (not . keepTestOptions) opts4 - (bench, opts6) = CommandUIOpt.splitBy (not . keepBenchOptions) opts5 - (profiling, opts7) = CommandUIOpt.splitBy (not . keepProfilingOptions) opts6 - (solving, opts8) = CommandUIOpt.splitBy (not . keepSolvingOptions) opts7 - (exe, opts9) = CommandUIOpt.splitBy (not . keepExeOptions) opts8 - (lib, opts10) = CommandUIOpt.splitBy (not . keepLibOptions) opts9 - (coverage, opts11) = CommandUIOpt.splitBy (not . keepCoverageOptions) opts10 - (output, opts12) = CommandUIOpt.splitBy (not . keepOutputOptions) opts11 - (configure, opts13) = CommandUIOpt.splitBy (not . keepConfigureOptions) opts12 - (phase, opts14) = CommandUIOpt.splitBy (not . keepPhaseOptions) opts13 - (compiler, opts15) = CommandUIOpt.splitBy (not . keepCompilerOptions) opts14 - (logging, opts16) = CommandUIOpt.splitBy (not . keepLoggingOptions) opts15 - (includePaths, opts17) = CommandUIOpt.splitBy (not . keepIncludeOptions) opts16 - (prog, _opts18) = CommandUIOpt.splitBy (not . keepProgOptions) opts17 + (unsupported, opts1) = CommandUIOpt.splitByKeep keepUnsupportedOptions opts0 + (install, opts2) = CommandUIOpt.splitByKeep keepInstallOptions opts1 + (irrelevant, opts3) = CommandUIOpt.splitByKeep keepIrrelevantOptions opts2 + (haddock, opts4) = CommandUIOpt.splitByKeep keepHaddockOptions opts3 + (test, opts5) = CommandUIOpt.splitByKeep keepTestOptions opts4 + (bench, opts6) = CommandUIOpt.splitByKeep keepBenchOptions opts5 + (profiling, opts7) = CommandUIOpt.splitByKeep keepProfilingOptions opts6 + (solving, opts8) = CommandUIOpt.splitByKeep keepSolvingOptions opts7 + (exe, opts9) = CommandUIOpt.splitByKeep keepExeOptions opts8 + (lib, opts10) = CommandUIOpt.splitByKeep keepLibOptions opts9 + (coverage, opts11) = CommandUIOpt.splitByKeep keepCoverageOptions opts10 + (output, opts12) = CommandUIOpt.splitByKeep keepOutputOptions opts11 + (configure, opts13) = CommandUIOpt.splitByKeep keepConfigureOptions opts12 + (phase, opts14) = CommandUIOpt.splitByKeep keepPhaseOptions opts13 + (compiler, opts15) = CommandUIOpt.splitByKeep keepCompilerOptions opts14 + (logging, opts16) = CommandUIOpt.splitByKeep keepLoggingOptions opts15 + (includePaths, opts17) = CommandUIOpt.splitByKeep keepIncludeOptions opts16 + (prog, _opts18) = CommandUIOpt.splitByKeep keepProgOptions opts17 buildUngroupedOptions :: [BuildOptionField] buildUngroupedOptions = opts18 where opts0 = commandOptions buildCommand ShowArgs - (_, opts1) = CommandUIOpt.splitBy (not . keepUnsupportedOptions) opts0 - (_, opts2) = CommandUIOpt.splitBy (not . keepInstallOptions) opts1 - (_, opts3) = CommandUIOpt.splitBy (not . keepIrrelevantOptions) opts2 - (_, opts4) = CommandUIOpt.splitBy (not . keepHaddockOptions) opts3 - (_, opts5) = CommandUIOpt.splitBy (not . keepTestOptions) opts4 - (_, opts6) = CommandUIOpt.splitBy (not . keepBenchOptions) opts5 - (_, opts7) = CommandUIOpt.splitBy (not . keepProfilingOptions) opts6 - (_, opts8) = CommandUIOpt.splitBy (not . keepSolvingOptions) opts7 - (_, opts9) = CommandUIOpt.splitBy (not . keepExeOptions) opts8 - (_, opts10) = CommandUIOpt.splitBy (not . keepLibOptions) opts9 - (_, opts11) = CommandUIOpt.splitBy (not . keepCoverageOptions) opts10 - (_, opts12) = CommandUIOpt.splitBy (not . keepOutputOptions) opts11 - (_, opts13) = CommandUIOpt.splitBy (not . keepConfigureOptions) opts12 - (_, opts14) = CommandUIOpt.splitBy (not . keepPhaseOptions) opts13 - (_, opts15) = CommandUIOpt.splitBy (not . keepCompilerOptions) opts14 - (_, opts16) = CommandUIOpt.splitBy (not . keepLoggingOptions) opts15 - (_, opts17) = CommandUIOpt.splitBy (not . keepIncludeOptions) opts16 - (_, opts18) = CommandUIOpt.splitBy (not . keepProgOptions) opts17 + (_, opts1) = CommandUIOpt.splitByKeep keepUnsupportedOptions opts0 + (_, opts2) = CommandUIOpt.splitByKeep keepInstallOptions opts1 + (_, opts3) = CommandUIOpt.splitByKeep keepIrrelevantOptions opts2 + (_, opts4) = CommandUIOpt.splitByKeep keepHaddockOptions opts3 + (_, opts5) = CommandUIOpt.splitByKeep keepTestOptions opts4 + (_, opts6) = CommandUIOpt.splitByKeep keepBenchOptions opts5 + (_, opts7) = CommandUIOpt.splitByKeep keepProfilingOptions opts6 + (_, opts8) = CommandUIOpt.splitByKeep keepSolvingOptions opts7 + (_, opts9) = CommandUIOpt.splitByKeep keepExeOptions opts8 + (_, opts10) = CommandUIOpt.splitByKeep keepLibOptions opts9 + (_, opts11) = CommandUIOpt.splitByKeep keepCoverageOptions opts10 + (_, opts12) = CommandUIOpt.splitByKeep keepOutputOptions opts11 + (_, opts13) = CommandUIOpt.splitByKeep keepConfigureOptions opts12 + (_, opts14) = CommandUIOpt.splitByKeep keepPhaseOptions opts13 + (_, opts15) = CommandUIOpt.splitByKeep keepCompilerOptions opts14 + (_, opts16) = CommandUIOpt.splitByKeep keepLoggingOptions opts15 + (_, opts17) = CommandUIOpt.splitByKeep keepIncludeOptions opts16 + (_, opts18) = CommandUIOpt.splitByKeep keepProgOptions opts17 diff --git a/cabal-install/src/Distribution/Client/CommandUIOptParse.hs b/cabal-install/src/Distribution/Client/CommandUIOptParse.hs index 24f61a02759..13b489ec7d3 100644 --- a/cabal-install/src/Distribution/Client/CommandUIOptParse.hs +++ b/cabal-install/src/Distribution/Client/CommandUIOptParse.hs @@ -20,6 +20,7 @@ module Distribution.Client.CommandUIOptParse -- * Utility helpers , splitBy + , splitByKeep ) where import Distribution.Client.Compat.Prelude @@ -223,3 +224,6 @@ getOptToColumns (GetOpt.Option shortFlags longFlags argDescr description) = splitBy :: (a -> Bool) -> [a] -> ([a], [a]) splitBy keepPred = partition (not . keepPred) + +splitByKeep :: (a -> Bool) -> [a] -> ([a], [a]) +splitByKeep keepPred = partition keepPred From c3d631eba2bb969231cb3dfc58bafdc2c1b4d2b0 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 5 Aug 2026 09:29:40 -0400 Subject: [PATCH 21/85] Replace splitByKeep with partition, remove splitBy --- .../src/Distribution/Client/CmdBuild.hs | 72 +++++++++---------- .../Distribution/Client/CommandUIOptParse.hs | 7 -- 2 files changed, 36 insertions(+), 43 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 5403dcb021e..b3dcc528f8c 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -380,48 +380,48 @@ buildOptionGroups = where opts0 = commandOptions buildCommand ShowArgs - (unsupported, opts1) = CommandUIOpt.splitByKeep keepUnsupportedOptions opts0 - (install, opts2) = CommandUIOpt.splitByKeep keepInstallOptions opts1 - (irrelevant, opts3) = CommandUIOpt.splitByKeep keepIrrelevantOptions opts2 - (haddock, opts4) = CommandUIOpt.splitByKeep keepHaddockOptions opts3 - (test, opts5) = CommandUIOpt.splitByKeep keepTestOptions opts4 - (bench, opts6) = CommandUIOpt.splitByKeep keepBenchOptions opts5 - (profiling, opts7) = CommandUIOpt.splitByKeep keepProfilingOptions opts6 - (solving, opts8) = CommandUIOpt.splitByKeep keepSolvingOptions opts7 - (exe, opts9) = CommandUIOpt.splitByKeep keepExeOptions opts8 - (lib, opts10) = CommandUIOpt.splitByKeep keepLibOptions opts9 - (coverage, opts11) = CommandUIOpt.splitByKeep keepCoverageOptions opts10 - (output, opts12) = CommandUIOpt.splitByKeep keepOutputOptions opts11 - (configure, opts13) = CommandUIOpt.splitByKeep keepConfigureOptions opts12 - (phase, opts14) = CommandUIOpt.splitByKeep keepPhaseOptions opts13 - (compiler, opts15) = CommandUIOpt.splitByKeep keepCompilerOptions opts14 - (logging, opts16) = CommandUIOpt.splitByKeep keepLoggingOptions opts15 - (includePaths, opts17) = CommandUIOpt.splitByKeep keepIncludeOptions opts16 - (prog, _opts18) = CommandUIOpt.splitByKeep keepProgOptions opts17 + (unsupported, opts1) = partition keepUnsupportedOptions opts0 + (install, opts2) = partition keepInstallOptions opts1 + (irrelevant, opts3) = partition keepIrrelevantOptions opts2 + (haddock, opts4) = partition keepHaddockOptions opts3 + (test, opts5) = partition keepTestOptions opts4 + (bench, opts6) = partition keepBenchOptions opts5 + (profiling, opts7) = partition keepProfilingOptions opts6 + (solving, opts8) = partition keepSolvingOptions opts7 + (exe, opts9) = partition keepExeOptions opts8 + (lib, opts10) = partition keepLibOptions opts9 + (coverage, opts11) = partition keepCoverageOptions opts10 + (output, opts12) = partition keepOutputOptions opts11 + (configure, opts13) = partition keepConfigureOptions opts12 + (phase, opts14) = partition keepPhaseOptions opts13 + (compiler, opts15) = partition keepCompilerOptions opts14 + (logging, opts16) = partition keepLoggingOptions opts15 + (includePaths, opts17) = partition keepIncludeOptions opts16 + (prog, _opts18) = partition keepProgOptions opts17 buildUngroupedOptions :: [BuildOptionField] buildUngroupedOptions = opts18 where opts0 = commandOptions buildCommand ShowArgs - (_, opts1) = CommandUIOpt.splitByKeep keepUnsupportedOptions opts0 - (_, opts2) = CommandUIOpt.splitByKeep keepInstallOptions opts1 - (_, opts3) = CommandUIOpt.splitByKeep keepIrrelevantOptions opts2 - (_, opts4) = CommandUIOpt.splitByKeep keepHaddockOptions opts3 - (_, opts5) = CommandUIOpt.splitByKeep keepTestOptions opts4 - (_, opts6) = CommandUIOpt.splitByKeep keepBenchOptions opts5 - (_, opts7) = CommandUIOpt.splitByKeep keepProfilingOptions opts6 - (_, opts8) = CommandUIOpt.splitByKeep keepSolvingOptions opts7 - (_, opts9) = CommandUIOpt.splitByKeep keepExeOptions opts8 - (_, opts10) = CommandUIOpt.splitByKeep keepLibOptions opts9 - (_, opts11) = CommandUIOpt.splitByKeep keepCoverageOptions opts10 - (_, opts12) = CommandUIOpt.splitByKeep keepOutputOptions opts11 - (_, opts13) = CommandUIOpt.splitByKeep keepConfigureOptions opts12 - (_, opts14) = CommandUIOpt.splitByKeep keepPhaseOptions opts13 - (_, opts15) = CommandUIOpt.splitByKeep keepCompilerOptions opts14 - (_, opts16) = CommandUIOpt.splitByKeep keepLoggingOptions opts15 - (_, opts17) = CommandUIOpt.splitByKeep keepIncludeOptions opts16 - (_, opts18) = CommandUIOpt.splitByKeep keepProgOptions opts17 + (_, opts1) = partition keepUnsupportedOptions opts0 + (_, opts2) = partition keepInstallOptions opts1 + (_, opts3) = partition keepIrrelevantOptions opts2 + (_, opts4) = partition keepHaddockOptions opts3 + (_, opts5) = partition keepTestOptions opts4 + (_, opts6) = partition keepBenchOptions opts5 + (_, opts7) = partition keepProfilingOptions opts6 + (_, opts8) = partition keepSolvingOptions opts7 + (_, opts9) = partition keepExeOptions opts8 + (_, opts10) = partition keepLibOptions opts9 + (_, opts11) = partition keepCoverageOptions opts10 + (_, opts12) = partition keepOutputOptions opts11 + (_, opts13) = partition keepConfigureOptions opts12 + (_, opts14) = partition keepPhaseOptions opts13 + (_, opts15) = partition keepCompilerOptions opts14 + (_, opts16) = partition keepLoggingOptions opts15 + (_, opts17) = partition keepIncludeOptions opts16 + (_, opts18) = partition keepProgOptions opts17 diff --git a/cabal-install/src/Distribution/Client/CommandUIOptParse.hs b/cabal-install/src/Distribution/Client/CommandUIOptParse.hs index 13b489ec7d3..d4ebd62ca91 100644 --- a/cabal-install/src/Distribution/Client/CommandUIOptParse.hs +++ b/cabal-install/src/Distribution/Client/CommandUIOptParse.hs @@ -18,9 +18,6 @@ module Distribution.Client.CommandUIOptParse , wrapDescription , capitalizeDescription - -- * Utility helpers - , splitBy - , splitByKeep ) where import Distribution.Client.Compat.Prelude @@ -222,8 +219,4 @@ getOptToColumns (GetOpt.Option shortFlags longFlags argDescr description) = GetOpt.ReqArg _ metaVar -> "--" <> longFlag <> "=" <> metaVar GetOpt.OptArg _ metaVar -> "--" <> longFlag <> "[=" <> metaVar <> "]" -splitBy :: (a -> Bool) -> [a] -> ([a], [a]) -splitBy keepPred = partition (not . keepPred) -splitByKeep :: (a -> Bool) -> [a] -> ([a], [a]) -splitByKeep keepPred = partition keepPred From 63b5a4c5b40006f92ec913ea7720d6ac0eb1131d Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 5 Aug 2026 09:48:30 -0400 Subject: [PATCH 22/85] Add groupSequentially --- .../src/Distribution/Client/CmdBuild.hs | 115 ++++++------------ .../Distribution/Client/CommandUIOptParse.hs | 13 +- 2 files changed, 49 insertions(+), 79 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index b3dcc528f8c..33ee0bf264c 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -29,14 +29,12 @@ import Distribution.Client.TargetProblem import qualified Data.Map as Map import Data.Monoid (Endo (..), appEndo) import qualified Data.Text as T -import qualified System.Console.GetOpt as GetOpt import qualified Distribution.Client.CommandUIOptParse as CommandUIOpt import Distribution.Client.Errors import Distribution.Client.NixStyleOptions ( NixStyleFlags (..) , cfgVerbosity , defaultNixStyleFlags - , nixStyleOptions , keepBenchOptions , keepCompilerOptions , keepConfigureOptions @@ -50,11 +48,12 @@ import Distribution.Client.NixStyleOptions , keepLoggingOptions , keepOutputOptions , keepPhaseOptions - , keepProgOptions , keepProfilingOptions + , keepProgOptions , keepSolvingOptions , keepTestOptions , keepUnsupportedOptions + , nixStyleOptions ) import Distribution.Client.ScriptUtils ( AcceptNoTargets (..) @@ -83,6 +82,7 @@ import Distribution.Simple.Utils import Distribution.Verbosity ( normal ) +import qualified System.Console.GetOpt as GetOpt import qualified Options.Applicative as O @@ -311,7 +311,8 @@ buildHelpText invokedName pname = descColumn :: Int descColumn = - min maxFlagColumnWidth + min + maxFlagColumnWidth ( maximum ( 0 : map @@ -348,82 +349,42 @@ buildHelpText invokedName pname = | otherwise = let (rows, warnings) = CommandUIOpt.renderOptionRows colorizeWarningHeader maxFlagColumnWidth descColumn helpOutputWidth (concatMap CommandUIOpt.optionFieldToGetOpt options) - in - ( "\n" - <> colorizeHeader (title <> ":") - <> "\n" - <> rows - , warnings - ) + in ( "\n" + <> colorizeHeader (title <> ":") + <> "\n" + <> rows + , warnings + ) + +buildOptionGroupSpecs :: [(String, BuildOptionField -> Bool)] +buildOptionGroupSpecs = + [ ("Unsupported options", keepUnsupportedOptions) + , ("Install layout options", keepInstallOptions) + , ("Irrelevant options", keepIrrelevantOptions) + , ("Haddock options", keepHaddockOptions) + , ("Test options", keepTestOptions) + , ("Benchmark options", keepBenchOptions) + , ("Profiling options", keepProfilingOptions) + , ("Dependency solving options", keepSolvingOptions) + , ("Executable build options", keepExeOptions) + , ("Library build options", keepLibOptions) + , ("Coverage options", keepCoverageOptions) + , ("Output and artifact options", keepOutputOptions) + , ("Configure-phase options", keepConfigureOptions) + , ("Build phase control options", keepPhaseOptions) + , ("Compiler and parallelism options", keepCompilerOptions) + , ("Logging and reporting options", keepLoggingOptions) + , ("Include and linker path options", keepIncludeOptions) + , ("Program override options", keepProgOptions) + ] buildOptionGroups :: [(String, [BuildOptionField])] buildOptionGroups = - [ ("Unsupported options", unsupported) - , ("Install layout options", install) - , ("Irrelevant options", irrelevant) - , ("Haddock options", haddock) - , ("Test options", test) - , ("Benchmark options", bench) - , ("Profiling options", profiling) - , ("Dependency solving options", solving) - , ("Executable build options", exe) - , ("Library build options", lib) - , ("Coverage options", coverage) - , ("Output and artifact options", output) - , ("Configure-phase options", configure) - , ("Build phase control options", phase) - , ("Compiler and parallelism options", compiler) - , ("Logging and reporting options", logging) - , ("Include and linker path options", includePaths) - , ("Program override options", prog) - ] - where - opts0 = commandOptions buildCommand ShowArgs - - (unsupported, opts1) = partition keepUnsupportedOptions opts0 - (install, opts2) = partition keepInstallOptions opts1 - (irrelevant, opts3) = partition keepIrrelevantOptions opts2 - (haddock, opts4) = partition keepHaddockOptions opts3 - (test, opts5) = partition keepTestOptions opts4 - (bench, opts6) = partition keepBenchOptions opts5 - (profiling, opts7) = partition keepProfilingOptions opts6 - (solving, opts8) = partition keepSolvingOptions opts7 - (exe, opts9) = partition keepExeOptions opts8 - (lib, opts10) = partition keepLibOptions opts9 - (coverage, opts11) = partition keepCoverageOptions opts10 - (output, opts12) = partition keepOutputOptions opts11 - (configure, opts13) = partition keepConfigureOptions opts12 - (phase, opts14) = partition keepPhaseOptions opts13 - (compiler, opts15) = partition keepCompilerOptions opts14 - (logging, opts16) = partition keepLoggingOptions opts15 - (includePaths, opts17) = partition keepIncludeOptions opts16 - (prog, _opts18) = partition keepProgOptions opts17 + fst $ CommandUIOpt.groupSequentially (commandOptions buildCommand ShowArgs) buildOptionGroupSpecs buildUngroupedOptions :: [BuildOptionField] buildUngroupedOptions = - opts18 - where - opts0 = commandOptions buildCommand ShowArgs - (_, opts1) = partition keepUnsupportedOptions opts0 - (_, opts2) = partition keepInstallOptions opts1 - (_, opts3) = partition keepIrrelevantOptions opts2 - (_, opts4) = partition keepHaddockOptions opts3 - (_, opts5) = partition keepTestOptions opts4 - (_, opts6) = partition keepBenchOptions opts5 - (_, opts7) = partition keepProfilingOptions opts6 - (_, opts8) = partition keepSolvingOptions opts7 - (_, opts9) = partition keepExeOptions opts8 - (_, opts10) = partition keepLibOptions opts9 - (_, opts11) = partition keepCoverageOptions opts10 - (_, opts12) = partition keepOutputOptions opts11 - (_, opts13) = partition keepConfigureOptions opts12 - (_, opts14) = partition keepPhaseOptions opts13 - (_, opts15) = partition keepCompilerOptions opts14 - (_, opts16) = partition keepLoggingOptions opts15 - (_, opts17) = partition keepIncludeOptions opts16 - (_, opts18) = partition keepProgOptions opts17 - - + snd $ CommandUIOpt.groupSequentially (commandOptions buildCommand ShowArgs) buildOptionGroupSpecs replaceBuildAlias :: String -> String -> String replaceBuildAlias invokedName = T.unpack . T.replace (T.pack "v2-build") (T.pack invokedName) . T.pack @@ -521,9 +482,9 @@ buildItemParser = O.asum ( buildOptionParsers ++ [ BuildItemListOptions - <$ O.flag' - () - (O.long "list-options" <> O.help "Print a list of command line flags") + <$ O.flag' + () + (O.long "list-options" <> O.help "Print a list of command line flags") , BuildItemTarget <$> O.strArgument (O.metavar "TARGET") ] ) diff --git a/cabal-install/src/Distribution/Client/CommandUIOptParse.hs b/cabal-install/src/Distribution/Client/CommandUIOptParse.hs index d4ebd62ca91..e2804f5d198 100644 --- a/cabal-install/src/Distribution/Client/CommandUIOptParse.hs +++ b/cabal-install/src/Distribution/Client/CommandUIOptParse.hs @@ -18,12 +18,15 @@ module Distribution.Client.CommandUIOptParse , wrapDescription , capitalizeDescription + -- * Option grouping helpers + , groupSequentially ) where import Distribution.Client.Compat.Prelude import Prelude () import Data.Char (isLower) +import Data.List (mapAccumL) import Data.Monoid (Endo (..)) import qualified System.Console.GetOpt as GetOpt @@ -59,7 +62,7 @@ optDescrParser = \case ] ChoiceOpt choices -> [ Endo setFn - <$ O.flag' () (flagMods optFlags <> O.help desc) + <$ O.flag' () (flagMods optFlags <> O.help desc) | (desc, optFlags, setFn, _get) <- choices ] BoolOpt desc trueFlags falseFlags setFn _get -> @@ -219,4 +222,10 @@ getOptToColumns (GetOpt.Option shortFlags longFlags argDescr description) = GetOpt.ReqArg _ metaVar -> "--" <> longFlag <> "=" <> metaVar GetOpt.OptArg _ metaVar -> "--" <> longFlag <> "[=" <> metaVar <> "]" - +groupSequentially :: [a] -> [(groupName, a -> Bool)] -> ([(groupName, [a])], [a]) +groupSequentially options groupingSpecs = + let step remaining (groupName, keepPred) = + let (groupMembers, leftovers) = partition keepPred remaining + in (leftovers, (groupName, groupMembers)) + (leftoverOptions, groupedBuckets) = mapAccumL step options groupingSpecs + in (groupedBuckets, leftoverOptions) From 06a59954d205186ec8420bc5df4c1bb4eaec033a Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 5 Aug 2026 09:56:10 -0400 Subject: [PATCH 23/85] Add groupPredicates --- .../src/Distribution/Client/CmdBuild.hs | 44 +------------------ .../Distribution/Client/CommandUIOptParse.hs | 43 ++++++++++++++++++ 2 files changed, 45 insertions(+), 42 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 33ee0bf264c..975d5b786bd 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -35,24 +35,6 @@ import Distribution.Client.NixStyleOptions ( NixStyleFlags (..) , cfgVerbosity , defaultNixStyleFlags - , keepBenchOptions - , keepCompilerOptions - , keepConfigureOptions - , keepCoverageOptions - , keepExeOptions - , keepHaddockOptions - , keepIncludeOptions - , keepInstallOptions - , keepIrrelevantOptions - , keepLibOptions - , keepLoggingOptions - , keepOutputOptions - , keepPhaseOptions - , keepProfilingOptions - , keepProgOptions - , keepSolvingOptions - , keepTestOptions - , keepUnsupportedOptions , nixStyleOptions ) import Distribution.Client.ScriptUtils @@ -356,35 +338,13 @@ buildHelpText invokedName pname = , warnings ) -buildOptionGroupSpecs :: [(String, BuildOptionField -> Bool)] -buildOptionGroupSpecs = - [ ("Unsupported options", keepUnsupportedOptions) - , ("Install layout options", keepInstallOptions) - , ("Irrelevant options", keepIrrelevantOptions) - , ("Haddock options", keepHaddockOptions) - , ("Test options", keepTestOptions) - , ("Benchmark options", keepBenchOptions) - , ("Profiling options", keepProfilingOptions) - , ("Dependency solving options", keepSolvingOptions) - , ("Executable build options", keepExeOptions) - , ("Library build options", keepLibOptions) - , ("Coverage options", keepCoverageOptions) - , ("Output and artifact options", keepOutputOptions) - , ("Configure-phase options", keepConfigureOptions) - , ("Build phase control options", keepPhaseOptions) - , ("Compiler and parallelism options", keepCompilerOptions) - , ("Logging and reporting options", keepLoggingOptions) - , ("Include and linker path options", keepIncludeOptions) - , ("Program override options", keepProgOptions) - ] - buildOptionGroups :: [(String, [BuildOptionField])] buildOptionGroups = - fst $ CommandUIOpt.groupSequentially (commandOptions buildCommand ShowArgs) buildOptionGroupSpecs + fst $ CommandUIOpt.groupSequentially (commandOptions buildCommand ShowArgs) CommandUIOpt.groupPredicates buildUngroupedOptions :: [BuildOptionField] buildUngroupedOptions = - snd $ CommandUIOpt.groupSequentially (commandOptions buildCommand ShowArgs) buildOptionGroupSpecs + snd $ CommandUIOpt.groupSequentially (commandOptions buildCommand ShowArgs) CommandUIOpt.groupPredicates replaceBuildAlias :: String -> String -> String replaceBuildAlias invokedName = T.unpack . T.replace (T.pack "v2-build") (T.pack invokedName) . T.pack diff --git a/cabal-install/src/Distribution/Client/CommandUIOptParse.hs b/cabal-install/src/Distribution/Client/CommandUIOptParse.hs index e2804f5d198..5a879ee6b1a 100644 --- a/cabal-install/src/Distribution/Client/CommandUIOptParse.hs +++ b/cabal-install/src/Distribution/Client/CommandUIOptParse.hs @@ -19,6 +19,7 @@ module Distribution.Client.CommandUIOptParse , capitalizeDescription -- * Option grouping helpers + , groupPredicates , groupSequentially ) where @@ -35,6 +36,26 @@ import Distribution.Simple.Command ( OptDescr (..) , OptionField (..) ) +import Distribution.Client.NixStyleOptions + ( keepBenchOptions + , keepCompilerOptions + , keepConfigureOptions + , keepCoverageOptions + , keepExeOptions + , keepHaddockOptions + , keepIncludeOptions + , keepInstallOptions + , keepIrrelevantOptions + , keepLibOptions + , keepLoggingOptions + , keepOutputOptions + , keepPhaseOptions + , keepProfilingOptions + , keepProgOptions + , keepSolvingOptions + , keepTestOptions + , keepUnsupportedOptions + ) import qualified Options.Applicative as O @@ -229,3 +250,25 @@ groupSequentially options groupingSpecs = in (leftovers, (groupName, groupMembers)) (leftoverOptions, groupedBuckets) = mapAccumL step options groupingSpecs in (groupedBuckets, leftoverOptions) + +groupPredicates :: [(String, OptionField a -> Bool)] +groupPredicates = + [ ("Unsupported options", keepUnsupportedOptions) + , ("Install layout options", keepInstallOptions) + , ("Irrelevant options", keepIrrelevantOptions) + , ("Haddock options", keepHaddockOptions) + , ("Test options", keepTestOptions) + , ("Benchmark options", keepBenchOptions) + , ("Profiling options", keepProfilingOptions) + , ("Dependency solving options", keepSolvingOptions) + , ("Executable build options", keepExeOptions) + , ("Library build options", keepLibOptions) + , ("Coverage options", keepCoverageOptions) + , ("Output and artifact options", keepOutputOptions) + , ("Configure-phase options", keepConfigureOptions) + , ("Build phase control options", keepPhaseOptions) + , ("Compiler and parallelism options", keepCompilerOptions) + , ("Logging and reporting options", keepLoggingOptions) + , ("Include and linker path options", keepIncludeOptions) + , ("Program override options", keepProgOptions) + ] From 09034ab390ac608d29be69369e050ef66f2393a4 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 5 Aug 2026 10:06:31 -0400 Subject: [PATCH 24/85] Calculate (optsGrouped, optsUngrouped) once --- .../src/Distribution/Client/CmdBuild.hs | 22 +++++++++---------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 975d5b786bd..b4dabed00c1 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -300,17 +300,22 @@ buildHelpText invokedName pname = : map (length . fst . CommandUIOpt.getOptToColumns) ( commonHelpOptions - ++ concatMap CommandUIOpt.optionFieldToGetOpt buildUngroupedOptions - ++ concatMap (concatMap CommandUIOpt.optionFieldToGetOpt . snd) buildOptionGroups + ++ concatMap CommandUIOpt.optionFieldToGetOpt optsUngrouped + ++ concatMap (concatMap CommandUIOpt.optionFieldToGetOpt . snd) optsGrouped ) ) ) + 2 (ungroupedRows, ungroupedWarnings) = - CommandUIOpt.renderOptionRows colorizeWarningHeader maxFlagColumnWidth descColumn helpOutputWidth (commonHelpOptions ++ concatMap CommandUIOpt.optionFieldToGetOpt buildUngroupedOptions) + CommandUIOpt.renderOptionRows + colorizeWarningHeader + maxFlagColumnWidth + descColumn + helpOutputWidth + (commonHelpOptions ++ concatMap CommandUIOpt.optionFieldToGetOpt optsUngrouped) - renderedGroups = map renderGroup buildOptionGroups + renderedGroups = map renderGroup optsGrouped groupedRows = concatMap fst renderedGroups @@ -338,13 +343,8 @@ buildHelpText invokedName pname = , warnings ) -buildOptionGroups :: [(String, [BuildOptionField])] -buildOptionGroups = - fst $ CommandUIOpt.groupSequentially (commandOptions buildCommand ShowArgs) CommandUIOpt.groupPredicates - -buildUngroupedOptions :: [BuildOptionField] -buildUngroupedOptions = - snd $ CommandUIOpt.groupSequentially (commandOptions buildCommand ShowArgs) CommandUIOpt.groupPredicates + (optsGrouped, optsUngrouped) = + CommandUIOpt.groupSequentially (commandOptions buildCommand ShowArgs) CommandUIOpt.groupPredicates replaceBuildAlias :: String -> String -> String replaceBuildAlias invokedName = T.unpack . T.replace (T.pack "v2-build") (T.pack invokedName) . T.pack From 403e482589530baa1052217e78eeadf643af6f33 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 5 Aug 2026 10:08:47 -0400 Subject: [PATCH 25/85] Add allOptions --- cabal-install/src/Distribution/Client/CmdBuild.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index b4dabed00c1..df8b8340227 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -291,6 +291,12 @@ buildHelpText invokedName pname = helpOutputWidth :: Int helpOutputWidth = 100 + allOptions :: [GetOpt.OptDescr ()] + allOptions = + commonHelpOptions + ++ concatMap CommandUIOpt.optionFieldToGetOpt optsUngrouped + ++ concatMap (concatMap CommandUIOpt.optionFieldToGetOpt . snd) optsGrouped + descColumn :: Int descColumn = min @@ -299,10 +305,7 @@ buildHelpText invokedName pname = ( 0 : map (length . fst . CommandUIOpt.getOptToColumns) - ( commonHelpOptions - ++ concatMap CommandUIOpt.optionFieldToGetOpt optsUngrouped - ++ concatMap (concatMap CommandUIOpt.optionFieldToGetOpt . snd) optsGrouped - ) + allOptions ) ) + 2 From b9e72f052068979b3d2e983a843b5ec122334784 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 5 Aug 2026 10:15:18 -0400 Subject: [PATCH 26/85] Styling only --- cabal-install/src/Distribution/Client/CmdBuild.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index df8b8340227..c89cb9b0fa5 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -338,7 +338,12 @@ buildHelpText invokedName pname = | null options = ("", []) | otherwise = let (rows, warnings) = - CommandUIOpt.renderOptionRows colorizeWarningHeader maxFlagColumnWidth descColumn helpOutputWidth (concatMap CommandUIOpt.optionFieldToGetOpt options) + CommandUIOpt.renderOptionRows + colorizeWarningHeader + maxFlagColumnWidth + descColumn + helpOutputWidth + (concatMap CommandUIOpt.optionFieldToGetOpt options) in ( "\n" <> colorizeHeader (title <> ":") <> "\n" From 16b2d007ac482cc806a0572078753aa20e2d416e Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 5 Aug 2026 10:31:17 -0400 Subject: [PATCH 27/85] Move helpText to CommandUIOptParse --- .../src/Distribution/Client/CmdBuild.hs | 122 +----------------- .../Distribution/Client/CommandUIOptParse.hs | 106 +++++++++++++++ 2 files changed, 111 insertions(+), 117 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index c89cb9b0fa5..3533968ff80 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -43,29 +43,18 @@ import Distribution.Client.ScriptUtils , updateContextAndWriteProjectFile , withContextAndSelectors ) -import Distribution.Client.Setup - ( GlobalFlags - , yesNoOpt - ) +import Distribution.Client.Setup (GlobalFlags, yesNoOpt) import Distribution.Simple.Command ( CommandParse (..) , CommandUI (..) - , OptionField - , ShowOrParseArgs (ParseArgs, ShowArgs) + , ShowOrParseArgs (ParseArgs) , commandParseArgs , option , usageAlternatives ) import Distribution.Simple.Flag (Flag, fromFlag, toFlag) -import Distribution.Simple.Utils - ( dieWithException - , wrapText - ) -import Distribution.Verbosity - ( normal - ) -import qualified System.Console.GetOpt as GetOpt - +import Distribution.Simple.Utils (dieWithException, wrapText) +import Distribution.Verbosity (normal) import qualified Options.Applicative as O buildCommand :: CommandUI (NixStyleFlags BuildFlags) @@ -265,110 +254,9 @@ buildListOptions = CommandList opts -> opts _ -> [] -type BuildOptionField = OptionField (NixStyleFlags BuildFlags) - -buildHelpText :: String -> String -> String -buildHelpText invokedName pname = - commandSynopsis buildCommand - <> "\n\n" - <> colorizeUsageHeader (replaceBuildAlias invokedName (commandUsage buildCommand pname)) - <> maybe "" (('\n' :) . ($ pname)) (commandDescription buildCommand) - <> "\n" - <> colorizeHeader "Flags for build:" - <> "\n" - <> ungroupedRows - <> groupedRows - <> warningSection - <> maybe "" (('\n' :) . colorizeExamplesHeader . replaceBuildAlias invokedName . ($ pname)) (commandNotes buildCommand) - where - commonHelpOptions :: [GetOpt.OptDescr ()] - commonHelpOptions = - [GetOpt.Option ['h'] ["help"] (GetOpt.NoArg ()) "Show this help text"] - - maxFlagColumnWidth :: Int - maxFlagColumnWidth = 30 - - helpOutputWidth :: Int - helpOutputWidth = 100 - - allOptions :: [GetOpt.OptDescr ()] - allOptions = - commonHelpOptions - ++ concatMap CommandUIOpt.optionFieldToGetOpt optsUngrouped - ++ concatMap (concatMap CommandUIOpt.optionFieldToGetOpt . snd) optsGrouped - - descColumn :: Int - descColumn = - min - maxFlagColumnWidth - ( maximum - ( 0 - : map - (length . fst . CommandUIOpt.getOptToColumns) - allOptions - ) - ) - + 2 - - (ungroupedRows, ungroupedWarnings) = - CommandUIOpt.renderOptionRows - colorizeWarningHeader - maxFlagColumnWidth - descColumn - helpOutputWidth - (commonHelpOptions ++ concatMap CommandUIOpt.optionFieldToGetOpt optsUngrouped) - - renderedGroups = map renderGroup optsGrouped - - groupedRows = concatMap fst renderedGroups - - groupedWarnings = concatMap snd renderedGroups - - warningSection = - case ungroupedWarnings ++ groupedWarnings of - [] -> "" - warnings -> - "\n" - <> colorizeWarningHeader "Warnings:" - <> "\n" - <> concat [" - " <> warning <> "\n" | warning <- warnings] - - renderGroup :: (String, [BuildOptionField]) -> (String, [String]) - renderGroup (title, options) - | null options = ("", []) - | otherwise = - let (rows, warnings) = - CommandUIOpt.renderOptionRows - colorizeWarningHeader - maxFlagColumnWidth - descColumn - helpOutputWidth - (concatMap CommandUIOpt.optionFieldToGetOpt options) - in ( "\n" - <> colorizeHeader (title <> ":") - <> "\n" - <> rows - , warnings - ) - - (optsGrouped, optsUngrouped) = - CommandUIOpt.groupSequentially (commandOptions buildCommand ShowArgs) CommandUIOpt.groupPredicates - replaceBuildAlias :: String -> String -> String replaceBuildAlias invokedName = T.unpack . T.replace (T.pack "v2-build") (T.pack invokedName) . T.pack -colorizeHeader :: String -> String -colorizeHeader text = "\ESC[32m" <> text <> "\ESC[0m" - -colorizeWarningHeader :: String -> String -colorizeWarningHeader text = "\ESC[31m" <> text <> "\ESC[0m" - -colorizeUsageHeader :: String -> String -colorizeUsageHeader = T.unpack . T.replace (T.pack "Usage:") (T.pack $ colorizeHeader "Usage:") . T.pack - -colorizeExamplesHeader :: String -> String -colorizeExamplesHeader = T.unpack . T.replace (T.pack "Examples:") (T.pack $ colorizeHeader "Examples:") . T.pack - parseBuildCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) parseBuildCommand invokedName cmdArgs = case O.execParserPure O.defaultPrefs (buildParserInfo invokedName) cmdArgs of @@ -381,7 +269,7 @@ parseBuildCommand invokedName cmdArgs = O.Failure failure -> let (msg, exitCode) = O.renderFailure failure ("cabal " ++ invokedName) in if exitCode == ExitSuccess - then CommandHelp (buildHelpText invokedName) + then CommandHelp (CommandUIOpt.helpText replaceBuildAlias buildCommand invokedName) else CommandErrors [msg] O.CompletionInvoked _ -> CommandErrors ["Shell completion is not supported by this parser path."] diff --git a/cabal-install/src/Distribution/Client/CommandUIOptParse.hs b/cabal-install/src/Distribution/Client/CommandUIOptParse.hs index 5a879ee6b1a..29c0fd96db5 100644 --- a/cabal-install/src/Distribution/Client/CommandUIOptParse.hs +++ b/cabal-install/src/Distribution/Client/CommandUIOptParse.hs @@ -17,6 +17,7 @@ module Distribution.Client.CommandUIOptParse , getOptToColumns , wrapDescription , capitalizeDescription + , helpText -- * Option grouping helpers , groupPredicates @@ -26,6 +27,7 @@ module Distribution.Client.CommandUIOptParse import Distribution.Client.Compat.Prelude import Prelude () +import qualified Data.Text as T import Data.Char (isLower) import Data.List (mapAccumL) import Data.Monoid (Endo (..)) @@ -35,6 +37,8 @@ import Distribution.ReadE (runReadE) import Distribution.Simple.Command ( OptDescr (..) , OptionField (..) + , ShowOrParseArgs (ShowArgs) + , CommandUI (..) ) import Distribution.Client.NixStyleOptions ( keepBenchOptions @@ -55,6 +59,7 @@ import Distribution.Client.NixStyleOptions , keepSolvingOptions , keepTestOptions , keepUnsupportedOptions + , NixStyleFlags(..) ) import qualified Options.Applicative as O @@ -272,3 +277,104 @@ groupPredicates = , ("Include and linker path options", keepIncludeOptions) , ("Program override options", keepProgOptions) ] + +type ReplaceCommandAlias = String -> String -> String + +helpText :: ReplaceCommandAlias -> CommandUI (NixStyleFlags a) -> String -> String -> String +helpText replaceBuildAlias buildCommand invokedName pname = + commandSynopsis buildCommand + <> "\n\n" + <> colorizeUsageHeader (replaceBuildAlias invokedName (commandUsage buildCommand pname)) + <> maybe "" (('\n' :) . ($ pname)) (commandDescription buildCommand) + <> "\n" + <> colorizeHeader "Flags for build:" + <> "\n" + <> ungroupedRows + <> groupedRows + <> warningSection + <> maybe "" (('\n' :) . colorizeExamplesHeader . replaceBuildAlias invokedName . ($ pname)) (commandNotes buildCommand) + where + commonHelpOptions :: [GetOpt.OptDescr ()] + commonHelpOptions = + [GetOpt.Option ['h'] ["help"] (GetOpt.NoArg ()) "Show this help text"] + + maxFlagColumnWidth :: Int + maxFlagColumnWidth = 30 + + helpOutputWidth :: Int + helpOutputWidth = 100 + + allOptions :: [GetOpt.OptDescr ()] + allOptions = + commonHelpOptions + ++ concatMap optionFieldToGetOpt optsUngrouped + ++ concatMap (concatMap optionFieldToGetOpt . snd) optsGrouped + + descColumn :: Int + descColumn = + min + maxFlagColumnWidth + ( maximum + ( 0 + : map + (length . fst . getOptToColumns) + allOptions + ) + ) + + 2 + + (ungroupedRows, ungroupedWarnings) = + renderOptionRows + colorizeWarningHeader + maxFlagColumnWidth + descColumn + helpOutputWidth + (commonHelpOptions ++ concatMap optionFieldToGetOpt optsUngrouped) + + renderedGroups = map renderGroup optsGrouped + + groupedRows = concatMap fst renderedGroups + + groupedWarnings = concatMap snd renderedGroups + + warningSection = + case ungroupedWarnings ++ groupedWarnings of + [] -> "" + warnings -> + "\n" + <> colorizeWarningHeader "Warnings:" + <> "\n" + <> concat [" - " <> warning <> "\n" | warning <- warnings] + + renderGroup :: (String, [OptionField a]) -> (String, [String]) + renderGroup (title, options) + | null options = ("", []) + | otherwise = + let (rows, warnings) = + renderOptionRows + colorizeWarningHeader + maxFlagColumnWidth + descColumn + helpOutputWidth + (concatMap optionFieldToGetOpt options) + in ( "\n" + <> colorizeHeader (title <> ":") + <> "\n" + <> rows + , warnings + ) + + (optsGrouped, optsUngrouped) = + groupSequentially (commandOptions buildCommand ShowArgs) groupPredicates + +colorizeHeader :: String -> String +colorizeHeader text = "\ESC[32m" <> text <> "\ESC[0m" + +colorizeWarningHeader :: String -> String +colorizeWarningHeader text = "\ESC[31m" <> text <> "\ESC[0m" + +colorizeUsageHeader :: String -> String +colorizeUsageHeader = T.unpack . T.replace (T.pack "Usage:") (T.pack $ colorizeHeader "Usage:") . T.pack + +colorizeExamplesHeader :: String -> String +colorizeExamplesHeader = T.unpack . T.replace (T.pack "Examples:") (T.pack $ colorizeHeader "Examples:") . T.pack From adc84b6778d330500054e3c7f5aa924edc9e6517 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 5 Aug 2026 10:40:46 -0400 Subject: [PATCH 28/85] Move examples --- .../src/Distribution/Client/CmdBuild.hs | 34 +++++++++---------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 3533968ff80..699ac19c9f3 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -115,6 +115,22 @@ buildCommand = ) } +examples :: String -> String +examples invokedName = + unlines + [ "Examples:" + , " - " <> invokedName + , " Build the package in the current directory or all packages in the project" + , " - " <> invokedName <> " pkgname" + , " Build the package named pkgname in the project" + , " - " <> invokedName <> " ./pkgfoo" + , " Build the package in the ./pkgfoo directory" + , " - " <> invokedName <> " cname" + , " Build the component named cname in the project" + , " - " <> invokedName <> " cname --enable-profiling" + , " Build the component in profiling mode (including dependencies as needed)" + ] + data BuildFlags = BuildFlags { buildOnlyConfigure :: Flag Bool } @@ -281,7 +297,7 @@ buildParserInfo invokedName = ( O.fullDesc <> O.progDesc buildHelpDescription <> O.header ("cabal " ++ invokedName) - <> O.footer (buildExamplesSection invokedName) + <> O.footer (examples invokedName) ) buildHelpDescription :: String @@ -290,22 +306,6 @@ buildHelpDescription = Nothing -> commandSynopsis buildCommand Just mkDescription -> mkDescription "cabal" -buildExamplesSection :: String -> String -buildExamplesSection invokedName = - unlines - [ "Examples:" - , " - " <> invokedName - , " Build the package in the current directory or all packages in the project" - , " - " <> invokedName <> " pkgname" - , " Build the package named pkgname in the project" - , " - " <> invokedName <> " ./pkgfoo" - , " Build the package in the ./pkgfoo directory" - , " - " <> invokedName <> " cname" - , " Build the component named cname in the project" - , " - " <> invokedName <> " cname --enable-profiling" - , " Build the component in profiling mode (including dependencies as needed)" - ] - data ParsedBuildCommand = ParsedBuildCommand { parsedFlagEdits :: Endo (NixStyleFlags BuildFlags) , parsedTargets :: [String] From c4fec5dc60e71ab103cf5d1525454bb2a1d1f0c6 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 5 Aug 2026 10:47:02 -0400 Subject: [PATCH 29/85] Use the examples --- .../src/Distribution/Client/CmdBuild.hs | 25 +------------------ 1 file changed, 1 insertion(+), 24 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 699ac19c9f3..ed7050a3501 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -75,30 +75,7 @@ buildCommand = ++ "configuration flags can be specified on the command line and these " ++ "extend the project configuration from the 'cabal.project', " ++ "'cabal.project.local' and other files." - , commandNotes = Just $ \pname -> - "Examples:\n" - ++ " - " - ++ pname - ++ " v2-build\n" - ++ " Build the package in the current directory " - ++ "or all packages in the project\n" - ++ " - " - ++ pname - ++ " v2-build pkgname\n" - ++ " Build the package named pkgname in the project\n" - ++ " - " - ++ pname - ++ " v2-build ./pkgfoo\n" - ++ " Build the package in the ./pkgfoo directory\n" - ++ " - " - ++ pname - ++ " v2-build cname\n" - ++ " Build the component named cname in the project\n" - ++ " - " - ++ pname - ++ " v2-build cname --enable-profiling\n" - ++ " Build the component in profiling mode " - ++ "(including dependencies as needed)\n" + , commandNotes = Just examples , commandDefaultFlags = defaultNixStyleFlags defaultBuildFlags , commandOptions = removeIgnoreProjectOption From 2682cd6dac3faef196a28c945667e360e00c294a Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 5 Aug 2026 10:49:08 -0400 Subject: [PATCH 30/85] Separate description --- .../src/Distribution/Client/CmdBuild.hs | 26 ++++++++++--------- 1 file changed, 14 insertions(+), 12 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index ed7050a3501..bf3c4452891 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -63,18 +63,7 @@ buildCommand = { commandName = "v2-build" , commandSynopsis = "Compile targets within the project." , commandUsage = usageAlternatives "v2-build" ["[TARGETS] [FLAGS]"] - , commandDescription = Just $ \_ -> - wrapText $ - "Build one or more targets from within the project. The available " - ++ "targets are the packages in the project as well as individual " - ++ "components within those packages, including libraries, executables, " - ++ "test-suites or benchmarks. Targets can be specified by name or " - ++ "location. If no target is specified then the default is to build " - ++ "the package in the current directory.\n\n" - ++ "Dependencies are built or rebuilt as necessary. Additional " - ++ "configuration flags can be specified on the command line and these " - ++ "extend the project configuration from the 'cabal.project', " - ++ "'cabal.project.local' and other files." + , commandDescription = Just $ \_ -> wrapText description , commandNotes = Just examples , commandDefaultFlags = defaultNixStyleFlags defaultBuildFlags , commandOptions = @@ -92,6 +81,19 @@ buildCommand = ) } +description :: String +description = + "Build one or more targets from within the project. The available " + ++ "targets are the packages in the project as well as individual " + ++ "components within those packages, including libraries, executables, " + ++ "test-suites or benchmarks. Targets can be specified by name or " + ++ "location. If no target is specified then the default is to build " + ++ "the package in the current directory.\n\n" + ++ "Dependencies are built or rebuilt as necessary. Additional " + ++ "configuration flags can be specified on the command line and these " + ++ "extend the project configuration from the 'cabal.project', " + ++ "'cabal.project.local' and other files." + examples :: String -> String examples invokedName = unlines From 68bef0e59ba8a92f463eea1cbdda199c97aff97c Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 5 Aug 2026 10:55:13 -0400 Subject: [PATCH 31/85] Use fmap . fmap --- cabal-install/src/Distribution/Client/CmdBuild.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index bf3c4452891..c4cec93369d 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -326,4 +326,6 @@ buildItemParser = buildOptionParsers :: [O.Parser BuildItem] buildOptionParsers = - map (BuildItemFlag <$>) (CommandUIOpt.optionFieldFlagParsers (commandOptions buildCommand ParseArgs)) + (fmap . fmap) + BuildItemFlag + (CommandUIOpt.optionFieldFlagParsers $ commandOptions buildCommand ParseArgs) From c09ced83dec7c7a19b355932fbd6fd5727db7075 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 5 Aug 2026 11:42:54 -0400 Subject: [PATCH 32/85] Don't reference buildCommand --- cabal-install/src/Distribution/Client/CmdHaddockProject.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdHaddockProject.hs b/cabal-install/src/Distribution/Client/CmdHaddockProject.hs index 2b0caff2262..a828cef6f23 100644 --- a/cabal-install/src/Distribution/Client/CmdHaddockProject.hs +++ b/cabal-install/src/Distribution/Client/CmdHaddockProject.hs @@ -133,7 +133,7 @@ haddockProjectAction flags _extraArgs globalFlags = do verbosity RejectNoTargets Nothing - (commandDefaultFlags CmdBuild.buildCommand) + buildDefaultFlags ["all"] globalFlags HaddockCommand @@ -199,7 +199,7 @@ haddockProjectAction flags _extraArgs globalFlags = do when localStyle $ CmdBuild.buildAction - (commandDefaultFlags CmdBuild.buildCommand) + buildDefaultFlags ["all"] globalFlags @@ -362,6 +362,7 @@ haddockProjectAction flags _extraArgs globalFlags = do where -- build all packages with appropriate haddock flags commonFlags = haddockProjectCommonFlags flags + buildDefaultFlags = NixStyleOptions.defaultNixStyleFlags CmdBuild.defaultBuildFlags verbosity = mkVerbosity defaultVerbosityHandles $ @@ -413,7 +414,7 @@ haddockProjectAction flags _extraArgs globalFlags = do (commandDefaultFlags CmdHaddock.haddockCommand) { NixStyleOptions.haddockFlags = haddockFlags , NixStyleOptions.configFlags = - (NixStyleOptions.configFlags (commandDefaultFlags CmdBuild.buildCommand)) + (NixStyleOptions.configFlags buildDefaultFlags) { configCommonFlags = commonFlags } } From 31eff536e2177c7b39f1072ea137167933a824a8 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 5 Aug 2026 11:43:25 -0400 Subject: [PATCH 33/85] Add cmdSpec --- .../src/Distribution/Client/CmdBuild.hs | 33 ++++++++++++++++++- cabal-install/src/Distribution/Client/Main.hs | 2 +- 2 files changed, 33 insertions(+), 2 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index c4cec93369d..2eeef46026b 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -1,7 +1,10 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + -- | cabal-install CLI command: build module Distribution.Client.CmdBuild ( -- * The @build@ CLI and action - buildCommand + cmdSpec , buildAction , parseBuildCommand , isBuildCommandName @@ -47,7 +50,10 @@ import Distribution.Client.Setup (GlobalFlags, yesNoOpt) import Distribution.Simple.Command ( CommandParse (..) , CommandUI (..) + , CommandSpec (..) , ShowOrParseArgs (ParseArgs) + , CommandType (..) + , commandAddAction , commandParseArgs , option , usageAlternatives @@ -57,6 +63,31 @@ import Distribution.Simple.Utils (dieWithException, wrapText) import Distribution.Verbosity (normal) import qualified Options.Applicative as O +cmdSpec :: [CommandSpec (GlobalFlags -> IO ())] +cmdSpec = [cmd defaultUi, cmd newUi, cmd origUi] + where + origUi@CommandUI{..} = buildCommand + + cmd ui = CommandSpec ui (`commandAddAction` buildAction) NormalCommand + + newMsg = T.unpack . T.replace "v2-" "new-" . T.pack + newUi = + origUi + { commandName = newMsg commandName + , commandUsage = newMsg . commandUsage + , commandDescription = (newMsg .) <$> commandDescription + , commandNotes = (newMsg .) <$> commandNotes + } + + defaultMsg = T.unpack . T.replace "v2-" "" . T.pack + defaultUi = + origUi + { commandName = defaultMsg commandName + , commandUsage = defaultMsg . commandUsage + , commandDescription = (defaultMsg .) <$> commandDescription + , commandNotes = (defaultMsg .) <$> commandNotes + } + buildCommand :: CommandUI (NixStyleFlags BuildFlags) buildCommand = CommandUI diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index e6dcb6051a8..ca9ad97f991 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -497,7 +497,7 @@ mainWorker args = do ++ concat [ newCmd CmdConfigure.configureCommand CmdConfigure.configureAction , newCmd CmdUpdate.updateCommand CmdUpdate.updateAction - , newCmd CmdBuild.buildCommand CmdBuild.buildAction + , CmdBuild.cmdSpec , newCmd CmdRepl.replCommand CmdRepl.replAction , newCmd CmdFreeze.freezeCommand CmdFreeze.freezeAction , newCmd CmdHaddock.haddockCommand CmdHaddock.haddockAction From f15450de2cb544d23d4437662efb4f024b610a5c Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 5 Aug 2026 12:15:48 -0400 Subject: [PATCH 34/85] Follow hlint suggestion: use list comprehension --- cabal-install/src/Distribution/Client/CommandUIOptParse.hs | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CommandUIOptParse.hs b/cabal-install/src/Distribution/Client/CommandUIOptParse.hs index 29c0fd96db5..b739e97eacc 100644 --- a/cabal-install/src/Distribution/Client/CommandUIOptParse.hs +++ b/cabal-install/src/Distribution/Client/CommandUIOptParse.hs @@ -149,10 +149,7 @@ renderOptionRows colorizeWarning maxFlagColumnWidth descColumn helpOutputWidth o else wrappedDescription isStacked = length flagColumn > maxFlagColumnWidth spacer = if isStacked && not isFirstInGroup then "\n" else "" - warning = - if wasAutoCapitalized - then ["Auto-capitalized help text for " <> flagColumn] - else [] + warning = ["Auto-capitalized help text for " <> flagColumn | wasAutoCapitalized] renderedRow = spacer <> if isStacked From 2f4010a0985b9ff0ef2e7ebcb01420856689deb1 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 5 Aug 2026 12:29:31 -0400 Subject: [PATCH 35/85] Don't import Options.Applicative qualified --- .../src/Distribution/Client/CmdBuild.hs | 66 ++++++++++++------- 1 file changed, 43 insertions(+), 23 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 2eeef46026b..d37227540d8 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -49,10 +49,10 @@ import Distribution.Client.ScriptUtils import Distribution.Client.Setup (GlobalFlags, yesNoOpt) import Distribution.Simple.Command ( CommandParse (..) - , CommandUI (..) , CommandSpec (..) - , ShowOrParseArgs (ParseArgs) , CommandType (..) + , CommandUI (..) + , ShowOrParseArgs (ParseArgs) , commandAddAction , commandParseArgs , option @@ -61,7 +61,27 @@ import Distribution.Simple.Command import Distribution.Simple.Flag (Flag, fromFlag, toFlag) import Distribution.Simple.Utils (dieWithException, wrapText) import Distribution.Verbosity (normal) -import qualified Options.Applicative as O +import Options.Applicative + ( Parser + , ParserInfo + , ParserResult (..) + , asum + , defaultPrefs + , execParserPure + , flag' + , footer + , fullDesc + , header + , help + , helper + , info + , long + , metavar + , progDesc + , renderFailure + , strArgument + , (<**>) + ) cmdSpec :: [CommandSpec (GlobalFlags -> IO ())] cmdSpec = [cmd defaultUi, cmd newUi, cmd origUi] @@ -285,29 +305,29 @@ replaceBuildAlias invokedName = T.unpack . T.replace (T.pack "v2-build") (T.pack parseBuildCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) parseBuildCommand invokedName cmdArgs = - case O.execParserPure O.defaultPrefs (buildParserInfo invokedName) cmdArgs of - O.Success parsed -> + case execParserPure defaultPrefs (buildParserInfo invokedName) cmdArgs of + Success parsed -> if parsedListOptions parsed then CommandList buildListOptions else let flags = appEndo (parsedFlagEdits parsed) (commandDefaultFlags buildCommand) in CommandReadyToGo (buildAction flags (parsedTargets parsed)) - O.Failure failure -> - let (msg, exitCode) = O.renderFailure failure ("cabal " ++ invokedName) + Failure failure -> + let (msg, exitCode) = renderFailure failure ("cabal " ++ invokedName) in if exitCode == ExitSuccess then CommandHelp (CommandUIOpt.helpText replaceBuildAlias buildCommand invokedName) else CommandErrors [msg] - O.CompletionInvoked _ -> + CompletionInvoked _ -> CommandErrors ["Shell completion is not supported by this parser path."] -buildParserInfo :: String -> O.ParserInfo ParsedBuildCommand +buildParserInfo :: String -> ParserInfo ParsedBuildCommand buildParserInfo invokedName = - O.info - (parsedBuildCommandParser O.<**> O.helper) - ( O.fullDesc - <> O.progDesc buildHelpDescription - <> O.header ("cabal " ++ invokedName) - <> O.footer (examples invokedName) + info + (parsedBuildCommandParser <**> helper) + ( fullDesc + <> progDesc buildHelpDescription + <> header ("cabal " ++ invokedName) + <> footer (examples invokedName) ) buildHelpDescription :: String @@ -327,8 +347,8 @@ data BuildItem | BuildItemTarget String | BuildItemListOptions -parsedBuildCommandParser :: O.Parser ParsedBuildCommand -parsedBuildCommandParser = toParsed <$> O.many buildItemParser +parsedBuildCommandParser :: Parser ParsedBuildCommand +parsedBuildCommandParser = toParsed <$> many buildItemParser where toParsed items = let edits = [e | BuildItemFlag e <- items] @@ -343,19 +363,19 @@ parsedBuildCommandParser = toParsed <$> O.many buildItemParser isListOptions BuildItemListOptions = True isListOptions _ = False -buildItemParser :: O.Parser BuildItem +buildItemParser :: Parser BuildItem buildItemParser = - O.asum + asum ( buildOptionParsers ++ [ BuildItemListOptions - <$ O.flag' + <$ flag' () - (O.long "list-options" <> O.help "Print a list of command line flags") - , BuildItemTarget <$> O.strArgument (O.metavar "TARGET") + (long "list-options" <> help "Print a list of command line flags") + , BuildItemTarget <$> strArgument (metavar "TARGET") ] ) -buildOptionParsers :: [O.Parser BuildItem] +buildOptionParsers :: [Parser BuildItem] buildOptionParsers = (fmap . fmap) BuildItemFlag From e973dc8ce989a93146d960d185c3e6d454c077ce Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 5 Aug 2026 13:09:49 -0400 Subject: [PATCH 36/85] examples taking a program name --- .../src/Distribution/Client/CmdBuild.hs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index d37227540d8..ab9b45ead9e 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -115,7 +115,7 @@ buildCommand = , commandSynopsis = "Compile targets within the project." , commandUsage = usageAlternatives "v2-build" ["[TARGETS] [FLAGS]"] , commandDescription = Just $ \_ -> wrapText description - , commandNotes = Just examples + , commandNotes = Just $ \pname -> examples pname "v2-build" , commandDefaultFlags = defaultNixStyleFlags defaultBuildFlags , commandOptions = removeIgnoreProjectOption @@ -145,19 +145,19 @@ description = ++ "extend the project configuration from the 'cabal.project', " ++ "'cabal.project.local' and other files." -examples :: String -> String -examples invokedName = +examples :: String -> String -> String +examples pname invokedName = unlines [ "Examples:" - , " - " <> invokedName + , " - " <> pname <> " " <> invokedName , " Build the package in the current directory or all packages in the project" - , " - " <> invokedName <> " pkgname" + , " - " <> pname <> " " <> invokedName <> " pkgname" , " Build the package named pkgname in the project" - , " - " <> invokedName <> " ./pkgfoo" + , " - " <> pname <> " " <> invokedName <> " ./pkgfoo" , " Build the package in the ./pkgfoo directory" - , " - " <> invokedName <> " cname" + , " - " <> pname <> " " <> invokedName <> " cname" , " Build the component named cname in the project" - , " - " <> invokedName <> " cname --enable-profiling" + , " - " <> pname <> " " <> invokedName <> " cname --enable-profiling" , " Build the component in profiling mode (including dependencies as needed)" ] @@ -327,7 +327,7 @@ buildParserInfo invokedName = ( fullDesc <> progDesc buildHelpDescription <> header ("cabal " ++ invokedName) - <> footer (examples invokedName) + <> footer (examples "cabal" invokedName) ) buildHelpDescription :: String From 687a7fde06e7046de1387d8bc3a63179a7870321 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 5 Aug 2026 15:34:26 -0400 Subject: [PATCH 37/85] Simplify cmdSpec --- .../src/Distribution/Client/CmdBuild.hs | 21 +++++-------------- 1 file changed, 5 insertions(+), 16 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index ab9b45ead9e..2e295c1650c 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -84,24 +84,13 @@ import Options.Applicative ) cmdSpec :: [CommandSpec (GlobalFlags -> IO ())] -cmdSpec = [cmd defaultUi, cmd newUi, cmd origUi] +cmdSpec = [CommandSpec ui (`commandAddAction` buildAction) NormalCommand] where - origUi@CommandUI{..} = buildCommand - - cmd ui = CommandSpec ui (`commandAddAction` buildAction) NormalCommand - - newMsg = T.unpack . T.replace "v2-" "new-" . T.pack - newUi = - origUi - { commandName = newMsg commandName - , commandUsage = newMsg . commandUsage - , commandDescription = (newMsg .) <$> commandDescription - , commandNotes = (newMsg .) <$> commandNotes - } - defaultMsg = T.unpack . T.replace "v2-" "" . T.pack - defaultUi = - origUi + CommandUI{..} = buildCommand + + ui = + buildCommand { commandName = defaultMsg commandName , commandUsage = defaultMsg . commandUsage , commandDescription = (defaultMsg .) <$> commandDescription From 72b05c13948e04cdd14141ba30956f39c0e2506d Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 5 Aug 2026 21:01:47 -0400 Subject: [PATCH 38/85] Group --enable-* with --disable-* --- Cabal/src/Distribution/Simple/Command.hs | 31 ++++++++++++++----- .../Distribution/Client/CommandUIOptParse.hs | 17 ++++++++-- 2 files changed, 39 insertions(+), 9 deletions(-) diff --git a/Cabal/src/Distribution/Simple/Command.hs b/Cabal/src/Distribution/Simple/Command.hs index 937662b1d33..71742d1e509 100644 --- a/Cabal/src/Distribution/Simple/Command.hs +++ b/Cabal/src/Distribution/Simple/Command.hs @@ -350,10 +350,10 @@ commandGetOpts -> CommandUI flags -> [GetOpt.OptDescr (flags -> flags)] commandGetOpts showOrParse command = - concatMap viewAsGetOpt (commandOptions command showOrParse) + concatMap (viewAsGetOpt showOrParse) (commandOptions command showOrParse) -viewAsGetOpt :: OptionField a -> [GetOpt.OptDescr (a -> a)] -viewAsGetOpt (OptionField _n aa) = concatMap optDescrToGetOpt aa +viewAsGetOpt :: ShowOrParseArgs -> OptionField a -> [GetOpt.OptDescr (a -> a)] +viewAsGetOpt showOrParse (OptionField _n aa) = concatMap optDescrToGetOpt aa where optDescrToGetOpt (ReqArg d (cs, ss) arg_desc set _) = [GetOpt.Option cs ss (GetOpt.ReqArg (runReadE set) arg_desc) d] @@ -368,10 +368,27 @@ viewAsGetOpt (OptionField _n aa) = concatMap optDescrToGetOpt aa [GetOpt.Option sfT lfT (GetOpt.NoArg (set True)) d] optDescrToGetOpt (BoolOpt d ([], []) (sfF, lfF) set _) = [GetOpt.Option sfF lfF (GetOpt.NoArg (set False)) d] - optDescrToGetOpt (BoolOpt d (sfT, lfT) (sfF, lfF) set _) = - [ GetOpt.Option sfT lfT (GetOpt.NoArg (set True)) ("Enable " ++ d) - , GetOpt.Option sfF lfF (GetOpt.NoArg (set False)) ("Disable " ++ d) - ] + optDescrToGetOpt (BoolOpt d trueFlags@(sfT, lfT) falseFlags@(sfF, lfF) set _) = + case showOrParse of + ShowArgs + | Just groupedLongFlag <- mkGroupedBoolLongFlag trueFlags falseFlags -> + [ GetOpt.Option [] [groupedLongFlag] (GetOpt.NoArg (set True)) ("Enable or disable " ++ d) + ] + _ -> + [ GetOpt.Option sfT lfT (GetOpt.NoArg (set True)) ("Enable " ++ d) + , GetOpt.Option sfF lfF (GetOpt.NoArg (set False)) ("Disable " ++ d) + ] + + mkGroupedBoolLongFlag :: OptFlags -> OptFlags -> Maybe String + mkGroupedBoolLongFlag ([], [longA]) ([], [longB]) = + checkPair longA longB <|> checkPair longB longA + where + checkPair longEnable longDisable = do + suffixEnable <- List.stripPrefix "enable-" longEnable + suffixDisable <- List.stripPrefix "disable-" longDisable + guard (suffixEnable == suffixDisable) + pure ("[enable|disable]-" ++ suffixEnable) + mkGroupedBoolLongFlag _ _ = Nothing getCurrentChoice :: OptDescr a -> a -> [String] getCurrentChoice (ChoiceOpt alts) a = diff --git a/cabal-install/src/Distribution/Client/CommandUIOptParse.hs b/cabal-install/src/Distribution/Client/CommandUIOptParse.hs index b739e97eacc..07e05e1f076 100644 --- a/cabal-install/src/Distribution/Client/CommandUIOptParse.hs +++ b/cabal-install/src/Distribution/Client/CommandUIOptParse.hs @@ -29,7 +29,7 @@ import Prelude () import qualified Data.Text as T import Data.Char (isLower) -import Data.List (mapAccumL) +import Data.List (mapAccumL, stripPrefix) import Data.Monoid (Endo (..)) import qualified System.Console.GetOpt as GetOpt @@ -119,16 +119,29 @@ optDescrToGetOpt = \case [ GetOpt.Option shortFlags longFlags (GetOpt.NoArg ()) desc | (desc, (shortFlags, longFlags), _setFn, _getFn) <- choices ] - BoolOpt desc (shortTrue, longTrue) (shortFalse, longFalse) _setFn _getFn + BoolOpt desc trueFlags@(shortTrue, longTrue) falseFlags@(shortFalse, longFalse) _setFn _getFn | null shortFalse && null longFalse -> [GetOpt.Option shortTrue longTrue (GetOpt.NoArg ()) desc] | null shortTrue && null longTrue -> [GetOpt.Option shortFalse longFalse (GetOpt.NoArg ()) desc] + | Just groupedLongFlag <- mkGroupedBoolLongFlag trueFlags falseFlags -> + [GetOpt.Option [] [groupedLongFlag] (GetOpt.NoArg ()) ("Enable or disable " <> desc)] | otherwise -> [ GetOpt.Option shortTrue longTrue (GetOpt.NoArg ()) ("Enable " <> desc) , GetOpt.Option shortFalse longFalse (GetOpt.NoArg ()) ("Disable " <> desc) ] +mkGroupedBoolLongFlag :: (String, [String]) -> (String, [String]) -> Maybe String +mkGroupedBoolLongFlag ([], [longA]) ([], [longB]) = + checkPair longA longB <|> checkPair longB longA + where + checkPair longEnable longDisable = do + suffixEnable <- stripPrefix "enable-" longEnable + suffixDisable <- stripPrefix "disable-" longDisable + guard (suffixEnable == suffixDisable) + pure ("[enable|disable]-" <> suffixEnable) +mkGroupedBoolLongFlag _ _ = Nothing + renderOptionRows :: (String -> String) -> Int -> Int -> Int -> [GetOpt.OptDescr ()] -> (String, [String]) renderOptionRows colorizeWarning maxFlagColumnWidth descColumn helpOutputWidth options = let rendered = [renderOption (index == 0) opt | (index, opt) <- zip [0 :: Int ..] options] From 610941c5c84b4e4fd01267af2aaa20b8044700eb Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 5 Aug 2026 21:14:23 -0400 Subject: [PATCH 39/85] Use "Toggle" instead of "Enable or disable" --- Cabal/src/Distribution/Simple/Command.hs | 2 +- cabal-install/src/Distribution/Client/CommandUIOptParse.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Cabal/src/Distribution/Simple/Command.hs b/Cabal/src/Distribution/Simple/Command.hs index 71742d1e509..676b6f15b12 100644 --- a/Cabal/src/Distribution/Simple/Command.hs +++ b/Cabal/src/Distribution/Simple/Command.hs @@ -372,7 +372,7 @@ viewAsGetOpt showOrParse (OptionField _n aa) = concatMap optDescrToGetOpt aa case showOrParse of ShowArgs | Just groupedLongFlag <- mkGroupedBoolLongFlag trueFlags falseFlags -> - [ GetOpt.Option [] [groupedLongFlag] (GetOpt.NoArg (set True)) ("Enable or disable " ++ d) + [ GetOpt.Option [] [groupedLongFlag] (GetOpt.NoArg (set True)) ("Toggle " ++ d) ] _ -> [ GetOpt.Option sfT lfT (GetOpt.NoArg (set True)) ("Enable " ++ d) diff --git a/cabal-install/src/Distribution/Client/CommandUIOptParse.hs b/cabal-install/src/Distribution/Client/CommandUIOptParse.hs index 07e05e1f076..25f21d5b936 100644 --- a/cabal-install/src/Distribution/Client/CommandUIOptParse.hs +++ b/cabal-install/src/Distribution/Client/CommandUIOptParse.hs @@ -125,7 +125,7 @@ optDescrToGetOpt = \case | null shortTrue && null longTrue -> [GetOpt.Option shortFalse longFalse (GetOpt.NoArg ()) desc] | Just groupedLongFlag <- mkGroupedBoolLongFlag trueFlags falseFlags -> - [GetOpt.Option [] [groupedLongFlag] (GetOpt.NoArg ()) ("Enable or disable " <> desc)] + [GetOpt.Option [] [groupedLongFlag] (GetOpt.NoArg ()) ("Toggle " <> desc)] | otherwise -> [ GetOpt.Option shortTrue longTrue (GetOpt.NoArg ()) ("Enable " <> desc) , GetOpt.Option shortFalse longFalse (GetOpt.NoArg ()) ("Disable " <> desc) From 1b2291d1b9b7d2a30b3ae01237c1b5d631b08f7f Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 5 Aug 2026 21:29:54 -0400 Subject: [PATCH 40/85] Use optparse-applicative with CmdInstall --- .../src/Distribution/Client/CmdInstall.hs | 161 +++++++++++++++++- cabal-install/src/Distribution/Client/Main.hs | 11 +- 2 files changed, 166 insertions(+), 6 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index 1215af9fc7b..1e37dda63c6 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -5,8 +5,11 @@ -- | cabal-install CLI command: install module Distribution.Client.CmdInstall ( -- * The @install@ CLI and action - installCommand + cmdSpec + , installCommand , installAction + , parseInstallCommand + , isInstallCommandName -- * Internals exposed for testing , selectPackageTargets @@ -117,8 +120,15 @@ import Distribution.Package import Distribution.Simple.BuildPaths ( exeExtension ) +import qualified Distribution.Client.CommandUIOptParse as CommandUIOpt import Distribution.Simple.Command - ( CommandUI (..) + ( CommandParse (..) + , CommandSpec (..) + , CommandType (..) + , CommandUI (..) + , ShowOrParseArgs (ParseArgs) + , commandAddAction + , commandParseArgs , optionName , usageAlternatives ) @@ -219,6 +229,8 @@ import Distribution.Verbosity import qualified Data.ByteString.Lazy.Char8 as BS import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map +import Data.Monoid (Endo (..), appEndo) +import qualified Data.Text as T import Data.Ord ( Down (..) ) @@ -228,6 +240,27 @@ import Distribution.Utils.NubList ( fromNubList ) import Network.URI (URI) +import Options.Applicative + ( Parser + , ParserInfo + , ParserResult (..) + , asum + , defaultPrefs + , execParserPure + , flag' + , footer + , fullDesc + , header + , help + , helper + , info + , long + , metavar + , progDesc + , renderFailure + , strArgument + , (<**>) + ) import System.Directory ( copyFile , createDirectoryIfMissing @@ -285,6 +318,20 @@ data InstallExe = InstallExe -- store. } +cmdSpec :: [CommandSpec (GlobalFlags -> IO ())] +cmdSpec = [CommandSpec ui (`commandAddAction` installAction) NormalCommand] + where + defaultMsg = T.unpack . T.replace (T.pack "v2-") (T.pack "") . T.pack + CommandUI{..} = installCommand + + ui = + installCommand + { commandName = defaultMsg commandName + , commandUsage = defaultMsg . commandUsage + , commandDescription = (defaultMsg .) <$> commandDescription + , commandNotes = (defaultMsg .) <$> commandNotes + } + installCommand :: CommandUI (NixStyleFlags ClientInstallFlags) installCommand = CommandUI @@ -1389,3 +1436,113 @@ reportBuildTargetProblems verbosity problems = reportTargetProblems verbosity "b reportCannotPruneDependencies :: Verbosity -> CannotPruneDependencies -> IO a reportCannotPruneDependencies verbosity = dieWithException verbosity . SelectComponentTargetError . renderCannotPruneDependencies + +-- | The command name and aliases for the @install@ command. +-- +-- >>> installCommandNames +-- ["install","new-install","v2-install"] +installCommandNames :: [String] +installCommandNames = ["install", "new-install", commandName installCommand] + +isInstallCommandName :: String -> Bool +isInstallCommandName name = name `elem` installCommandNames + +installListOptions :: [String] +installListOptions = + case commandParseArgs installCommand False ["--list-options"] of + CommandList opts -> opts + _ -> [] + +replaceInstallAlias :: String -> String -> String +replaceInstallAlias invokedName = + T.unpack . T.replace (T.pack "v2-install") (T.pack invokedName) . T.pack + +parseInstallCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) +parseInstallCommand invokedName cmdArgs = + case execParserPure defaultPrefs (installParserInfo invokedName) cmdArgs of + Success parsed -> + if parsedListOptions parsed + then CommandList installListOptions + else + let flags = appEndo (parsedFlagEdits parsed) (commandDefaultFlags installCommand) + in CommandReadyToGo (installAction flags (parsedTargets parsed)) + Failure failure -> + let (msg, exitCode) = renderFailure failure ("cabal " ++ invokedName) + in if exitCode == ExitSuccess + then CommandHelp (CommandUIOpt.helpText replaceInstallAlias installCommand invokedName) + else CommandErrors [msg] + CompletionInvoked _ -> + CommandErrors ["Shell completion is not supported by this parser path."] + +installParserInfo :: String -> ParserInfo ParsedInstallCommand +installParserInfo invokedName = + info + (parsedInstallCommandParser <**> helper) + ( fullDesc + <> progDesc installHelpDescription + <> header ("cabal " ++ invokedName) + <> footer (installExamples invokedName) + ) + +installHelpDescription :: String +installHelpDescription = + case commandDescription installCommand of + Nothing -> commandSynopsis installCommand + Just mkDescription -> mkDescription "cabal" + +installExamples :: String -> String +installExamples invokedName = + unlines + [ "Examples:" + , " - cabal " <> invokedName + , " Install the package in the current directory" + , " - cabal " <> invokedName <> " pkgname" + , " Install the package named pkgname (fetching it from hackage if necessary)" + , " - cabal " <> invokedName <> " ./pkgfoo" + , " Install the package in the ./pkgfoo directory" + ] + +data ParsedInstallCommand = ParsedInstallCommand + { parsedFlagEdits :: Endo (NixStyleFlags ClientInstallFlags) + , parsedTargets :: [String] + , parsedListOptions :: Bool + } + +data InstallItem + = InstallItemFlag (Endo (NixStyleFlags ClientInstallFlags)) + | InstallItemTarget String + | InstallItemListOptions + +parsedInstallCommandParser :: Parser ParsedInstallCommand +parsedInstallCommandParser = toParsed <$> many installItemParser + where + toParsed items = + let edits = [e | InstallItemFlag e <- items] + targets = [t | InstallItemTarget t <- items] + listOptionsSeen = any isListOptions items + in ParsedInstallCommand + { parsedFlagEdits = mconcat edits + , parsedTargets = targets + , parsedListOptions = listOptionsSeen + } + + isListOptions InstallItemListOptions = True + isListOptions _ = False + +installItemParser :: Parser InstallItem +installItemParser = + asum + ( installOptionParsers + ++ [ InstallItemListOptions + <$ flag' + () + (long "list-options" <> help "Print a list of command line flags") + , InstallItemTarget <$> strArgument (metavar "TARGET") + ] + ) + +installOptionParsers :: [Parser InstallItem] +installOptionParsers = + (fmap . fmap) + InstallItemFlag + (CommandUIOpt.optionFieldFlagParsers $ commandOptions installCommand ParseArgs) diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index ca9ad97f991..efd338fcc98 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -379,12 +379,12 @@ mainWorker args = do where commandsRunBuildOptparseFirst :: [String] -> IO (CommandParse (GlobalFlags, CommandParse Action)) commandsRunBuildOptparseFirst argv = - case parseBuildWithOptparse argv of + case parseBuildOrInstallWithOptparse argv of Just parsed -> pure parsed Nothing -> commandsRunWithFallback globalCmd commands delegateToExternal argv - parseBuildWithOptparse :: [String] -> Maybe (CommandParse (GlobalFlags, CommandParse Action)) - parseBuildWithOptparse argv = + parseBuildOrInstallWithOptparse :: [String] -> Maybe (CommandParse (GlobalFlags, CommandParse Action)) + parseBuildOrInstallWithOptparse argv = case commandParseArgs globalCmd True argv of CommandReadyToGo (mkGlobalFlags, cmdArgs0) -> case cmdArgs0 of @@ -392,6 +392,9 @@ mainWorker args = do | CmdBuild.isBuildCommandName cmdName -> let globalFlags = mkGlobalFlags (commandDefaultFlags globalCmd) in Just $ CommandReadyToGo (globalFlags, CmdBuild.parseBuildCommand cmdName cmdArgs) + | CmdInstall.isInstallCommandName cmdName -> + let globalFlags = mkGlobalFlags (commandDefaultFlags globalCmd) + in Just $ CommandReadyToGo (globalFlags, CmdInstall.parseInstallCommand cmdName cmdArgs) _ -> Nothing _ -> Nothing @@ -504,7 +507,7 @@ mainWorker args = do , newCmd CmdHaddockProject.haddockProjectCommand CmdHaddockProject.haddockProjectAction - , newCmd CmdInstall.installCommand CmdInstall.installAction + , CmdInstall.cmdSpec , newCmd CmdRun.runCommand CmdRun.runAction , newCmd CmdTest.testCommand CmdTest.testAction , newCmd CmdBench.benchCommand CmdBench.benchAction From 566741b8261abaffbc9f6577da844b8b80515b94 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 6 Aug 2026 07:58:10 -0400 Subject: [PATCH 41/85] Add OptionGroupKey --- .../Distribution/Client/CommandUIOptParse.hs | 82 ++++++++++++++----- 1 file changed, 61 insertions(+), 21 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CommandUIOptParse.hs b/cabal-install/src/Distribution/Client/CommandUIOptParse.hs index 25f21d5b936..de0e3922f8a 100644 --- a/cabal-install/src/Distribution/Client/CommandUIOptParse.hs +++ b/cabal-install/src/Distribution/Client/CommandUIOptParse.hs @@ -266,26 +266,66 @@ groupSequentially options groupingSpecs = (leftoverOptions, groupedBuckets) = mapAccumL step options groupingSpecs in (groupedBuckets, leftoverOptions) -groupPredicates :: [(String, OptionField a -> Bool)] +data OptionGroupKey + = UnsupportedOptions + | InstallLayoutOptions + | IrrelevantOptions + | HaddockOptions + | TestOptions + | BenchmarkOptions + | ProfilingOptions + | DependencySolvingOptions + | ExecutableBuildOptions + | LibraryBuildOptions + | CoverageOptions + | OutputAndArtifactOptions + | ConfigurePhaseOptions + | BuildPhaseControlOptions + | CompilerAndParallelismOptions + | LoggingAndReportingOptions + | IncludeAndLinkerPathOptions + | ProgramOverrideOptions + +instance Show OptionGroupKey where + show UnsupportedOptions = "Unsupported options" + show InstallLayoutOptions = "Install layout options" + show IrrelevantOptions = "Irrelevant options" + show HaddockOptions = "Haddock options" + show TestOptions = "Test options" + show BenchmarkOptions = "Benchmark options" + show ProfilingOptions = "Profiling options" + show DependencySolvingOptions = "Dependency solving options" + show ExecutableBuildOptions = "Executable build options" + show LibraryBuildOptions = "Library build options" + show CoverageOptions = "Coverage options" + show OutputAndArtifactOptions = "Output and artifact options" + show ConfigurePhaseOptions = "Configure-phase options" + show BuildPhaseControlOptions = "Build phase control options" + show CompilerAndParallelismOptions = "Compiler and parallelism options" + show LoggingAndReportingOptions = "Logging and reporting options" + show IncludeAndLinkerPathOptions = "Include and linker path options" + show ProgramOverrideOptions = "Program override options" + +groupPredicates :: [(OptionGroupKey, OptionField a -> Bool)] groupPredicates = - [ ("Unsupported options", keepUnsupportedOptions) - , ("Install layout options", keepInstallOptions) - , ("Irrelevant options", keepIrrelevantOptions) - , ("Haddock options", keepHaddockOptions) - , ("Test options", keepTestOptions) - , ("Benchmark options", keepBenchOptions) - , ("Profiling options", keepProfilingOptions) - , ("Dependency solving options", keepSolvingOptions) - , ("Executable build options", keepExeOptions) - , ("Library build options", keepLibOptions) - , ("Coverage options", keepCoverageOptions) - , ("Output and artifact options", keepOutputOptions) - , ("Configure-phase options", keepConfigureOptions) - , ("Build phase control options", keepPhaseOptions) - , ("Compiler and parallelism options", keepCompilerOptions) - , ("Logging and reporting options", keepLoggingOptions) - , ("Include and linker path options", keepIncludeOptions) - , ("Program override options", keepProgOptions) + [ (UnsupportedOptions, keepUnsupportedOptions) + , (InstallLayoutOptions, keepInstallOptions) + , (IrrelevantOptions, keepIrrelevantOptions) + , (HaddockOptions, keepHaddockOptions) + , (TestOptions, keepTestOptions) + , (BenchmarkOptions, keepBenchOptions) + , (ProfilingOptions, keepProfilingOptions) + , (DependencySolvingOptions, keepSolvingOptions) + , (ExecutableBuildOptions, keepExeOptions) + , (LibraryBuildOptions, keepLibOptions) + , (CoverageOptions, keepCoverageOptions) + , (OutputAndArtifactOptions, keepOutputOptions) + , (ConfigurePhaseOptions, keepConfigureOptions) + , (BuildPhaseControlOptions, keepPhaseOptions) + , (CompilerAndParallelismOptions, keepCompilerOptions) + , (LoggingAndReportingOptions, keepLoggingOptions) + , (IncludeAndLinkerPathOptions, keepIncludeOptions) + , (ProgramOverrideOptions, keepProgOptions) ] type ReplaceCommandAlias = String -> String -> String @@ -356,7 +396,7 @@ helpText replaceBuildAlias buildCommand invokedName pname = <> "\n" <> concat [" - " <> warning <> "\n" | warning <- warnings] - renderGroup :: (String, [OptionField a]) -> (String, [String]) + renderGroup :: (OptionGroupKey, [OptionField a]) -> (String, [String]) renderGroup (title, options) | null options = ("", []) | otherwise = @@ -368,7 +408,7 @@ helpText replaceBuildAlias buildCommand invokedName pname = helpOutputWidth (concatMap optionFieldToGetOpt options) in ( "\n" - <> colorizeHeader (title <> ":") + <> colorizeHeader (show title <> ":") <> "\n" <> rows , warnings From 583a8c4c0a6fd440ea2e45f2ec3b7b8ce6e58af8 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 6 Aug 2026 08:27:28 -0400 Subject: [PATCH 42/85] Lambda lift renderGroup --- .../Distribution/Client/CommandUIOptParse.hs | 59 ++++++++++--------- 1 file changed, 30 insertions(+), 29 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CommandUIOptParse.hs b/cabal-install/src/Distribution/Client/CommandUIOptParse.hs index de0e3922f8a..6021eb41205 100644 --- a/cabal-install/src/Distribution/Client/CommandUIOptParse.hs +++ b/cabal-install/src/Distribution/Client/CommandUIOptParse.hs @@ -27,21 +27,15 @@ module Distribution.Client.CommandUIOptParse import Distribution.Client.Compat.Prelude import Prelude () -import qualified Data.Text as T import Data.Char (isLower) import Data.List (mapAccumL, stripPrefix) import Data.Monoid (Endo (..)) +import qualified Data.Text as T import qualified System.Console.GetOpt as GetOpt -import Distribution.ReadE (runReadE) -import Distribution.Simple.Command - ( OptDescr (..) - , OptionField (..) - , ShowOrParseArgs (ShowArgs) - , CommandUI (..) - ) import Distribution.Client.NixStyleOptions - ( keepBenchOptions + ( NixStyleFlags (..) + , keepBenchOptions , keepCompilerOptions , keepConfigureOptions , keepCoverageOptions @@ -59,7 +53,13 @@ import Distribution.Client.NixStyleOptions , keepSolvingOptions , keepTestOptions , keepUnsupportedOptions - , NixStyleFlags(..) + ) +import Distribution.ReadE (runReadE) +import Distribution.Simple.Command + ( CommandUI (..) + , OptDescr (..) + , OptionField (..) + , ShowOrParseArgs (ShowArgs) ) import qualified Options.Applicative as O @@ -381,7 +381,8 @@ helpText replaceBuildAlias buildCommand invokedName pname = helpOutputWidth (commonHelpOptions ++ concatMap optionFieldToGetOpt optsUngrouped) - renderedGroups = map renderGroup optsGrouped + renderGroupToWidth = renderGroup maxFlagColumnWidth descColumn helpOutputWidth + renderedGroups = map renderGroupToWidth optsGrouped groupedRows = concatMap fst renderedGroups @@ -396,27 +397,27 @@ helpText replaceBuildAlias buildCommand invokedName pname = <> "\n" <> concat [" - " <> warning <> "\n" | warning <- warnings] - renderGroup :: (OptionGroupKey, [OptionField a]) -> (String, [String]) - renderGroup (title, options) - | null options = ("", []) - | otherwise = - let (rows, warnings) = - renderOptionRows - colorizeWarningHeader - maxFlagColumnWidth - descColumn - helpOutputWidth - (concatMap optionFieldToGetOpt options) - in ( "\n" - <> colorizeHeader (show title <> ":") - <> "\n" - <> rows - , warnings - ) - (optsGrouped, optsUngrouped) = groupSequentially (commandOptions buildCommand ShowArgs) groupPredicates +renderGroup :: Int -> Int -> Int -> (OptionGroupKey, [OptionField a]) -> (String, [String]) +renderGroup maxFlagColumnWidth descColumn helpOutputWidth (title, options) + | null options = ("", []) + | otherwise = + let (rows, warnings) = + renderOptionRows + colorizeWarningHeader + maxFlagColumnWidth + descColumn + helpOutputWidth + (concatMap optionFieldToGetOpt options) + in ( "\n" + <> colorizeHeader (show title <> ":") + <> "\n" + <> rows + , warnings + ) + colorizeHeader :: String -> String colorizeHeader text = "\ESC[32m" <> text <> "\ESC[0m" From 7ecce5e786b8bcb35205c82a681de13e270bd625 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 6 Aug 2026 08:36:04 -0400 Subject: [PATCH 43/85] Render the install layout group compactly --- .../Distribution/Client/CommandUIOptParse.hs | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/cabal-install/src/Distribution/Client/CommandUIOptParse.hs b/cabal-install/src/Distribution/Client/CommandUIOptParse.hs index 6021eb41205..082910ff114 100644 --- a/cabal-install/src/Distribution/Client/CommandUIOptParse.hs +++ b/cabal-install/src/Distribution/Client/CommandUIOptParse.hs @@ -61,6 +61,7 @@ import Distribution.Simple.Command , OptionField (..) , ShowOrParseArgs (ShowArgs) ) +import Distribution.Simple.Utils (ordNub) import qualified Options.Applicative as O @@ -285,6 +286,7 @@ data OptionGroupKey | LoggingAndReportingOptions | IncludeAndLinkerPathOptions | ProgramOverrideOptions + deriving (Eq) instance Show OptionGroupKey where show UnsupportedOptions = "Unsupported options" @@ -403,6 +405,7 @@ helpText replaceBuildAlias buildCommand invokedName pname = renderGroup :: Int -> Int -> Int -> (OptionGroupKey, [OptionField a]) -> (String, [String]) renderGroup maxFlagColumnWidth descColumn helpOutputWidth (title, options) | null options = ("", []) + | title == InstallLayoutOptions = renderInstallLayoutGroupCompact helpOutputWidth options | otherwise = let (rows, warnings) = renderOptionRows @@ -418,6 +421,20 @@ renderGroup maxFlagColumnWidth descColumn helpOutputWidth (title, options) , warnings ) +renderInstallLayoutGroupCompact :: Int -> [OptionField a] -> (String, [String]) +renderInstallLayoutGroupCompact helpOutputWidth options = + ( "\n" + <> colorizeHeader (show InstallLayoutOptions <> ":") + <> "\n" + <> concat [" " <> line <> "\n" | line <- wrappedFlagLines] + , [] + ) + where + flagColumns = map (fst . getOptToColumns) (concatMap optionFieldToGetOpt options) + compactFlags = ordNub flagColumns + flagsLine = intercalate ", " compactFlags + wrappedFlagLines = wrapDescription (max 40 (helpOutputWidth - 2)) flagsLine + colorizeHeader :: String -> String colorizeHeader text = "\ESC[32m" <> text <> "\ESC[0m" From 759ad50440516a1c491c33c9b2d4dd6087280bd4 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 6 Aug 2026 12:00:13 -0400 Subject: [PATCH 44/85] Move module to Client.Cmd.UI --- cabal-install/cabal-install.cabal | 2 +- .../Distribution/Client/{CommandUIOptParse.hs => Cmd/UI.hs} | 2 +- cabal-install/src/Distribution/Client/CmdBuild.hs | 6 +++--- cabal-install/src/Distribution/Client/CmdInstall.hs | 6 +++--- 4 files changed, 8 insertions(+), 8 deletions(-) rename cabal-install/src/Distribution/Client/{CommandUIOptParse.hs => Cmd/UI.hs} (99%) diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 2190fbe696a..67c8bb76246 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -106,7 +106,7 @@ library Distribution.Client.CmdClean Distribution.Client.CmdConfigure Distribution.Client.CmdErrorMessages - Distribution.Client.CommandUIOptParse + Distribution.Client.Cmd.UI Distribution.Client.CmdExec Distribution.Client.CmdFreeze Distribution.Client.CmdHaddock diff --git a/cabal-install/src/Distribution/Client/CommandUIOptParse.hs b/cabal-install/src/Distribution/Client/Cmd/UI.hs similarity index 99% rename from cabal-install/src/Distribution/Client/CommandUIOptParse.hs rename to cabal-install/src/Distribution/Client/Cmd/UI.hs index 082910ff114..dcf4aac3e4c 100644 --- a/cabal-install/src/Distribution/Client/CommandUIOptParse.hs +++ b/cabal-install/src/Distribution/Client/Cmd/UI.hs @@ -1,6 +1,6 @@ {-# LANGUAGE LambdaCase #-} -module Distribution.Client.CommandUIOptParse +module Distribution.Client.Cmd.UI ( -- * Converting CommandUI options to optparse-applicative parsers optionFieldFlagParsers , optionFieldParser diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 2e295c1650c..acb4b6d373b 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -32,7 +32,7 @@ import Distribution.Client.TargetProblem import qualified Data.Map as Map import Data.Monoid (Endo (..), appEndo) import qualified Data.Text as T -import qualified Distribution.Client.CommandUIOptParse as CommandUIOpt +import Distribution.Client.Cmd.UI (optionFieldFlagParsers, helpText) import Distribution.Client.Errors import Distribution.Client.NixStyleOptions ( NixStyleFlags (..) @@ -304,7 +304,7 @@ parseBuildCommand invokedName cmdArgs = Failure failure -> let (msg, exitCode) = renderFailure failure ("cabal " ++ invokedName) in if exitCode == ExitSuccess - then CommandHelp (CommandUIOpt.helpText replaceBuildAlias buildCommand invokedName) + then CommandHelp (helpText replaceBuildAlias buildCommand invokedName) else CommandErrors [msg] CompletionInvoked _ -> CommandErrors ["Shell completion is not supported by this parser path."] @@ -368,4 +368,4 @@ buildOptionParsers :: [Parser BuildItem] buildOptionParsers = (fmap . fmap) BuildItemFlag - (CommandUIOpt.optionFieldFlagParsers $ commandOptions buildCommand ParseArgs) + (optionFieldFlagParsers $ commandOptions buildCommand ParseArgs) diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index 1e37dda63c6..6a47d50b508 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -120,7 +120,7 @@ import Distribution.Package import Distribution.Simple.BuildPaths ( exeExtension ) -import qualified Distribution.Client.CommandUIOptParse as CommandUIOpt +import Distribution.Client.Cmd.UI (optionFieldFlagParsers, helpText) import Distribution.Simple.Command ( CommandParse (..) , CommandSpec (..) @@ -1469,7 +1469,7 @@ parseInstallCommand invokedName cmdArgs = Failure failure -> let (msg, exitCode) = renderFailure failure ("cabal " ++ invokedName) in if exitCode == ExitSuccess - then CommandHelp (CommandUIOpt.helpText replaceInstallAlias installCommand invokedName) + then CommandHelp (helpText replaceInstallAlias installCommand invokedName) else CommandErrors [msg] CompletionInvoked _ -> CommandErrors ["Shell completion is not supported by this parser path."] @@ -1545,4 +1545,4 @@ installOptionParsers :: [Parser InstallItem] installOptionParsers = (fmap . fmap) InstallItemFlag - (CommandUIOpt.optionFieldFlagParsers $ commandOptions installCommand ParseArgs) + (optionFieldFlagParsers $ commandOptions installCommand ParseArgs) From 19395732b9b7bb467ed2f964b58754c2bfa2c664 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 6 Aug 2026 15:26:01 -0400 Subject: [PATCH 45/85] For test-show-details, list options --- Cabal/src/Distribution/Simple/Setup/Test.hs | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/Cabal/src/Distribution/Simple/Setup/Test.hs b/Cabal/src/Distribution/Simple/Setup/Test.hs index 5a1563f2b70..718cde13305 100644 --- a/Cabal/src/Distribution/Simple/Setup/Test.hs +++ b/Cabal/src/Distribution/Simple/Setup/Test.hs @@ -194,11 +194,14 @@ testOptions' showOrParseArgs = , option [] ["show-details"] - ( "'always': always show results of individual test cases. " - ++ "'never': never show results of individual test cases. " - ++ "'failures': show results of failing test cases. " - ++ "'streaming': show results of test cases in real time." - ++ "'direct': send results of test cases in real time; no log file." + ( unlines + [ "Allowed values:" + , "- always: always show results of individual test cases," + , "- never: never show results of individual test cases," + , "- failures: show results of failing test cases," + , "- streaming: show results of test cases in real time," + , "- direct: send results of test cases in real time; no log file." + ] ) testShowDetails (\v flags -> flags{testShowDetails = v}) From 2c3fc838800882b56910a246b5abb7d0e655ca64 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Fri, 7 Aug 2026 08:34:57 -0400 Subject: [PATCH 46/85] Add a deprecated group --- cabal-install/src/Distribution/Client/Cmd/UI.hs | 8 ++++++-- cabal-install/src/Distribution/Client/NixStyleOptions.hs | 4 ++++ 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/cabal-install/src/Distribution/Client/Cmd/UI.hs b/cabal-install/src/Distribution/Client/Cmd/UI.hs index dcf4aac3e4c..10fee70dac4 100644 --- a/cabal-install/src/Distribution/Client/Cmd/UI.hs +++ b/cabal-install/src/Distribution/Client/Cmd/UI.hs @@ -53,6 +53,7 @@ import Distribution.Client.NixStyleOptions , keepSolvingOptions , keepTestOptions , keepUnsupportedOptions + , keepDeprecatedOptions ) import Distribution.ReadE (runReadE) import Distribution.Simple.Command @@ -268,7 +269,8 @@ groupSequentially options groupingSpecs = in (groupedBuckets, leftoverOptions) data OptionGroupKey - = UnsupportedOptions + = DeprecatedOptions + | UnsupportedOptions | InstallLayoutOptions | IrrelevantOptions | HaddockOptions @@ -289,6 +291,7 @@ data OptionGroupKey deriving (Eq) instance Show OptionGroupKey where + show DeprecatedOptions = "Deprecated options" show UnsupportedOptions = "Unsupported options" show InstallLayoutOptions = "Install layout options" show IrrelevantOptions = "Irrelevant options" @@ -310,7 +313,8 @@ instance Show OptionGroupKey where groupPredicates :: [(OptionGroupKey, OptionField a -> Bool)] groupPredicates = - [ (UnsupportedOptions, keepUnsupportedOptions) + [ (DeprecatedOptions, keepDeprecatedOptions) + , (UnsupportedOptions, keepUnsupportedOptions) , (InstallLayoutOptions, keepInstallOptions) , (IrrelevantOptions, keepIrrelevantOptions) , (HaddockOptions, keepHaddockOptions) diff --git a/cabal-install/src/Distribution/Client/NixStyleOptions.hs b/cabal-install/src/Distribution/Client/NixStyleOptions.hs index 63ea3d6ded0..c6eda25bda8 100644 --- a/cabal-install/src/Distribution/Client/NixStyleOptions.hs +++ b/cabal-install/src/Distribution/Client/NixStyleOptions.hs @@ -12,6 +12,7 @@ module Distribution.Client.NixStyleOptions , cfgVerbosity -- * Option filtering/grouping predicates + , keepDeprecatedOptions , keepUnsupportedOptions , keepInstallOptions , keepIrrelevantOptions @@ -186,6 +187,9 @@ cfgVerbosity v flags = mkVerbosity defaultVerbosityHandles $ fromFlagOrDefault v (setupVerbosity . configCommonFlags $ configFlags flags) +keepDeprecatedOptions :: OptionField a -> Bool +keepDeprecatedOptions (optionName -> o) = "prefer-oldest" == o + keepUnsupportedOptions :: OptionField a -> Bool keepUnsupportedOptions (optionName -> o) = "root-cmd" == o || "allow-boot-library-installs" == o From 56cca343e963bb95631e5d2571626aea5e7a3ee7 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Mon, 10 Aug 2026 13:27:29 -0400 Subject: [PATCH 47/85] Generalise CmdItem --- .../src/Distribution/Client/Cmd/UI.hs | 10 +++++++- .../src/Distribution/Client/CmdBuild.hs | 23 ++++++++--------- .../src/Distribution/Client/CmdInstall.hs | 25 ++++++++----------- 3 files changed, 30 insertions(+), 28 deletions(-) diff --git a/cabal-install/src/Distribution/Client/Cmd/UI.hs b/cabal-install/src/Distribution/Client/Cmd/UI.hs index 10fee70dac4..7988fed7e66 100644 --- a/cabal-install/src/Distribution/Client/Cmd/UI.hs +++ b/cabal-install/src/Distribution/Client/Cmd/UI.hs @@ -12,6 +12,9 @@ module Distribution.Client.Cmd.UI , optionFieldToGetOpt , optDescrToGetOpt + -- * Command data types + , CmdItem (..) + -- * Help text layout helpers , renderOptionRows , getOptToColumns @@ -39,6 +42,7 @@ import Distribution.Client.NixStyleOptions , keepCompilerOptions , keepConfigureOptions , keepCoverageOptions + , keepDeprecatedOptions , keepExeOptions , keepHaddockOptions , keepIncludeOptions @@ -53,7 +57,6 @@ import Distribution.Client.NixStyleOptions , keepSolvingOptions , keepTestOptions , keepUnsupportedOptions - , keepDeprecatedOptions ) import Distribution.ReadE (runReadE) import Distribution.Simple.Command @@ -66,6 +69,11 @@ import Distribution.Simple.Utils (ordNub) import qualified Options.Applicative as O +data CmdItem a + = CmdItemFlag (Endo (NixStyleFlags a)) + | CmdItemTarget String + | CmdItemListOptions + optionFieldFlagParsers :: [OptionField flags] -> [O.Parser (Endo flags)] optionFieldFlagParsers = concatMap optionFieldParser diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index acb4b6d373b..d4599afb1ca 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -32,7 +32,7 @@ import Distribution.Client.TargetProblem import qualified Data.Map as Map import Data.Monoid (Endo (..), appEndo) import qualified Data.Text as T -import Distribution.Client.Cmd.UI (optionFieldFlagParsers, helpText) +import Distribution.Client.Cmd.UI (CmdItem (..), helpText, optionFieldFlagParsers) import Distribution.Client.Errors import Distribution.Client.NixStyleOptions ( NixStyleFlags (..) @@ -331,17 +331,14 @@ data ParsedBuildCommand = ParsedBuildCommand , parsedListOptions :: Bool } -data BuildItem - = BuildItemFlag (Endo (NixStyleFlags BuildFlags)) - | BuildItemTarget String - | BuildItemListOptions +type BuildCmdItem = CmdItem BuildFlags parsedBuildCommandParser :: Parser ParsedBuildCommand parsedBuildCommandParser = toParsed <$> many buildItemParser where toParsed items = - let edits = [e | BuildItemFlag e <- items] - targets = [t | BuildItemTarget t <- items] + let edits = [e | CmdItemFlag e <- items] + targets = [t | CmdItemTarget t <- items] listOptionsSeen = any isListOptions items in ParsedBuildCommand { parsedFlagEdits = mconcat edits @@ -349,23 +346,23 @@ parsedBuildCommandParser = toParsed <$> many buildItemParser , parsedListOptions = listOptionsSeen } - isListOptions BuildItemListOptions = True + isListOptions CmdItemListOptions = True isListOptions _ = False -buildItemParser :: Parser BuildItem +buildItemParser :: Parser BuildCmdItem buildItemParser = asum ( buildOptionParsers - ++ [ BuildItemListOptions + ++ [ CmdItemListOptions <$ flag' () (long "list-options" <> help "Print a list of command line flags") - , BuildItemTarget <$> strArgument (metavar "TARGET") + , CmdItemTarget <$> strArgument (metavar "TARGET") ] ) -buildOptionParsers :: [Parser BuildItem] +buildOptionParsers :: [Parser BuildCmdItem] buildOptionParsers = (fmap . fmap) - BuildItemFlag + CmdItemFlag (optionFieldFlagParsers $ commandOptions buildCommand ParseArgs) diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index 6a47d50b508..953a6c23616 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -34,6 +34,7 @@ import Distribution.Client.TargetProblem import Distribution.Client.CmdInstall.ClientInstallFlags import Distribution.Client.CmdInstall.ClientInstallTargetSelector +import Distribution.Client.Cmd.UI (CmdItem (..), helpText, optionFieldFlagParsers) import Distribution.Client.Config ( SavedConfig (..) , defaultInstallPath @@ -120,7 +121,6 @@ import Distribution.Package import Distribution.Simple.BuildPaths ( exeExtension ) -import Distribution.Client.Cmd.UI (optionFieldFlagParsers, helpText) import Distribution.Simple.Command ( CommandParse (..) , CommandSpec (..) @@ -230,11 +230,11 @@ import qualified Data.ByteString.Lazy.Char8 as BS import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map import Data.Monoid (Endo (..), appEndo) -import qualified Data.Text as T import Data.Ord ( Down (..) ) import qualified Data.Set as S +import qualified Data.Text as T import Distribution.Client.Errors import Distribution.Utils.NubList ( fromNubList @@ -1508,17 +1508,14 @@ data ParsedInstallCommand = ParsedInstallCommand , parsedListOptions :: Bool } -data InstallItem - = InstallItemFlag (Endo (NixStyleFlags ClientInstallFlags)) - | InstallItemTarget String - | InstallItemListOptions +type InstallCmdItem = CmdItem ClientInstallFlags parsedInstallCommandParser :: Parser ParsedInstallCommand parsedInstallCommandParser = toParsed <$> many installItemParser where toParsed items = - let edits = [e | InstallItemFlag e <- items] - targets = [t | InstallItemTarget t <- items] + let edits = [e | CmdItemFlag e <- items] + targets = [t | CmdItemTarget t <- items] listOptionsSeen = any isListOptions items in ParsedInstallCommand { parsedFlagEdits = mconcat edits @@ -1526,23 +1523,23 @@ parsedInstallCommandParser = toParsed <$> many installItemParser , parsedListOptions = listOptionsSeen } - isListOptions InstallItemListOptions = True + isListOptions CmdItemListOptions = True isListOptions _ = False -installItemParser :: Parser InstallItem +installItemParser :: Parser InstallCmdItem installItemParser = asum ( installOptionParsers - ++ [ InstallItemListOptions + ++ [ CmdItemListOptions <$ flag' () (long "list-options" <> help "Print a list of command line flags") - , InstallItemTarget <$> strArgument (metavar "TARGET") + , CmdItemTarget <$> strArgument (metavar "TARGET") ] ) -installOptionParsers :: [Parser InstallItem] +installOptionParsers :: [Parser InstallCmdItem] installOptionParsers = (fmap . fmap) - InstallItemFlag + CmdItemFlag (optionFieldFlagParsers $ commandOptions installCommand ParseArgs) From 7afd8a902e890f274f11d94814e546a85c5f7af9 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Tue, 11 Aug 2026 14:58:53 -0400 Subject: [PATCH 48/85] Generalise *OptionParsers --- cabal-install/src/Distribution/Client/CmdBuild.hs | 11 +++++------ cabal-install/src/Distribution/Client/CmdInstall.hs | 10 ++++------ 2 files changed, 9 insertions(+), 12 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index d4599afb1ca..3a7622c4abd 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -52,6 +52,7 @@ import Distribution.Simple.Command , CommandSpec (..) , CommandType (..) , CommandUI (..) + , OptionField (..) , ShowOrParseArgs (ParseArgs) , commandAddAction , commandParseArgs @@ -352,7 +353,7 @@ parsedBuildCommandParser = toParsed <$> many buildItemParser buildItemParser :: Parser BuildCmdItem buildItemParser = asum - ( buildOptionParsers + ( buildOptionParsers (commandOptions buildCommand ParseArgs) ++ [ CmdItemListOptions <$ flag' () @@ -361,8 +362,6 @@ buildItemParser = ] ) -buildOptionParsers :: [Parser BuildCmdItem] -buildOptionParsers = - (fmap . fmap) - CmdItemFlag - (optionFieldFlagParsers $ commandOptions buildCommand ParseArgs) +buildOptionParsers + :: [OptionField (NixStyleFlags a)] -> [Parser (CmdItem a)] +buildOptionParsers fields = (fmap . fmap) CmdItemFlag (optionFieldFlagParsers fields) diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index 953a6c23616..da8fa688fa4 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -126,6 +126,7 @@ import Distribution.Simple.Command , CommandSpec (..) , CommandType (..) , CommandUI (..) + , OptionField (..) , ShowOrParseArgs (ParseArgs) , commandAddAction , commandParseArgs @@ -1529,7 +1530,7 @@ parsedInstallCommandParser = toParsed <$> many installItemParser installItemParser :: Parser InstallCmdItem installItemParser = asum - ( installOptionParsers + ( installOptionParsers (commandOptions installCommand ParseArgs) ++ [ CmdItemListOptions <$ flag' () @@ -1538,8 +1539,5 @@ installItemParser = ] ) -installOptionParsers :: [Parser InstallCmdItem] -installOptionParsers = - (fmap . fmap) - CmdItemFlag - (optionFieldFlagParsers $ commandOptions installCommand ParseArgs) +installOptionParsers :: [OptionField (NixStyleFlags a)] -> [Parser (CmdItem a)] +installOptionParsers fields = (fmap . fmap) CmdItemFlag (optionFieldFlagParsers fields) From d075ad48820af3dbc1757f9757a23487e4e74800 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Tue, 11 Aug 2026 15:04:21 -0400 Subject: [PATCH 49/85] Move cmdOptionParsers --- cabal-install/src/Distribution/Client/Cmd/UI.hs | 4 ++++ cabal-install/src/Distribution/Client/CmdBuild.hs | 9 ++------- cabal-install/src/Distribution/Client/CmdInstall.hs | 7 ++----- 3 files changed, 8 insertions(+), 12 deletions(-) diff --git a/cabal-install/src/Distribution/Client/Cmd/UI.hs b/cabal-install/src/Distribution/Client/Cmd/UI.hs index 7988fed7e66..f7602b55e21 100644 --- a/cabal-install/src/Distribution/Client/Cmd/UI.hs +++ b/cabal-install/src/Distribution/Client/Cmd/UI.hs @@ -14,6 +14,7 @@ module Distribution.Client.Cmd.UI -- * Command data types , CmdItem (..) + , cmdOptionParsers -- * Help text layout helpers , renderOptionRows @@ -74,6 +75,9 @@ data CmdItem a | CmdItemTarget String | CmdItemListOptions +cmdOptionParsers :: [OptionField (NixStyleFlags a)] -> [O.Parser (CmdItem a)] +cmdOptionParsers fields = (fmap . fmap) CmdItemFlag (optionFieldFlagParsers fields) + optionFieldFlagParsers :: [OptionField flags] -> [O.Parser (Endo flags)] optionFieldFlagParsers = concatMap optionFieldParser diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 3a7622c4abd..c984a4b7f78 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -32,7 +32,7 @@ import Distribution.Client.TargetProblem import qualified Data.Map as Map import Data.Monoid (Endo (..), appEndo) import qualified Data.Text as T -import Distribution.Client.Cmd.UI (CmdItem (..), helpText, optionFieldFlagParsers) +import Distribution.Client.Cmd.UI (CmdItem (..), cmdOptionParsers, helpText) import Distribution.Client.Errors import Distribution.Client.NixStyleOptions ( NixStyleFlags (..) @@ -52,7 +52,6 @@ import Distribution.Simple.Command , CommandSpec (..) , CommandType (..) , CommandUI (..) - , OptionField (..) , ShowOrParseArgs (ParseArgs) , commandAddAction , commandParseArgs @@ -353,7 +352,7 @@ parsedBuildCommandParser = toParsed <$> many buildItemParser buildItemParser :: Parser BuildCmdItem buildItemParser = asum - ( buildOptionParsers (commandOptions buildCommand ParseArgs) + ( cmdOptionParsers (commandOptions buildCommand ParseArgs) ++ [ CmdItemListOptions <$ flag' () @@ -361,7 +360,3 @@ buildItemParser = , CmdItemTarget <$> strArgument (metavar "TARGET") ] ) - -buildOptionParsers - :: [OptionField (NixStyleFlags a)] -> [Parser (CmdItem a)] -buildOptionParsers fields = (fmap . fmap) CmdItemFlag (optionFieldFlagParsers fields) diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index da8fa688fa4..ff1db516ca1 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -34,7 +34,7 @@ import Distribution.Client.TargetProblem import Distribution.Client.CmdInstall.ClientInstallFlags import Distribution.Client.CmdInstall.ClientInstallTargetSelector -import Distribution.Client.Cmd.UI (CmdItem (..), helpText, optionFieldFlagParsers) +import Distribution.Client.Cmd.UI (CmdItem (..), cmdOptionParsers, helpText) import Distribution.Client.Config ( SavedConfig (..) , defaultInstallPath @@ -1530,7 +1530,7 @@ parsedInstallCommandParser = toParsed <$> many installItemParser installItemParser :: Parser InstallCmdItem installItemParser = asum - ( installOptionParsers (commandOptions installCommand ParseArgs) + ( cmdOptionParsers (commandOptions installCommand ParseArgs) ++ [ CmdItemListOptions <$ flag' () @@ -1538,6 +1538,3 @@ installItemParser = , CmdItemTarget <$> strArgument (metavar "TARGET") ] ) - -installOptionParsers :: [OptionField (NixStyleFlags a)] -> [Parser (CmdItem a)] -installOptionParsers fields = (fmap . fmap) CmdItemFlag (optionFieldFlagParsers fields) From e45886ba9c9f9c3eca3f02b6c1ba38bfc9191ba3 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Tue, 11 Aug 2026 15:22:13 -0400 Subject: [PATCH 50/85] Move cmdItemParser --- .../src/Distribution/Client/Cmd/UI.hs | 21 +++++++++++++++ .../src/Distribution/Client/CmdBuild.hs | 26 +++---------------- .../src/Distribution/Client/CmdInstall.hs | 26 +++---------------- 3 files changed, 29 insertions(+), 44 deletions(-) diff --git a/cabal-install/src/Distribution/Client/Cmd/UI.hs b/cabal-install/src/Distribution/Client/Cmd/UI.hs index f7602b55e21..a6fdf663544 100644 --- a/cabal-install/src/Distribution/Client/Cmd/UI.hs +++ b/cabal-install/src/Distribution/Client/Cmd/UI.hs @@ -14,6 +14,7 @@ module Distribution.Client.Cmd.UI -- * Command data types , CmdItem (..) + , cmdItemParser , cmdOptionParsers -- * Help text layout helpers @@ -68,6 +69,14 @@ import Distribution.Simple.Command ) import Distribution.Simple.Utils (ordNub) +import Options.Applicative + ( asum + , flag' + , help + , long + , metavar + , strArgument + ) import qualified Options.Applicative as O data CmdItem a @@ -75,6 +84,18 @@ data CmdItem a | CmdItemTarget String | CmdItemListOptions +cmdItemParser :: [O.Parser (CmdItem a)] -> O.Parser (CmdItem a) +cmdItemParser flags = + asum + ( flags + ++ [ CmdItemListOptions + <$ flag' + () + (long "list-options" <> help "Print a list of command line flags") + , CmdItemTarget <$> strArgument (metavar "TARGET") + ] + ) + cmdOptionParsers :: [OptionField (NixStyleFlags a)] -> [O.Parser (CmdItem a)] cmdOptionParsers fields = (fmap . fmap) CmdItemFlag (optionFieldFlagParsers fields) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index c984a4b7f78..715e4f0dd56 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -32,7 +32,7 @@ import Distribution.Client.TargetProblem import qualified Data.Map as Map import Data.Monoid (Endo (..), appEndo) import qualified Data.Text as T -import Distribution.Client.Cmd.UI (CmdItem (..), cmdOptionParsers, helpText) +import Distribution.Client.Cmd.UI (CmdItem (..), cmdItemParser, cmdOptionParsers, helpText) import Distribution.Client.Errors import Distribution.Client.NixStyleOptions ( NixStyleFlags (..) @@ -65,21 +65,15 @@ import Options.Applicative ( Parser , ParserInfo , ParserResult (..) - , asum , defaultPrefs , execParserPure - , flag' , footer , fullDesc , header - , help , helper , info - , long - , metavar , progDesc , renderFailure - , strArgument , (<**>) ) @@ -331,11 +325,11 @@ data ParsedBuildCommand = ParsedBuildCommand , parsedListOptions :: Bool } -type BuildCmdItem = CmdItem BuildFlags - parsedBuildCommandParser :: Parser ParsedBuildCommand -parsedBuildCommandParser = toParsed <$> many buildItemParser +parsedBuildCommandParser = toParsed <$> many (cmdItemParser flagParsers) where + flagParsers = cmdOptionParsers (commandOptions buildCommand ParseArgs) + toParsed items = let edits = [e | CmdItemFlag e <- items] targets = [t | CmdItemTarget t <- items] @@ -348,15 +342,3 @@ parsedBuildCommandParser = toParsed <$> many buildItemParser isListOptions CmdItemListOptions = True isListOptions _ = False - -buildItemParser :: Parser BuildCmdItem -buildItemParser = - asum - ( cmdOptionParsers (commandOptions buildCommand ParseArgs) - ++ [ CmdItemListOptions - <$ flag' - () - (long "list-options" <> help "Print a list of command line flags") - , CmdItemTarget <$> strArgument (metavar "TARGET") - ] - ) diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index ff1db516ca1..ef3b152a8bd 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -34,7 +34,7 @@ import Distribution.Client.TargetProblem import Distribution.Client.CmdInstall.ClientInstallFlags import Distribution.Client.CmdInstall.ClientInstallTargetSelector -import Distribution.Client.Cmd.UI (CmdItem (..), cmdOptionParsers, helpText) +import Distribution.Client.Cmd.UI (CmdItem (..), cmdItemParser, cmdOptionParsers, helpText) import Distribution.Client.Config ( SavedConfig (..) , defaultInstallPath @@ -245,21 +245,15 @@ import Options.Applicative ( Parser , ParserInfo , ParserResult (..) - , asum , defaultPrefs , execParserPure - , flag' , footer , fullDesc , header - , help , helper , info - , long - , metavar , progDesc , renderFailure - , strArgument , (<**>) ) import System.Directory @@ -1509,11 +1503,11 @@ data ParsedInstallCommand = ParsedInstallCommand , parsedListOptions :: Bool } -type InstallCmdItem = CmdItem ClientInstallFlags - parsedInstallCommandParser :: Parser ParsedInstallCommand -parsedInstallCommandParser = toParsed <$> many installItemParser +parsedInstallCommandParser = toParsed <$> many (cmdItemParser flagParsers) where + flagParsers = cmdOptionParsers (commandOptions installCommand ParseArgs) + toParsed items = let edits = [e | CmdItemFlag e <- items] targets = [t | CmdItemTarget t <- items] @@ -1526,15 +1520,3 @@ parsedInstallCommandParser = toParsed <$> many installItemParser isListOptions CmdItemListOptions = True isListOptions _ = False - -installItemParser :: Parser InstallCmdItem -installItemParser = - asum - ( cmdOptionParsers (commandOptions installCommand ParseArgs) - ++ [ CmdItemListOptions - <$ flag' - () - (long "list-options" <> help "Print a list of command line flags") - , CmdItemTarget <$> strArgument (metavar "TARGET") - ] - ) From e22fe3174eb278eecd6c82a0736601b6ff15e2fb Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Tue, 11 Aug 2026 15:39:24 -0400 Subject: [PATCH 51/85] Move parsedCommandParser --- .../src/Distribution/Client/Cmd/UI.hs | 24 +++++++++++ .../src/Distribution/Client/CmdBuild.hs | 40 +++++-------------- .../src/Distribution/Client/CmdInstall.hs | 40 +++++-------------- 3 files changed, 46 insertions(+), 58 deletions(-) diff --git a/cabal-install/src/Distribution/Client/Cmd/UI.hs b/cabal-install/src/Distribution/Client/Cmd/UI.hs index a6fdf663544..38d0188742b 100644 --- a/cabal-install/src/Distribution/Client/Cmd/UI.hs +++ b/cabal-install/src/Distribution/Client/Cmd/UI.hs @@ -14,6 +14,8 @@ module Distribution.Client.Cmd.UI -- * Command data types , CmdItem (..) + , ParsedCommand (..) + , parsedCommandParser , cmdItemParser , cmdOptionParsers @@ -84,6 +86,28 @@ data CmdItem a | CmdItemTarget String | CmdItemListOptions +data ParsedCommand a = ParsedCommand + { parsedFlagEdits :: Endo (NixStyleFlags a) + , parsedTargets :: [String] + , parsedListOptions :: Bool + } + +parsedCommandParser :: [O.Parser (CmdItem a)] -> O.Parser (ParsedCommand a) +parsedCommandParser flagParsers = toParsed <$> many (cmdItemParser flagParsers) + where + toParsed items = + let edits = [e | CmdItemFlag e <- items] + targets = [t | CmdItemTarget t <- items] + listOptionsSeen = any isListOptions items + in ParsedCommand + { parsedFlagEdits = mconcat edits + , parsedTargets = targets + , parsedListOptions = listOptionsSeen + } + + isListOptions CmdItemListOptions = True + isListOptions _ = False + cmdItemParser :: [O.Parser (CmdItem a)] -> O.Parser (CmdItem a) cmdItemParser flags = asum diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 715e4f0dd56..ecbb1c6c93e 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -32,7 +32,12 @@ import Distribution.Client.TargetProblem import qualified Data.Map as Map import Data.Monoid (Endo (..), appEndo) import qualified Data.Text as T -import Distribution.Client.Cmd.UI (CmdItem (..), cmdItemParser, cmdOptionParsers, helpText) +import Distribution.Client.Cmd.UI + ( ParsedCommand (..) + , cmdOptionParsers + , helpText + , parsedCommandParser + ) import Distribution.Client.Errors import Distribution.Client.NixStyleOptions ( NixStyleFlags (..) @@ -62,8 +67,7 @@ import Distribution.Simple.Flag (Flag, fromFlag, toFlag) import Distribution.Simple.Utils (dieWithException, wrapText) import Distribution.Verbosity (normal) import Options.Applicative - ( Parser - , ParserInfo + ( ParserInfo , ParserResult (..) , defaultPrefs , execParserPure @@ -303,42 +307,20 @@ parseBuildCommand invokedName cmdArgs = CompletionInvoked _ -> CommandErrors ["Shell completion is not supported by this parser path."] -buildParserInfo :: String -> ParserInfo ParsedBuildCommand +buildParserInfo :: String -> ParserInfo (ParsedCommand BuildFlags) buildParserInfo invokedName = info - (parsedBuildCommandParser <**> helper) + (parsedCommandParser flagParsers <**> helper) ( fullDesc <> progDesc buildHelpDescription <> header ("cabal " ++ invokedName) <> footer (examples "cabal" invokedName) ) + where + flagParsers = cmdOptionParsers (commandOptions buildCommand ParseArgs) buildHelpDescription :: String buildHelpDescription = case commandDescription buildCommand of Nothing -> commandSynopsis buildCommand Just mkDescription -> mkDescription "cabal" - -data ParsedBuildCommand = ParsedBuildCommand - { parsedFlagEdits :: Endo (NixStyleFlags BuildFlags) - , parsedTargets :: [String] - , parsedListOptions :: Bool - } - -parsedBuildCommandParser :: Parser ParsedBuildCommand -parsedBuildCommandParser = toParsed <$> many (cmdItemParser flagParsers) - where - flagParsers = cmdOptionParsers (commandOptions buildCommand ParseArgs) - - toParsed items = - let edits = [e | CmdItemFlag e <- items] - targets = [t | CmdItemTarget t <- items] - listOptionsSeen = any isListOptions items - in ParsedBuildCommand - { parsedFlagEdits = mconcat edits - , parsedTargets = targets - , parsedListOptions = listOptionsSeen - } - - isListOptions CmdItemListOptions = True - isListOptions _ = False diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index ef3b152a8bd..6b3f52b3d59 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -34,7 +34,12 @@ import Distribution.Client.TargetProblem import Distribution.Client.CmdInstall.ClientInstallFlags import Distribution.Client.CmdInstall.ClientInstallTargetSelector -import Distribution.Client.Cmd.UI (CmdItem (..), cmdItemParser, cmdOptionParsers, helpText) +import Distribution.Client.Cmd.UI + ( ParsedCommand (..) + , cmdOptionParsers + , helpText + , parsedCommandParser + ) import Distribution.Client.Config ( SavedConfig (..) , defaultInstallPath @@ -242,8 +247,7 @@ import Distribution.Utils.NubList ) import Network.URI (URI) import Options.Applicative - ( Parser - , ParserInfo + ( ParserInfo , ParserResult (..) , defaultPrefs , execParserPure @@ -1469,15 +1473,17 @@ parseInstallCommand invokedName cmdArgs = CompletionInvoked _ -> CommandErrors ["Shell completion is not supported by this parser path."] -installParserInfo :: String -> ParserInfo ParsedInstallCommand +installParserInfo :: String -> ParserInfo (ParsedCommand ClientInstallFlags) installParserInfo invokedName = info - (parsedInstallCommandParser <**> helper) + (parsedCommandParser flagParsers <**> helper) ( fullDesc <> progDesc installHelpDescription <> header ("cabal " ++ invokedName) <> footer (installExamples invokedName) ) + where + flagParsers = cmdOptionParsers (commandOptions installCommand ParseArgs) installHelpDescription :: String installHelpDescription = @@ -1496,27 +1502,3 @@ installExamples invokedName = , " - cabal " <> invokedName <> " ./pkgfoo" , " Install the package in the ./pkgfoo directory" ] - -data ParsedInstallCommand = ParsedInstallCommand - { parsedFlagEdits :: Endo (NixStyleFlags ClientInstallFlags) - , parsedTargets :: [String] - , parsedListOptions :: Bool - } - -parsedInstallCommandParser :: Parser ParsedInstallCommand -parsedInstallCommandParser = toParsed <$> many (cmdItemParser flagParsers) - where - flagParsers = cmdOptionParsers (commandOptions installCommand ParseArgs) - - toParsed items = - let edits = [e | CmdItemFlag e <- items] - targets = [t | CmdItemTarget t <- items] - listOptionsSeen = any isListOptions items - in ParsedInstallCommand - { parsedFlagEdits = mconcat edits - , parsedTargets = targets - , parsedListOptions = listOptionsSeen - } - - isListOptions CmdItemListOptions = True - isListOptions _ = False From 0a549bb0c5fd092299b55376f72cb5172eb1c867 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Tue, 11 Aug 2026 15:45:36 -0400 Subject: [PATCH 52/85] Move helpDescriptionOrSynopsis --- cabal-install/src/Distribution/Client/Cmd/UI.hs | 7 +++++++ cabal-install/src/Distribution/Client/CmdBuild.hs | 9 ++------- cabal-install/src/Distribution/Client/CmdInstall.hs | 9 ++------- 3 files changed, 11 insertions(+), 14 deletions(-) diff --git a/cabal-install/src/Distribution/Client/Cmd/UI.hs b/cabal-install/src/Distribution/Client/Cmd/UI.hs index 38d0188742b..8acc5120157 100644 --- a/cabal-install/src/Distribution/Client/Cmd/UI.hs +++ b/cabal-install/src/Distribution/Client/Cmd/UI.hs @@ -18,6 +18,7 @@ module Distribution.Client.Cmd.UI , parsedCommandParser , cmdItemParser , cmdOptionParsers + , helpDescriptionOrSynopsis -- * Help text layout helpers , renderOptionRows @@ -81,6 +82,12 @@ import Options.Applicative ) import qualified Options.Applicative as O +helpDescriptionOrSynopsis :: CommandUI flags -> String +helpDescriptionOrSynopsis x = + case commandDescription x of + Nothing -> commandSynopsis x + Just mkDescription -> mkDescription "cabal" + data CmdItem a = CmdItemFlag (Endo (NixStyleFlags a)) | CmdItemTarget String diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index ecbb1c6c93e..4dcd4d36521 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -35,6 +35,7 @@ import qualified Data.Text as T import Distribution.Client.Cmd.UI ( ParsedCommand (..) , cmdOptionParsers + , helpDescriptionOrSynopsis , helpText , parsedCommandParser ) @@ -312,15 +313,9 @@ buildParserInfo invokedName = info (parsedCommandParser flagParsers <**> helper) ( fullDesc - <> progDesc buildHelpDescription + <> progDesc (helpDescriptionOrSynopsis buildCommand) <> header ("cabal " ++ invokedName) <> footer (examples "cabal" invokedName) ) where flagParsers = cmdOptionParsers (commandOptions buildCommand ParseArgs) - -buildHelpDescription :: String -buildHelpDescription = - case commandDescription buildCommand of - Nothing -> commandSynopsis buildCommand - Just mkDescription -> mkDescription "cabal" diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index 6b3f52b3d59..be4ea11a798 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -37,6 +37,7 @@ import Distribution.Client.CmdInstall.ClientInstallTargetSelector import Distribution.Client.Cmd.UI ( ParsedCommand (..) , cmdOptionParsers + , helpDescriptionOrSynopsis , helpText , parsedCommandParser ) @@ -1478,19 +1479,13 @@ installParserInfo invokedName = info (parsedCommandParser flagParsers <**> helper) ( fullDesc - <> progDesc installHelpDescription + <> progDesc (helpDescriptionOrSynopsis installCommand) <> header ("cabal " ++ invokedName) <> footer (installExamples invokedName) ) where flagParsers = cmdOptionParsers (commandOptions installCommand ParseArgs) -installHelpDescription :: String -installHelpDescription = - case commandDescription installCommand of - Nothing -> commandSynopsis installCommand - Just mkDescription -> mkDescription "cabal" - installExamples :: String -> String installExamples invokedName = unlines From 127720b226c03b91d3c2a99bd4798f43a3b56002 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Tue, 11 Aug 2026 16:06:01 -0400 Subject: [PATCH 53/85] Move parserInfo --- .../src/Distribution/Client/Cmd/UI.hs | 23 +++- .../src/Distribution/Client/CmdBuild.hs | 26 +---- .../src/Distribution/Client/CmdInstall.hs | 105 ++++++------------ 3 files changed, 62 insertions(+), 92 deletions(-) diff --git a/cabal-install/src/Distribution/Client/Cmd/UI.hs b/cabal-install/src/Distribution/Client/Cmd/UI.hs index 8acc5120157..049a8fbf220 100644 --- a/cabal-install/src/Distribution/Client/Cmd/UI.hs +++ b/cabal-install/src/Distribution/Client/Cmd/UI.hs @@ -19,6 +19,7 @@ module Distribution.Client.Cmd.UI , cmdItemParser , cmdOptionParsers , helpDescriptionOrSynopsis + , parserInfo -- * Help text layout helpers , renderOptionRows @@ -73,12 +74,20 @@ import Distribution.Simple.Command import Distribution.Simple.Utils (ordNub) import Options.Applicative - ( asum + ( ParserInfo + , asum , flag' + , footer + , fullDesc + , header , help + , helper + , info , long , metavar + , progDesc , strArgument + , (<**>) ) import qualified Options.Applicative as O @@ -99,6 +108,18 @@ data ParsedCommand a = ParsedCommand , parsedListOptions :: Bool } +type Examples = String -> String -> String + +parserInfo :: String -> Examples -> [O.Parser (CmdItem a)] -> CommandUI flags -> ParserInfo (ParsedCommand a) +parserInfo invokedName examples flagParsers cmdui = + info + (parsedCommandParser flagParsers <**> helper) + ( fullDesc + <> progDesc (helpDescriptionOrSynopsis cmdui) + <> header ("cabal " ++ invokedName) + <> footer (examples "cabal" invokedName) + ) + parsedCommandParser :: [O.Parser (CmdItem a)] -> O.Parser (ParsedCommand a) parsedCommandParser flagParsers = toParsed <$> many (cmdItemParser flagParsers) where diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 4dcd4d36521..69ba2ecc214 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -35,9 +35,8 @@ import qualified Data.Text as T import Distribution.Client.Cmd.UI ( ParsedCommand (..) , cmdOptionParsers - , helpDescriptionOrSynopsis , helpText - , parsedCommandParser + , parserInfo ) import Distribution.Client.Errors import Distribution.Client.NixStyleOptions @@ -68,18 +67,10 @@ import Distribution.Simple.Flag (Flag, fromFlag, toFlag) import Distribution.Simple.Utils (dieWithException, wrapText) import Distribution.Verbosity (normal) import Options.Applicative - ( ParserInfo - , ParserResult (..) + ( ParserResult (..) , defaultPrefs , execParserPure - , footer - , fullDesc - , header - , helper - , info - , progDesc , renderFailure - , (<**>) ) cmdSpec :: [CommandSpec (GlobalFlags -> IO ())] @@ -293,7 +284,7 @@ replaceBuildAlias invokedName = T.unpack . T.replace (T.pack "v2-build") (T.pack parseBuildCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) parseBuildCommand invokedName cmdArgs = - case execParserPure defaultPrefs (buildParserInfo invokedName) cmdArgs of + case execParserPure defaultPrefs info cmdArgs of Success parsed -> if parsedListOptions parsed then CommandList buildListOptions @@ -307,15 +298,6 @@ parseBuildCommand invokedName cmdArgs = else CommandErrors [msg] CompletionInvoked _ -> CommandErrors ["Shell completion is not supported by this parser path."] - -buildParserInfo :: String -> ParserInfo (ParsedCommand BuildFlags) -buildParserInfo invokedName = - info - (parsedCommandParser flagParsers <**> helper) - ( fullDesc - <> progDesc (helpDescriptionOrSynopsis buildCommand) - <> header ("cabal " ++ invokedName) - <> footer (examples "cabal" invokedName) - ) where + info = parserInfo invokedName examples flagParsers buildCommand flagParsers = cmdOptionParsers (commandOptions buildCommand ParseArgs) diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index be4ea11a798..a507ee0a26c 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -37,9 +37,8 @@ import Distribution.Client.CmdInstall.ClientInstallTargetSelector import Distribution.Client.Cmd.UI ( ParsedCommand (..) , cmdOptionParsers - , helpDescriptionOrSynopsis , helpText - , parsedCommandParser + , parserInfo ) import Distribution.Client.Config ( SavedConfig (..) @@ -204,7 +203,7 @@ import Distribution.System , Platform , buildOS ) -import Distribution.Types.InstalledPackageInfo +import qualified Distribution.Types.InstalledPackageInfo as IPI ( InstalledPackageInfo (..) ) import Distribution.Types.PackageId @@ -248,18 +247,10 @@ import Distribution.Utils.NubList ) import Network.URI (URI) import Options.Applicative - ( ParserInfo - , ParserResult (..) + ( ParserResult (..) , defaultPrefs , execParserPure - , footer - , fullDesc - , header - , helper - , info - , progDesc , renderFailure - , (<**>) ) import System.Directory ( copyFile @@ -337,37 +328,9 @@ installCommand = CommandUI { commandName = "v2-install" , commandSynopsis = "Install packages." - , commandUsage = - usageAlternatives - "v2-install" - ["[TARGETS] [FLAGS]"] - , commandDescription = Just $ \_ -> - wrapText $ - "Installs one or more packages. This is done by installing them " - ++ "in the store and symlinking or copying the executables in the directory " - ++ "specified by the --installdir flag (`~/.local/bin/` by default). " - ++ "If you want the installed executables to be available globally, " - ++ "make sure that the PATH environment variable contains that directory. " - ++ "\n\n" - ++ "If TARGET is a library and --lib (provisional) is used, " - ++ "it will be added to the global environment. " - ++ "When doing this, cabal will try to build a plan that includes all " - ++ "the previously installed libraries. This is currently not implemented." - , commandNotes = Just $ \pname -> - "Examples:\n" - ++ " " - ++ pname - ++ " v2-install\n" - ++ " Install the package in the current directory\n" - ++ " " - ++ pname - ++ " v2-install pkgname\n" - ++ " Install the package named pkgname" - ++ " (fetching it from hackage if necessary)\n" - ++ " " - ++ pname - ++ " v2-install ./pkgfoo\n" - ++ " Install the package in the ./pkgfoo directory\n" + , commandUsage = usageAlternatives "v2-install" ["[TARGETS] [FLAGS]"] + , commandDescription = Just $ \_ -> wrapText description + , commandNotes = Just $ \pname -> examples pname "v2-install" , commandOptions = \x -> filter notInstallDirOpt $ nixStyleOptions clientInstallOptions x , commandDefaultFlags = defaultNixStyleFlags defaultClientInstallFlags } @@ -376,6 +339,31 @@ installCommand = notInstallDirOpt x = optionName x `notElem` installDirOptNames installDirOptNames = map optionName installDirsOptions +description :: String +description = + "Installs one or more packages. This is done by installing them " + ++ "in the store and symlinking or copying the executables in the directory " + ++ "specified by the --installdir flag (`~/.local/bin/` by default). " + ++ "If you want the installed executables to be available globally, " + ++ "make sure that the PATH environment variable contains that directory. " + ++ "\n\n" + ++ "If TARGET is a library and --lib (provisional) is used, " + ++ "it will be added to the global environment. " + ++ "When doing this, cabal will try to build a plan that includes all " + ++ "the previously installed libraries. This is currently not implemented." + +examples :: String -> String -> String +examples pname invokedName = + unlines + [ "Examples:" + , " - " <> pname <> " " <> invokedName + , " Install the package in the current directory" + , " - " <> pname <> " " <> invokedName <> " pkgname" + , " Install the package named pkgname (fetching it from hackage if necessary)" + , " - " <> pname <> " " <> invokedName <> " ./pkgfoo" + , " Install the package in the ./pkgfoo directory" + ] + -- | The @install@ command actually serves four different needs. It installs: -- * exes: -- For example a program from hackage. The behavior is similar to the old @@ -1003,7 +991,7 @@ prepareExeInstall installLibraries :: Verbosity -> ProjectBuildContext - -> PI.PackageIndex InstalledPackageInfo + -> PI.PackageIndex IPI.InstalledPackageInfo -> Compiler -> PackageDBStackCWD -> FilePath @@ -1036,7 +1024,7 @@ installLibraries . sortBy (comparing (Down . fst)) . PI.lookupPackageName installedIndex globalLatest = concatMap getLatest globalPackages - globalEntries = GhcEnvFilePackageId . installedUnitId <$> globalLatest + globalEntries = GhcEnvFilePackageId . IPI.installedUnitId <$> globalLatest baseEntries = GhcEnvFileClearPackageDbStack : fmap GhcEnvFilePackageDb packageDbs pkgEntries = @@ -1125,7 +1113,7 @@ environmentFileToSpecifiers environmentFileToSpecifiers ipi = foldMap $ \case (GhcEnvFilePackageId unitId) | Just - InstalledPackageInfo + IPI.InstalledPackageInfo { sourcePackageId = PackageIdentifier{..} , installedUnitId } <- @@ -1459,7 +1447,7 @@ replaceInstallAlias invokedName = parseInstallCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) parseInstallCommand invokedName cmdArgs = - case execParserPure defaultPrefs (installParserInfo invokedName) cmdArgs of + case execParserPure defaultPrefs info cmdArgs of Success parsed -> if parsedListOptions parsed then CommandList installListOptions @@ -1473,27 +1461,6 @@ parseInstallCommand invokedName cmdArgs = else CommandErrors [msg] CompletionInvoked _ -> CommandErrors ["Shell completion is not supported by this parser path."] - -installParserInfo :: String -> ParserInfo (ParsedCommand ClientInstallFlags) -installParserInfo invokedName = - info - (parsedCommandParser flagParsers <**> helper) - ( fullDesc - <> progDesc (helpDescriptionOrSynopsis installCommand) - <> header ("cabal " ++ invokedName) - <> footer (installExamples invokedName) - ) where + info = parserInfo invokedName examples flagParsers installCommand flagParsers = cmdOptionParsers (commandOptions installCommand ParseArgs) - -installExamples :: String -> String -installExamples invokedName = - unlines - [ "Examples:" - , " - cabal " <> invokedName - , " Install the package in the current directory" - , " - cabal " <> invokedName <> " pkgname" - , " Install the package named pkgname (fetching it from hackage if necessary)" - , " - cabal " <> invokedName <> " ./pkgfoo" - , " Install the package in the ./pkgfoo directory" - ] From bd1c5562eb462b4ebacbdeb894534a7bf67a6465 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 13 Aug 2026 14:59:46 -0400 Subject: [PATCH 54/85] Rename to isCommandName --- cabal-install/src/Distribution/Client/CmdBuild.hs | 12 ++++++------ cabal-install/src/Distribution/Client/CmdInstall.hs | 12 ++++++------ cabal-install/src/Distribution/Client/Main.hs | 4 ++-- 3 files changed, 14 insertions(+), 14 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 69ba2ecc214..1b57057eab2 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -7,7 +7,7 @@ module Distribution.Client.CmdBuild cmdSpec , buildAction , parseBuildCommand - , isBuildCommandName + , isCommandName , BuildFlags (..) , defaultBuildFlags @@ -265,13 +265,13 @@ reportCannotPruneDependencies verbosity = -- | The command name and aliases for the @build@ command. -- --- >>> buildCommandNames +-- >>> commandNames -- ["build","new-build","v2-build"] -buildCommandNames :: [String] -buildCommandNames = ["build", "new-build", commandName buildCommand] +commandNames :: [String] +commandNames = ["build", "new-build", commandName buildCommand] -isBuildCommandName :: String -> Bool -isBuildCommandName name = name `elem` buildCommandNames +isCommandName :: String -> Bool +isCommandName name = name `elem` commandNames buildListOptions :: [String] buildListOptions = diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index a507ee0a26c..24a6a65ae1b 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -9,7 +9,7 @@ module Distribution.Client.CmdInstall , installCommand , installAction , parseInstallCommand - , isInstallCommandName + , isCommandName -- * Internals exposed for testing , selectPackageTargets @@ -1427,13 +1427,13 @@ reportCannotPruneDependencies verbosity = -- | The command name and aliases for the @install@ command. -- --- >>> installCommandNames +-- >>> commandNames -- ["install","new-install","v2-install"] -installCommandNames :: [String] -installCommandNames = ["install", "new-install", commandName installCommand] +commandNames :: [String] +commandNames = ["install", "new-install", commandName installCommand] -isInstallCommandName :: String -> Bool -isInstallCommandName name = name `elem` installCommandNames +isCommandName :: String -> Bool +isCommandName name = name `elem` commandNames installListOptions :: [String] installListOptions = diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index efd338fcc98..4e22910ad9b 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -389,10 +389,10 @@ mainWorker args = do CommandReadyToGo (mkGlobalFlags, cmdArgs0) -> case cmdArgs0 of (cmdName : cmdArgs) - | CmdBuild.isBuildCommandName cmdName -> + | CmdBuild.isCommandName cmdName -> let globalFlags = mkGlobalFlags (commandDefaultFlags globalCmd) in Just $ CommandReadyToGo (globalFlags, CmdBuild.parseBuildCommand cmdName cmdArgs) - | CmdInstall.isInstallCommandName cmdName -> + | CmdInstall.isCommandName cmdName -> let globalFlags = mkGlobalFlags (commandDefaultFlags globalCmd) in Just $ CommandReadyToGo (globalFlags, CmdInstall.parseInstallCommand cmdName cmdArgs) _ -> Nothing From 2e6c5a293e17e0015057f3434c77a9566a563357 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 13 Aug 2026 15:07:51 -0400 Subject: [PATCH 55/85] Rename to parseCommand --- .../src/Distribution/Client/CmdBuild.hs | 16 +++++++++------- .../src/Distribution/Client/CmdInstall.hs | 14 ++++++++------ cabal-install/src/Distribution/Client/Main.hs | 4 ++-- 3 files changed, 19 insertions(+), 15 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 1b57057eab2..35562214421 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -3,14 +3,16 @@ -- | cabal-install CLI command: build module Distribution.Client.CmdBuild - ( -- * The @build@ CLI and action - cmdSpec - , buildAction - , parseBuildCommand - , isCommandName + ( -- * The @build@ CLI command UI and action + buildAction , BuildFlags (..) , defaultBuildFlags + -- * The @build@ CLI command spec and parser + , cmdSpec + , isCommandName + , parseCommand + -- * Internals exposed for testing , selectPackageTargets , selectComponentTarget @@ -282,8 +284,8 @@ buildListOptions = replaceBuildAlias :: String -> String -> String replaceBuildAlias invokedName = T.unpack . T.replace (T.pack "v2-build") (T.pack invokedName) . T.pack -parseBuildCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) -parseBuildCommand invokedName cmdArgs = +parseCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) +parseCommand invokedName cmdArgs = case execParserPure defaultPrefs info cmdArgs of Success parsed -> if parsedListOptions parsed diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index 24a6a65ae1b..5ca34225a2d 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -4,12 +4,14 @@ -- | cabal-install CLI command: install module Distribution.Client.CmdInstall - ( -- * The @install@ CLI and action - cmdSpec - , installCommand + ( -- * The @install@ CLI command UI and action + installCommand , installAction - , parseInstallCommand + + -- * The @install@ CLI command spec and parser + , cmdSpec , isCommandName + , parseCommand -- * Internals exposed for testing , selectPackageTargets @@ -1445,8 +1447,8 @@ replaceInstallAlias :: String -> String -> String replaceInstallAlias invokedName = T.unpack . T.replace (T.pack "v2-install") (T.pack invokedName) . T.pack -parseInstallCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) -parseInstallCommand invokedName cmdArgs = +parseCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) +parseCommand invokedName cmdArgs = case execParserPure defaultPrefs info cmdArgs of Success parsed -> if parsedListOptions parsed diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index 4e22910ad9b..1664f52f474 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -391,10 +391,10 @@ mainWorker args = do (cmdName : cmdArgs) | CmdBuild.isCommandName cmdName -> let globalFlags = mkGlobalFlags (commandDefaultFlags globalCmd) - in Just $ CommandReadyToGo (globalFlags, CmdBuild.parseBuildCommand cmdName cmdArgs) + in Just $ CommandReadyToGo (globalFlags, CmdBuild.parseCommand cmdName cmdArgs) | CmdInstall.isCommandName cmdName -> let globalFlags = mkGlobalFlags (commandDefaultFlags globalCmd) - in Just $ CommandReadyToGo (globalFlags, CmdInstall.parseInstallCommand cmdName cmdArgs) + in Just $ CommandReadyToGo (globalFlags, CmdInstall.parseCommand cmdName cmdArgs) _ -> Nothing _ -> Nothing From 017f20cba66dc402785b7c13fbe598bff9ed879a Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 13 Aug 2026 15:37:34 -0400 Subject: [PATCH 56/85] Use do block to reduce repetition --- cabal-install/src/Distribution/Client/Main.hs | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index 1664f52f474..164590913bb 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -386,16 +386,14 @@ mainWorker args = do parseBuildOrInstallWithOptparse :: [String] -> Maybe (CommandParse (GlobalFlags, CommandParse Action)) parseBuildOrInstallWithOptparse argv = case commandParseArgs globalCmd True argv of - CommandReadyToGo (mkGlobalFlags, cmdArgs0) -> - case cmdArgs0 of - (cmdName : cmdArgs) - | CmdBuild.isCommandName cmdName -> - let globalFlags = mkGlobalFlags (commandDefaultFlags globalCmd) - in Just $ CommandReadyToGo (globalFlags, CmdBuild.parseCommand cmdName cmdArgs) - | CmdInstall.isCommandName cmdName -> - let globalFlags = mkGlobalFlags (commandDefaultFlags globalCmd) - in Just $ CommandReadyToGo (globalFlags, CmdInstall.parseCommand cmdName cmdArgs) + CommandReadyToGo (mkGlobalFlags, cmdArgs0) -> do + (cmdParser, cmdName : cmdArgs) <- case cmdArgs0 of + x@(n : _) + | CmdBuild.isCommandName n -> Just (CmdBuild.parseCommand, x) + | CmdInstall.isCommandName n -> Just (CmdInstall.parseCommand, x) _ -> Nothing + let globalFlags = mkGlobalFlags (commandDefaultFlags globalCmd) + return $ CommandReadyToGo (globalFlags, cmdParser cmdName cmdArgs) _ -> Nothing delegateToExternal From b54457195d0b6e1fabf38c45d553be34800cab2b Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Thu, 13 Aug 2026 15:42:36 -0400 Subject: [PATCH 57/85] Satisfy fourmolu --- cabal-install/src/Distribution/Client/CmdBuild.hs | 2 +- cabal-install/src/Distribution/Client/CmdInstall.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 35562214421..73c96f13e3d 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -8,7 +8,7 @@ module Distribution.Client.CmdBuild , BuildFlags (..) , defaultBuildFlags - -- * The @build@ CLI command spec and parser + -- * The @build@ CLI command spec and parser , cmdSpec , isCommandName , parseCommand diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index 5ca34225a2d..1d44a6f12af 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -8,7 +8,7 @@ module Distribution.Client.CmdInstall installCommand , installAction - -- * The @install@ CLI command spec and parser + -- * The @install@ CLI command spec and parser , cmdSpec , isCommandName , parseCommand From d8a80f6b07b53183d8685c428902caad5f28158a Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sat, 15 Aug 2026 14:20:45 -0400 Subject: [PATCH 58/85] Replace FILTER with values for test-show-details --- Cabal/src/Distribution/Simple/Setup/Test.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cabal/src/Distribution/Simple/Setup/Test.hs b/Cabal/src/Distribution/Simple/Setup/Test.hs index 718cde13305..00b8121e98f 100644 --- a/Cabal/src/Distribution/Simple/Setup/Test.hs +++ b/Cabal/src/Distribution/Simple/Setup/Test.hs @@ -206,7 +206,7 @@ testOptions' showOrParseArgs = testShowDetails (\v flags -> flags{testShowDetails = v}) ( reqArg - "FILTER" + "always|never|failures|streaming|direct" ( parsecToReadE ( \_ -> "--show-details flag expects one of " From a75f679cd637ef610dbdaac79f61b512dc71e1a1 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sat, 15 Aug 2026 14:23:49 -0400 Subject: [PATCH 59/85] Replace LEVEL with values for remote-build-report --- 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 7fe9e61fff1..5c7684f5bc2 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/cabal-install/src/Distribution/Client/Setup.hs @@ -2743,7 +2743,7 @@ installOptions showOrParseArgs = installBuildReports (\v flags -> flags{installBuildReports = v}) ( reqArg - "LEVEL" + "none|anonymous|detailed" ( parsecToReadE ( const $ "report level must be 'none', " From cd3bf85b021feab0bab5fa872bc228ee6e7d5d93 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sat, 15 Aug 2026 14:29:38 -0400 Subject: [PATCH 60/85] Sublist for remote-build-reporting options --- cabal-install/src/Distribution/Client/Setup.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs index 5c7684f5bc2..d6fb00b3afe 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/cabal-install/src/Distribution/Client/Setup.hs @@ -2739,7 +2739,13 @@ installOptions showOrParseArgs = , option [] ["remote-build-reporting"] - "Generate build reports to send to a remote server (none, anonymous or detailed)." + ( unlines + [ "Generate build reports to send to a remote server:" + , "- none: do not report," + , "- anonymous: report without identifying information," + , "- detailed: report with full details." + ] + ) installBuildReports (\v flags -> flags{installBuildReports = v}) ( reqArg From 44ba14917d16250528b39681e326088c9eef410d Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sat, 15 Aug 2026 15:27:51 -0400 Subject: [PATCH 61/85] act-as-setup warning and error --- cabal-install/src/Distribution/Client/Main.hs | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index 164590913bb..e8ea0386826 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -232,6 +232,7 @@ import Distribution.Simple.Utils , cabalVersion , createDirectoryIfMissingVerbose , die' + , dieNoWrap , dieNoVerbosity , dieWithException , findPackageDesc @@ -1594,9 +1595,14 @@ actAsSetupAction actAsSetupFlags args _globalFlags = Simple.autoconfSetupHooks defaultVerbosityHandles args - Make -> error "actAsSetupAction Main" - Hooks -> error "actAsSetupAction Hooks" - Custom -> error "actAsSetupAction Custom" + Make -> unsupportedBuildType + Hooks -> unsupportedBuildType + Custom -> unsupportedBuildType + where + verbosity = mkVerbosity defaultVerbosityHandles normal + unsupportedBuildType = do + warn verbosity "act-as-setup accepts --build-type=Simple|Configure, case-sensitively." + dieNoWrap verbosity "act-as-setup doesn't accept --build-type=Make|Hooks|Custom." manpageAction :: [CommandSpec action] -> ManpageFlags -> [String] -> Action manpageAction commands flags extraArgs _ = do From a2d60a2e95677e2fe94bc484da1f4e6b464c2bb7 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 16 Aug 2026 08:36:14 -0400 Subject: [PATCH 62/85] HasCallStack for getConfigState --- Cabal/src/Distribution/Simple/Configure.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs index 53c3b35caa0..d724e605fd4 100644 --- a/Cabal/src/Distribution/Simple/Configure.hs +++ b/Cabal/src/Distribution/Simple/Configure.hs @@ -73,6 +73,7 @@ module Distribution.Simple.Configure import Control.Monad import Distribution.Compat.Prelude +import GHC.Stack (HasCallStack) import Prelude () import Distribution.Backpack.Configure @@ -81,7 +82,6 @@ import Distribution.Backpack.DescribeUnitId import Distribution.Backpack.Id import Distribution.Backpack.PreExistingComponent import qualified Distribution.Compat.Graph as Graph -import Distribution.Compat.Stack import Distribution.Compiler import Distribution.InstalledPackageInfo (InstalledPackageInfo) import qualified Distribution.InstalledPackageInfo as IPI @@ -253,7 +253,8 @@ instance Exception ConfigStateFileError -- missing, if the file cannot be read, or if the file was created by an older -- version of Cabal. getConfigStateFile - :: Maybe (SymbolicPath CWD (Dir Pkg)) + :: HasCallStack + => Maybe (SymbolicPath CWD (Dir Pkg)) -> SymbolicPath Pkg File -- ^ The file path of the @setup-config@ file. -> IO LocalBuildInfo @@ -279,8 +280,6 @@ getConfigStateFile mbWorkDir setupConfigFile = do throwIO $ ConfigStateFileBadVersion cabalId compId eResult | otherwise = act deferErrorIfBadVersion getStoredValue - where - _ = callStack -- TODO: attach call stack to exception -- | Read the 'localBuildInfoFile', returning either an error or the local build -- info. From df82ea171237b0490933fa640f4a0592bf5a9551 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 16 Aug 2026 08:59:29 -0400 Subject: [PATCH 63/85] Replace BUILD-TYPE with values for BuildType --- cabal-install/src/Distribution/Client/Setup.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs index d6fb00b3afe..f53d00baba9 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/cabal-install/src/Distribution/Client/Setup.hs @@ -3451,7 +3451,7 @@ actAsSetupCommand = actAsSetupBuildType (\v flags -> flags{actAsSetupBuildType = v}) ( reqArg - "BUILD-TYPE" + placeholder ( parsecToReadE ("Cannot parse build type: " ++) (fmap toFlag parsec) @@ -3460,6 +3460,9 @@ actAsSetupCommand = ) ] } + where + placeholder = intercalate "|" $ map show setupBuildTypes + setupBuildTypes = [Simple, Configure] -- ------------------------------------------------------------ From 7d22cd979815cee669f3227cb830e9441d046477 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 16 Aug 2026 09:38:12 -0400 Subject: [PATCH 64/85] Move cmdSpec to Cmd.UI --- .../src/Distribution/Client/Cmd/UI.hs | 23 ++++++++++++++++++- .../src/Distribution/Client/CmdBuild.hs | 16 ++----------- .../src/Distribution/Client/CmdInstall.hs | 16 ++----------- 3 files changed, 26 insertions(+), 29 deletions(-) diff --git a/cabal-install/src/Distribution/Client/Cmd/UI.hs b/cabal-install/src/Distribution/Client/Cmd/UI.hs index 049a8fbf220..5f6bd1db219 100644 --- a/cabal-install/src/Distribution/Client/Cmd/UI.hs +++ b/cabal-install/src/Distribution/Client/Cmd/UI.hs @@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} module Distribution.Client.Cmd.UI ( -- * Converting CommandUI options to optparse-applicative parsers @@ -18,6 +19,7 @@ module Distribution.Client.Cmd.UI , parsedCommandParser , cmdItemParser , cmdOptionParsers + , cmdSpec , helpDescriptionOrSynopsis , parserInfo @@ -66,10 +68,13 @@ import Distribution.Client.NixStyleOptions ) import Distribution.ReadE (runReadE) import Distribution.Simple.Command - ( CommandUI (..) + ( CommandSpec (..) + , CommandType (NormalCommand) + , CommandUI (..) , OptDescr (..) , OptionField (..) , ShowOrParseArgs (ShowArgs) + , commandAddAction ) import Distribution.Simple.Utils (ordNub) @@ -110,6 +115,22 @@ data ParsedCommand a = ParsedCommand type Examples = String -> String -> String +cmdSpec + :: CommandUI flags + -> (flags -> [String] -> action) + -> [CommandSpec action] +cmdSpec command action = + [CommandSpec ui (`commandAddAction` action) NormalCommand] + where + defaultMsg = T.unpack . T.replace "v2-" "" . T.pack + ui = + command + { commandName = defaultMsg (commandName command) + , commandUsage = defaultMsg . commandUsage command + , commandDescription = (defaultMsg .) <$> commandDescription command + , commandNotes = (defaultMsg .) <$> commandNotes command + } + parserInfo :: String -> Examples -> [O.Parser (CmdItem a)] -> CommandUI flags -> ParserInfo (ParsedCommand a) parserInfo invokedName examples flagParsers cmdui = info diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 73c96f13e3d..d480d01c797 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -40,6 +40,7 @@ import Distribution.Client.Cmd.UI , helpText , parserInfo ) +import qualified Distribution.Client.Cmd.UI as UI import Distribution.Client.Errors import Distribution.Client.NixStyleOptions ( NixStyleFlags (..) @@ -57,10 +58,8 @@ import Distribution.Client.Setup (GlobalFlags, yesNoOpt) import Distribution.Simple.Command ( CommandParse (..) , CommandSpec (..) - , CommandType (..) , CommandUI (..) , ShowOrParseArgs (ParseArgs) - , commandAddAction , commandParseArgs , option , usageAlternatives @@ -76,18 +75,7 @@ import Options.Applicative ) cmdSpec :: [CommandSpec (GlobalFlags -> IO ())] -cmdSpec = [CommandSpec ui (`commandAddAction` buildAction) NormalCommand] - where - defaultMsg = T.unpack . T.replace "v2-" "" . T.pack - CommandUI{..} = buildCommand - - ui = - buildCommand - { commandName = defaultMsg commandName - , commandUsage = defaultMsg . commandUsage - , commandDescription = (defaultMsg .) <$> commandDescription - , commandNotes = (defaultMsg .) <$> commandNotes - } +cmdSpec = UI.cmdSpec buildCommand buildAction buildCommand :: CommandUI (NixStyleFlags BuildFlags) buildCommand = diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index 1d44a6f12af..f1e8326f145 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -33,6 +33,7 @@ import Distribution.Client.TargetProblem , TargetProblem' ) +import qualified Distribution.Client.Cmd.UI as UI import Distribution.Client.CmdInstall.ClientInstallFlags import Distribution.Client.CmdInstall.ClientInstallTargetSelector @@ -131,11 +132,9 @@ import Distribution.Simple.BuildPaths import Distribution.Simple.Command ( CommandParse (..) , CommandSpec (..) - , CommandType (..) , CommandUI (..) , OptionField (..) , ShowOrParseArgs (ParseArgs) - , commandAddAction , commandParseArgs , optionName , usageAlternatives @@ -312,18 +311,7 @@ data InstallExe = InstallExe } cmdSpec :: [CommandSpec (GlobalFlags -> IO ())] -cmdSpec = [CommandSpec ui (`commandAddAction` installAction) NormalCommand] - where - defaultMsg = T.unpack . T.replace (T.pack "v2-") (T.pack "") . T.pack - CommandUI{..} = installCommand - - ui = - installCommand - { commandName = defaultMsg commandName - , commandUsage = defaultMsg . commandUsage - , commandDescription = (defaultMsg .) <$> commandDescription - , commandNotes = (defaultMsg .) <$> commandNotes - } +cmdSpec = UI.cmdSpec installCommand installAction installCommand :: CommandUI (NixStyleFlags ClientInstallFlags) installCommand = From a2042ebce4ba6a00ecb6eb9474ce8fef277e0703 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 16 Aug 2026 09:54:00 -0400 Subject: [PATCH 65/85] Use Cmd.UI.cmdSpec --- cabal-install/src/Distribution/Client/CmdBuild.hs | 9 ++------- cabal-install/src/Distribution/Client/CmdInstall.hs | 6 ------ cabal-install/src/Distribution/Client/Main.hs | 7 ++++--- 3 files changed, 6 insertions(+), 16 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index d480d01c797..dfd8bf8f5d4 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -4,12 +4,12 @@ -- | cabal-install CLI command: build module Distribution.Client.CmdBuild ( -- * The @build@ CLI command UI and action - buildAction + buildCommand + , buildAction , BuildFlags (..) , defaultBuildFlags -- * The @build@ CLI command spec and parser - , cmdSpec , isCommandName , parseCommand @@ -40,7 +40,6 @@ import Distribution.Client.Cmd.UI , helpText , parserInfo ) -import qualified Distribution.Client.Cmd.UI as UI import Distribution.Client.Errors import Distribution.Client.NixStyleOptions ( NixStyleFlags (..) @@ -57,7 +56,6 @@ import Distribution.Client.ScriptUtils import Distribution.Client.Setup (GlobalFlags, yesNoOpt) import Distribution.Simple.Command ( CommandParse (..) - , CommandSpec (..) , CommandUI (..) , ShowOrParseArgs (ParseArgs) , commandParseArgs @@ -74,9 +72,6 @@ import Options.Applicative , renderFailure ) -cmdSpec :: [CommandSpec (GlobalFlags -> IO ())] -cmdSpec = UI.cmdSpec buildCommand buildAction - buildCommand :: CommandUI (NixStyleFlags BuildFlags) buildCommand = CommandUI diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index f1e8326f145..29a5cb6f58e 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -9,7 +9,6 @@ module Distribution.Client.CmdInstall , installAction -- * The @install@ CLI command spec and parser - , cmdSpec , isCommandName , parseCommand @@ -33,7 +32,6 @@ import Distribution.Client.TargetProblem , TargetProblem' ) -import qualified Distribution.Client.Cmd.UI as UI import Distribution.Client.CmdInstall.ClientInstallFlags import Distribution.Client.CmdInstall.ClientInstallTargetSelector @@ -131,7 +129,6 @@ import Distribution.Simple.BuildPaths ) import Distribution.Simple.Command ( CommandParse (..) - , CommandSpec (..) , CommandUI (..) , OptionField (..) , ShowOrParseArgs (ParseArgs) @@ -310,9 +307,6 @@ data InstallExe = InstallExe -- store. } -cmdSpec :: [CommandSpec (GlobalFlags -> IO ())] -cmdSpec = UI.cmdSpec installCommand installAction - installCommand :: CommandUI (NixStyleFlags ClientInstallFlags) installCommand = CommandUI diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index e8ea0386826..1d240c8a10b 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -182,6 +182,7 @@ import Distribution.PackageDescription , buildable ) +import Distribution.Client.Cmd.UI (cmdSpec) import Distribution.Client.Errors import Distribution.Compat.ResponseFile import Distribution.PackageDescription.PrettyPrint @@ -232,8 +233,8 @@ import Distribution.Simple.Utils , cabalVersion , createDirectoryIfMissingVerbose , die' - , dieNoWrap , dieNoVerbosity + , dieNoWrap , dieWithException , findPackageDesc , info @@ -499,14 +500,14 @@ mainWorker args = do ++ concat [ newCmd CmdConfigure.configureCommand CmdConfigure.configureAction , newCmd CmdUpdate.updateCommand CmdUpdate.updateAction - , CmdBuild.cmdSpec + , cmdSpec CmdBuild.buildCommand CmdBuild.buildAction , newCmd CmdRepl.replCommand CmdRepl.replAction , newCmd CmdFreeze.freezeCommand CmdFreeze.freezeAction , newCmd CmdHaddock.haddockCommand CmdHaddock.haddockAction , newCmd CmdHaddockProject.haddockProjectCommand CmdHaddockProject.haddockProjectAction - , CmdInstall.cmdSpec + , cmdSpec CmdInstall.installCommand CmdInstall.installAction , newCmd CmdRun.runCommand CmdRun.runAction , newCmd CmdTest.testCommand CmdTest.testAction , newCmd CmdBench.benchCommand CmdBench.benchAction From 02b0bf1cdbd842fe0549b4267f7a5c53a785905a Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 16 Aug 2026 10:00:07 -0400 Subject: [PATCH 66/85] Move parseCommand to Cmd.UI --- .../src/Distribution/Client/Cmd/UI.hs | 36 ++++++++++++++++- .../src/Distribution/Client/CmdBuild.hs | 39 ++++++------------- .../src/Distribution/Client/CmdInstall.hs | 39 ++++++------------- 3 files changed, 57 insertions(+), 57 deletions(-) diff --git a/cabal-install/src/Distribution/Client/Cmd/UI.hs b/cabal-install/src/Distribution/Client/Cmd/UI.hs index 5f6bd1db219..4fa61db7934 100644 --- a/cabal-install/src/Distribution/Client/Cmd/UI.hs +++ b/cabal-install/src/Distribution/Client/Cmd/UI.hs @@ -20,6 +20,7 @@ module Distribution.Client.Cmd.UI , cmdItemParser , cmdOptionParsers , cmdSpec + , parseCommand , helpDescriptionOrSynopsis , parserInfo @@ -68,7 +69,8 @@ import Distribution.Client.NixStyleOptions ) import Distribution.ReadE (runReadE) import Distribution.Simple.Command - ( CommandSpec (..) + ( CommandParse (..) + , CommandSpec (..) , CommandType (NormalCommand) , CommandUI (..) , OptDescr (..) @@ -80,7 +82,10 @@ import Distribution.Simple.Utils (ordNub) import Options.Applicative ( ParserInfo + , ParserResult (..) , asum + , defaultPrefs + , execParserPure , flag' , footer , fullDesc @@ -91,6 +96,7 @@ import Options.Applicative , long , metavar , progDesc + , renderFailure , strArgument , (<**>) ) @@ -131,6 +137,34 @@ cmdSpec command action = , commandNotes = (defaultMsg .) <$> commandNotes command } +parseCommand + :: String + -> [String] + -> Examples + -> [O.Parser (CmdItem a)] + -> CommandUI (NixStyleFlags a) + -> [String] + -> (NixStyleFlags a -> [String] -> action) + -> ReplaceCommandAlias + -> CommandParse action +parseCommand invokedName cmdArgs examples flagParsers cmdui listOptions action replaceAlias = + case execParserPure defaultPrefs pInfo cmdArgs of + Success parsed -> + if parsedListOptions parsed + then CommandList listOptions + else + let flags = appEndo (parsedFlagEdits parsed) (commandDefaultFlags cmdui) + in CommandReadyToGo (action flags (parsedTargets parsed)) + Failure failure -> + let (msg, exitCode) = renderFailure failure ("cabal " ++ invokedName) + in if exitCode == ExitSuccess + then CommandHelp (helpText replaceAlias cmdui invokedName) + else CommandErrors [msg] + CompletionInvoked _ -> + CommandErrors ["Shell completion is not supported by this parser path."] + where + pInfo = parserInfo invokedName examples flagParsers cmdui + parserInfo :: String -> Examples -> [O.Parser (CmdItem a)] -> CommandUI flags -> ParserInfo (ParsedCommand a) parserInfo invokedName examples flagParsers cmdui = info diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index dfd8bf8f5d4..44daa471511 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -32,14 +32,11 @@ import Distribution.Client.TargetProblem ) import qualified Data.Map as Map -import Data.Monoid (Endo (..), appEndo) import qualified Data.Text as T import Distribution.Client.Cmd.UI - ( ParsedCommand (..) - , cmdOptionParsers - , helpText - , parserInfo + ( cmdOptionParsers ) +import qualified Distribution.Client.Cmd.UI as Cmd.UI import Distribution.Client.Errors import Distribution.Client.NixStyleOptions ( NixStyleFlags (..) @@ -65,12 +62,6 @@ import Distribution.Simple.Command import Distribution.Simple.Flag (Flag, fromFlag, toFlag) import Distribution.Simple.Utils (dieWithException, wrapText) import Distribution.Verbosity (normal) -import Options.Applicative - ( ParserResult (..) - , defaultPrefs - , execParserPure - , renderFailure - ) buildCommand :: CommandUI (NixStyleFlags BuildFlags) buildCommand = @@ -269,20 +260,12 @@ replaceBuildAlias invokedName = T.unpack . T.replace (T.pack "v2-build") (T.pack parseCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) parseCommand invokedName cmdArgs = - case execParserPure defaultPrefs info cmdArgs of - Success parsed -> - if parsedListOptions parsed - then CommandList buildListOptions - else - let flags = appEndo (parsedFlagEdits parsed) (commandDefaultFlags buildCommand) - in CommandReadyToGo (buildAction flags (parsedTargets parsed)) - Failure failure -> - let (msg, exitCode) = renderFailure failure ("cabal " ++ invokedName) - in if exitCode == ExitSuccess - then CommandHelp (helpText replaceBuildAlias buildCommand invokedName) - else CommandErrors [msg] - CompletionInvoked _ -> - CommandErrors ["Shell completion is not supported by this parser path."] - where - info = parserInfo invokedName examples flagParsers buildCommand - flagParsers = cmdOptionParsers (commandOptions buildCommand ParseArgs) + Cmd.UI.parseCommand + invokedName + cmdArgs + examples + (cmdOptionParsers (commandOptions buildCommand ParseArgs)) + buildCommand + buildListOptions + buildAction + replaceBuildAlias diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index 29a5cb6f58e..40814d4a377 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -36,11 +36,9 @@ import Distribution.Client.CmdInstall.ClientInstallFlags import Distribution.Client.CmdInstall.ClientInstallTargetSelector import Distribution.Client.Cmd.UI - ( ParsedCommand (..) - , cmdOptionParsers - , helpText - , parserInfo + ( cmdOptionParsers ) +import qualified Distribution.Client.Cmd.UI as Cmd.UI import Distribution.Client.Config ( SavedConfig (..) , defaultInstallPath @@ -233,7 +231,6 @@ import Distribution.Verbosity import qualified Data.ByteString.Lazy.Char8 as BS import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map -import Data.Monoid (Endo (..), appEndo) import Data.Ord ( Down (..) ) @@ -244,12 +241,6 @@ import Distribution.Utils.NubList ( fromNubList ) import Network.URI (URI) -import Options.Applicative - ( ParserResult (..) - , defaultPrefs - , execParserPure - , renderFailure - ) import System.Directory ( copyFile , createDirectoryIfMissing @@ -1431,20 +1422,12 @@ replaceInstallAlias invokedName = parseCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) parseCommand invokedName cmdArgs = - case execParserPure defaultPrefs info cmdArgs of - Success parsed -> - if parsedListOptions parsed - then CommandList installListOptions - else - let flags = appEndo (parsedFlagEdits parsed) (commandDefaultFlags installCommand) - in CommandReadyToGo (installAction flags (parsedTargets parsed)) - Failure failure -> - let (msg, exitCode) = renderFailure failure ("cabal " ++ invokedName) - in if exitCode == ExitSuccess - then CommandHelp (helpText replaceInstallAlias installCommand invokedName) - else CommandErrors [msg] - CompletionInvoked _ -> - CommandErrors ["Shell completion is not supported by this parser path."] - where - info = parserInfo invokedName examples flagParsers installCommand - flagParsers = cmdOptionParsers (commandOptions installCommand ParseArgs) + Cmd.UI.parseCommand + invokedName + cmdArgs + examples + (cmdOptionParsers (commandOptions installCommand ParseArgs)) + installCommand + installListOptions + installAction + replaceInstallAlias From 1c4529c5f64e18903008ba903436c47c85b5a0b0 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 16 Aug 2026 10:06:30 -0400 Subject: [PATCH 67/85] Move replaceCommandAlias to Cmd.UI --- cabal-install/src/Distribution/Client/Cmd/UI.hs | 5 +++++ cabal-install/src/Distribution/Client/CmdBuild.hs | 7 ++----- cabal-install/src/Distribution/Client/CmdInstall.hs | 8 ++------ 3 files changed, 9 insertions(+), 11 deletions(-) diff --git a/cabal-install/src/Distribution/Client/Cmd/UI.hs b/cabal-install/src/Distribution/Client/Cmd/UI.hs index 4fa61db7934..4abcf9ac159 100644 --- a/cabal-install/src/Distribution/Client/Cmd/UI.hs +++ b/cabal-install/src/Distribution/Client/Cmd/UI.hs @@ -21,6 +21,7 @@ module Distribution.Client.Cmd.UI , cmdOptionParsers , cmdSpec , parseCommand + , replaceCommandAlias , helpDescriptionOrSynopsis , parserInfo @@ -121,6 +122,10 @@ data ParsedCommand a = ParsedCommand type Examples = String -> String -> String +replaceCommandAlias :: String -> ReplaceCommandAlias +replaceCommandAlias commandName invokedName = + T.unpack . T.replace (T.pack commandName) (T.pack invokedName) . T.pack + cmdSpec :: CommandUI flags -> (flags -> [String] -> action) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 44daa471511..7ce3aeedcbf 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -32,9 +32,9 @@ import Distribution.Client.TargetProblem ) import qualified Data.Map as Map -import qualified Data.Text as T import Distribution.Client.Cmd.UI ( cmdOptionParsers + , replaceCommandAlias ) import qualified Distribution.Client.Cmd.UI as Cmd.UI import Distribution.Client.Errors @@ -255,9 +255,6 @@ buildListOptions = CommandList opts -> opts _ -> [] -replaceBuildAlias :: String -> String -> String -replaceBuildAlias invokedName = T.unpack . T.replace (T.pack "v2-build") (T.pack invokedName) . T.pack - parseCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) parseCommand invokedName cmdArgs = Cmd.UI.parseCommand @@ -268,4 +265,4 @@ parseCommand invokedName cmdArgs = buildCommand buildListOptions buildAction - replaceBuildAlias + (replaceCommandAlias (commandName buildCommand)) diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index 40814d4a377..bb1433fd5c1 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -37,6 +37,7 @@ import Distribution.Client.CmdInstall.ClientInstallTargetSelector import Distribution.Client.Cmd.UI ( cmdOptionParsers + , replaceCommandAlias ) import qualified Distribution.Client.Cmd.UI as Cmd.UI import Distribution.Client.Config @@ -235,7 +236,6 @@ import Data.Ord ( Down (..) ) import qualified Data.Set as S -import qualified Data.Text as T import Distribution.Client.Errors import Distribution.Utils.NubList ( fromNubList @@ -1416,10 +1416,6 @@ installListOptions = CommandList opts -> opts _ -> [] -replaceInstallAlias :: String -> String -> String -replaceInstallAlias invokedName = - T.unpack . T.replace (T.pack "v2-install") (T.pack invokedName) . T.pack - parseCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) parseCommand invokedName cmdArgs = Cmd.UI.parseCommand @@ -1430,4 +1426,4 @@ parseCommand invokedName cmdArgs = installCommand installListOptions installAction - replaceInstallAlias + (replaceCommandAlias (commandName installCommand)) From f957f1adc6da50a05b5cfc0d72f3a92e358fcd5a Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 16 Aug 2026 10:08:03 -0400 Subject: [PATCH 68/85] Move cmdListOptions to Cmd.UI --- cabal-install/src/Distribution/Client/Cmd/UI.hs | 8 ++++++++ cabal-install/src/Distribution/Client/CmdBuild.hs | 12 +++--------- cabal-install/src/Distribution/Client/CmdInstall.hs | 12 +++--------- 3 files changed, 14 insertions(+), 18 deletions(-) diff --git a/cabal-install/src/Distribution/Client/Cmd/UI.hs b/cabal-install/src/Distribution/Client/Cmd/UI.hs index 4abcf9ac159..d64331bdf7a 100644 --- a/cabal-install/src/Distribution/Client/Cmd/UI.hs +++ b/cabal-install/src/Distribution/Client/Cmd/UI.hs @@ -20,6 +20,7 @@ module Distribution.Client.Cmd.UI , cmdItemParser , cmdOptionParsers , cmdSpec + , cmdListOptions , parseCommand , replaceCommandAlias , helpDescriptionOrSynopsis @@ -78,6 +79,7 @@ import Distribution.Simple.Command , OptionField (..) , ShowOrParseArgs (ShowArgs) , commandAddAction + , commandParseArgs ) import Distribution.Simple.Utils (ordNub) @@ -142,6 +144,12 @@ cmdSpec command action = , commandNotes = (defaultMsg .) <$> commandNotes command } +cmdListOptions :: CommandUI flags -> [String] +cmdListOptions command = + case commandParseArgs command False ["--list-options"] of + CommandList opts -> opts + _ -> [] + parseCommand :: String -> [String] diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 7ce3aeedcbf..1339a4a64ca 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -33,7 +33,8 @@ import Distribution.Client.TargetProblem import qualified Data.Map as Map import Distribution.Client.Cmd.UI - ( cmdOptionParsers + ( cmdListOptions + , cmdOptionParsers , replaceCommandAlias ) import qualified Distribution.Client.Cmd.UI as Cmd.UI @@ -55,7 +56,6 @@ import Distribution.Simple.Command ( CommandParse (..) , CommandUI (..) , ShowOrParseArgs (ParseArgs) - , commandParseArgs , option , usageAlternatives ) @@ -249,12 +249,6 @@ commandNames = ["build", "new-build", commandName buildCommand] isCommandName :: String -> Bool isCommandName name = name `elem` commandNames -buildListOptions :: [String] -buildListOptions = - case commandParseArgs buildCommand False ["--list-options"] of - CommandList opts -> opts - _ -> [] - parseCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) parseCommand invokedName cmdArgs = Cmd.UI.parseCommand @@ -263,6 +257,6 @@ parseCommand invokedName cmdArgs = examples (cmdOptionParsers (commandOptions buildCommand ParseArgs)) buildCommand - buildListOptions + (cmdListOptions buildCommand) buildAction (replaceCommandAlias (commandName buildCommand)) diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index bb1433fd5c1..1ae2169be4e 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -36,7 +36,8 @@ import Distribution.Client.CmdInstall.ClientInstallFlags import Distribution.Client.CmdInstall.ClientInstallTargetSelector import Distribution.Client.Cmd.UI - ( cmdOptionParsers + ( cmdListOptions + , cmdOptionParsers , replaceCommandAlias ) import qualified Distribution.Client.Cmd.UI as Cmd.UI @@ -131,7 +132,6 @@ import Distribution.Simple.Command , CommandUI (..) , OptionField (..) , ShowOrParseArgs (ParseArgs) - , commandParseArgs , optionName , usageAlternatives ) @@ -1410,12 +1410,6 @@ commandNames = ["install", "new-install", commandName installCommand] isCommandName :: String -> Bool isCommandName name = name `elem` commandNames -installListOptions :: [String] -installListOptions = - case commandParseArgs installCommand False ["--list-options"] of - CommandList opts -> opts - _ -> [] - parseCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) parseCommand invokedName cmdArgs = Cmd.UI.parseCommand @@ -1424,6 +1418,6 @@ parseCommand invokedName cmdArgs = examples (cmdOptionParsers (commandOptions installCommand ParseArgs)) installCommand - installListOptions + (cmdListOptions installCommand) installAction (replaceCommandAlias (commandName installCommand)) From d1ee3477e1dfc3ca9290ae8e43b72a1b0d0fb44e Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 16 Aug 2026 10:15:45 -0400 Subject: [PATCH 69/85] Change arg order of parseCommand --- cabal-install/src/Distribution/Client/Cmd/UI.hs | 15 +++++++-------- cabal-install/src/Distribution/Client/CmdBuild.hs | 11 ++--------- .../src/Distribution/Client/CmdInstall.hs | 11 ++--------- 3 files changed, 11 insertions(+), 26 deletions(-) diff --git a/cabal-install/src/Distribution/Client/Cmd/UI.hs b/cabal-install/src/Distribution/Client/Cmd/UI.hs index d64331bdf7a..30c059d9f43 100644 --- a/cabal-install/src/Distribution/Client/Cmd/UI.hs +++ b/cabal-install/src/Distribution/Client/Cmd/UI.hs @@ -77,7 +77,7 @@ import Distribution.Simple.Command , CommandUI (..) , OptDescr (..) , OptionField (..) - , ShowOrParseArgs (ShowArgs) + , ShowOrParseArgs (..) , commandAddAction , commandParseArgs ) @@ -151,20 +151,18 @@ cmdListOptions command = _ -> [] parseCommand - :: String - -> [String] - -> Examples - -> [O.Parser (CmdItem a)] + :: Examples -> CommandUI (NixStyleFlags a) - -> [String] -> (NixStyleFlags a -> [String] -> action) -> ReplaceCommandAlias + -> String + -> [String] -> CommandParse action -parseCommand invokedName cmdArgs examples flagParsers cmdui listOptions action replaceAlias = +parseCommand examples cmdui action replaceAlias invokedName cmdArgs = case execParserPure defaultPrefs pInfo cmdArgs of Success parsed -> if parsedListOptions parsed - then CommandList listOptions + then CommandList (cmdListOptions cmdui) else let flags = appEndo (parsedFlagEdits parsed) (commandDefaultFlags cmdui) in CommandReadyToGo (action flags (parsedTargets parsed)) @@ -177,6 +175,7 @@ parseCommand invokedName cmdArgs examples flagParsers cmdui listOptions action r CommandErrors ["Shell completion is not supported by this parser path."] where pInfo = parserInfo invokedName examples flagParsers cmdui + flagParsers = cmdOptionParsers (commandOptions cmdui ParseArgs) parserInfo :: String -> Examples -> [O.Parser (CmdItem a)] -> CommandUI flags -> ParserInfo (ParsedCommand a) parserInfo invokedName examples flagParsers cmdui = diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 1339a4a64ca..f6a59af6f87 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -33,9 +33,7 @@ import Distribution.Client.TargetProblem import qualified Data.Map as Map import Distribution.Client.Cmd.UI - ( cmdListOptions - , cmdOptionParsers - , replaceCommandAlias + ( replaceCommandAlias ) import qualified Distribution.Client.Cmd.UI as Cmd.UI import Distribution.Client.Errors @@ -55,7 +53,6 @@ import Distribution.Client.Setup (GlobalFlags, yesNoOpt) import Distribution.Simple.Command ( CommandParse (..) , CommandUI (..) - , ShowOrParseArgs (ParseArgs) , option , usageAlternatives ) @@ -250,13 +247,9 @@ isCommandName :: String -> Bool isCommandName name = name `elem` commandNames parseCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) -parseCommand invokedName cmdArgs = +parseCommand = Cmd.UI.parseCommand - invokedName - cmdArgs examples - (cmdOptionParsers (commandOptions buildCommand ParseArgs)) buildCommand - (cmdListOptions buildCommand) buildAction (replaceCommandAlias (commandName buildCommand)) diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index 1ae2169be4e..89bbf441cff 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -36,9 +36,7 @@ import Distribution.Client.CmdInstall.ClientInstallFlags import Distribution.Client.CmdInstall.ClientInstallTargetSelector import Distribution.Client.Cmd.UI - ( cmdListOptions - , cmdOptionParsers - , replaceCommandAlias + ( replaceCommandAlias ) import qualified Distribution.Client.Cmd.UI as Cmd.UI import Distribution.Client.Config @@ -131,7 +129,6 @@ import Distribution.Simple.Command ( CommandParse (..) , CommandUI (..) , OptionField (..) - , ShowOrParseArgs (ParseArgs) , optionName , usageAlternatives ) @@ -1411,13 +1408,9 @@ isCommandName :: String -> Bool isCommandName name = name `elem` commandNames parseCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) -parseCommand invokedName cmdArgs = +parseCommand = Cmd.UI.parseCommand - invokedName - cmdArgs examples - (cmdOptionParsers (commandOptions installCommand ParseArgs)) installCommand - (cmdListOptions installCommand) installAction (replaceCommandAlias (commandName installCommand)) From f41155863839131fbf48150e63ea3984f5b552bf Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 16 Aug 2026 10:21:32 -0400 Subject: [PATCH 70/85] Simplify CommandReadyToGo --- cabal-install/src/Distribution/Client/Main.hs | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index 1d240c8a10b..419faa0a279 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -389,14 +389,16 @@ mainWorker args = do parseBuildOrInstallWithOptparse argv = case commandParseArgs globalCmd True argv of CommandReadyToGo (mkGlobalFlags, cmdArgs0) -> do - (cmdParser, cmdName : cmdArgs) <- case cmdArgs0 of - x@(n : _) - | CmdBuild.isCommandName n -> Just (CmdBuild.parseCommand, x) - | CmdInstall.isCommandName n -> Just (CmdInstall.parseCommand, x) - _ -> Nothing + cmdName : cmdArgs <- pure cmdArgs0 + cmdParser <- parserForCommand cmdName let globalFlags = mkGlobalFlags (commandDefaultFlags globalCmd) return $ CommandReadyToGo (globalFlags, cmdParser cmdName cmdArgs) _ -> Nothing + where + parserForCommand name + | CmdBuild.isCommandName name = Just CmdBuild.parseCommand + | CmdInstall.isCommandName name = Just CmdInstall.parseCommand + | otherwise = Nothing delegateToExternal :: [Command Action] From 1727cd00ae26730affdcc9bd5f3a85f99496ca43 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 16 Aug 2026 10:26:40 -0400 Subject: [PATCH 71/85] Satisfy HLint --- cabal-install/src/Distribution/Client/CmdBuild.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index f6a59af6f87..018374d1091 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -- | cabal-install CLI command: build module Distribution.Client.CmdBuild From a9ebfb5547b568a9c26d50d808d0245b46cce110 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 16 Aug 2026 13:57:35 -0400 Subject: [PATCH 72/85] Move changes to one region of module --- .../src/Distribution/Client/CmdBuild.hs | 82 +++++++++---------- .../src/Distribution/Client/CmdInstall.hs | 66 +++++++-------- 2 files changed, 74 insertions(+), 74 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 018374d1091..933d489abf9 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -59,29 +59,23 @@ import Distribution.Simple.Flag (Flag, fromFlag, toFlag) import Distribution.Simple.Utils (dieWithException, wrapText) import Distribution.Verbosity (normal) -buildCommand :: CommandUI (NixStyleFlags BuildFlags) -buildCommand = - CommandUI - { commandName = "v2-build" - , commandSynopsis = "Compile targets within the project." - , commandUsage = usageAlternatives "v2-build" ["[TARGETS] [FLAGS]"] - , commandDescription = Just $ \_ -> wrapText description - , commandNotes = Just $ \pname -> examples pname "v2-build" - , commandDefaultFlags = defaultNixStyleFlags defaultBuildFlags - , commandOptions = - removeIgnoreProjectOption - . nixStyleOptions - ( \showOrParseArgs -> - [ option - [] - ["only-configure"] - "Instead of performing a full build just run the configure step" - buildOnlyConfigure - (\v flags -> flags{buildOnlyConfigure = v}) - (yesNoOpt showOrParseArgs) - ] - ) - } +-- | The command name and aliases for the @build@ command. +-- +-- >>> commandNames +-- ["build","new-build","v2-build"] +commandNames :: [String] +commandNames = ["build", "new-build", commandName buildCommand] + +isCommandName :: String -> Bool +isCommandName name = name `elem` commandNames + +parseCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) +parseCommand = + Cmd.UI.parseCommand + examples + buildCommand + buildAction + (replaceCommandAlias (commandName buildCommand)) description :: String description = @@ -112,6 +106,30 @@ examples pname invokedName = , " Build the component in profiling mode (including dependencies as needed)" ] +buildCommand :: CommandUI (NixStyleFlags BuildFlags) +buildCommand = + CommandUI + { commandName = "v2-build" + , commandSynopsis = "Compile targets within the project." + , commandUsage = usageAlternatives "v2-build" ["[TARGETS] [FLAGS]"] + , commandDescription = Just $ \_ -> wrapText description + , commandNotes = Just $ \pname -> examples pname "v2-build" + , commandDefaultFlags = defaultNixStyleFlags defaultBuildFlags + , commandOptions = + removeIgnoreProjectOption + . nixStyleOptions + ( \showOrParseArgs -> + [ option + [] + ["only-configure"] + "Instead of performing a full build just run the configure step" + buildOnlyConfigure + (\v flags -> flags{buildOnlyConfigure = v}) + (yesNoOpt showOrParseArgs) + ] + ) + } + data BuildFlags = BuildFlags { buildOnlyConfigure :: Flag Bool } @@ -234,21 +252,3 @@ reportBuildTargetProblems verbosity problems = reportCannotPruneDependencies :: Verbosity -> CannotPruneDependencies -> IO a reportCannotPruneDependencies verbosity = dieWithException verbosity . ReportCannotPruneDependencies . renderCannotPruneDependencies - --- | The command name and aliases for the @build@ command. --- --- >>> commandNames --- ["build","new-build","v2-build"] -commandNames :: [String] -commandNames = ["build", "new-build", commandName buildCommand] - -isCommandName :: String -> Bool -isCommandName name = name `elem` commandNames - -parseCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) -parseCommand = - Cmd.UI.parseCommand - examples - buildCommand - buildAction - (replaceCommandAlias (commandName buildCommand)) diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index 89bbf441cff..e4d2090dff7 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -295,21 +295,23 @@ data InstallExe = InstallExe -- store. } -installCommand :: CommandUI (NixStyleFlags ClientInstallFlags) -installCommand = - CommandUI - { commandName = "v2-install" - , commandSynopsis = "Install packages." - , commandUsage = usageAlternatives "v2-install" ["[TARGETS] [FLAGS]"] - , commandDescription = Just $ \_ -> wrapText description - , commandNotes = Just $ \pname -> examples pname "v2-install" - , commandOptions = \x -> filter notInstallDirOpt $ nixStyleOptions clientInstallOptions x - , commandDefaultFlags = defaultNixStyleFlags defaultClientInstallFlags - } - where - -- install doesn't take installDirs flags, since it always installs into the store in a fixed way. - notInstallDirOpt x = optionName x `notElem` installDirOptNames - installDirOptNames = map optionName installDirsOptions +-- | The command name and aliases for the @install@ command. +-- +-- >>> commandNames +-- ["install","new-install","v2-install"] +commandNames :: [String] +commandNames = ["install", "new-install", commandName installCommand] + +isCommandName :: String -> Bool +isCommandName name = name `elem` commandNames + +parseCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) +parseCommand = + Cmd.UI.parseCommand + examples + installCommand + installAction + (replaceCommandAlias (commandName installCommand)) description :: String description = @@ -336,6 +338,22 @@ examples pname invokedName = , " Install the package in the ./pkgfoo directory" ] +installCommand :: CommandUI (NixStyleFlags ClientInstallFlags) +installCommand = + CommandUI + { commandName = "v2-install" + , commandSynopsis = "Install packages." + , commandUsage = usageAlternatives "v2-install" ["[TARGETS] [FLAGS]"] + , commandDescription = Just $ \_ -> wrapText description + , commandNotes = Just $ \pname -> examples pname "v2-install" + , commandOptions = \x -> filter notInstallDirOpt $ nixStyleOptions clientInstallOptions x + , commandDefaultFlags = defaultNixStyleFlags defaultClientInstallFlags + } + where + -- install doesn't take installDirs flags, since it always installs into the store in a fixed way. + notInstallDirOpt x = optionName x `notElem` installDirOptNames + installDirOptNames = map optionName installDirsOptions + -- | The @install@ command actually serves four different needs. It installs: -- * exes: -- For example a program from hackage. The behavior is similar to the old @@ -1396,21 +1414,3 @@ reportBuildTargetProblems verbosity problems = reportTargetProblems verbosity "b reportCannotPruneDependencies :: Verbosity -> CannotPruneDependencies -> IO a reportCannotPruneDependencies verbosity = dieWithException verbosity . SelectComponentTargetError . renderCannotPruneDependencies - --- | The command name and aliases for the @install@ command. --- --- >>> commandNames --- ["install","new-install","v2-install"] -commandNames :: [String] -commandNames = ["install", "new-install", commandName installCommand] - -isCommandName :: String -> Bool -isCommandName name = name `elem` commandNames - -parseCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) -parseCommand = - Cmd.UI.parseCommand - examples - installCommand - installAction - (replaceCommandAlias (commandName installCommand)) From 1bfb9c38f66e9387e21d814848df985a4a0435ca Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 16 Aug 2026 14:06:41 -0400 Subject: [PATCH 73/85] Get rid of isCommandName --- cabal-install/src/Distribution/Client/CmdBuild.hs | 1 - cabal-install/src/Distribution/Client/CmdInstall.hs | 11 ----------- cabal-install/src/Distribution/Client/Main.hs | 4 ++-- 3 files changed, 2 insertions(+), 14 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 933d489abf9..72406f2e17b 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -9,7 +9,6 @@ module Distribution.Client.CmdBuild , defaultBuildFlags -- * The @build@ CLI command spec and parser - , isCommandName , parseCommand -- * Internals exposed for testing diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index e4d2090dff7..faf20051ece 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -9,7 +9,6 @@ module Distribution.Client.CmdInstall , installAction -- * The @install@ CLI command spec and parser - , isCommandName , parseCommand -- * Internals exposed for testing @@ -295,16 +294,6 @@ data InstallExe = InstallExe -- store. } --- | The command name and aliases for the @install@ command. --- --- >>> commandNames --- ["install","new-install","v2-install"] -commandNames :: [String] -commandNames = ["install", "new-install", commandName installCommand] - -isCommandName :: String -> Bool -isCommandName name = name `elem` commandNames - parseCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) parseCommand = Cmd.UI.parseCommand diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index 419faa0a279..4d912ce0913 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -396,8 +396,8 @@ mainWorker args = do _ -> Nothing where parserForCommand name - | CmdBuild.isCommandName name = Just CmdBuild.parseCommand - | CmdInstall.isCommandName name = Just CmdInstall.parseCommand + | name `elem` ["build", "new-build", commandName CmdBuild.buildCommand] = Just CmdBuild.parseCommand + | name `elem` ["install", "new-install", commandName CmdInstall.installCommand] = Just CmdInstall.parseCommand | otherwise = Nothing delegateToExternal From 242c6ea6905fae6917e8e73cf6215816b359d1f5 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 16 Aug 2026 14:17:09 -0400 Subject: [PATCH 74/85] Add commandNames --- cabal-install/src/Distribution/Client/Cmd/UI.hs | 17 +++++++++++++++-- .../src/Distribution/Client/CmdBuild.hs | 10 ---------- cabal-install/src/Distribution/Client/Main.hs | 6 +++--- 3 files changed, 18 insertions(+), 15 deletions(-) diff --git a/cabal-install/src/Distribution/Client/Cmd/UI.hs b/cabal-install/src/Distribution/Client/Cmd/UI.hs index 30c059d9f43..2f740ebffda 100644 --- a/cabal-install/src/Distribution/Client/Cmd/UI.hs +++ b/cabal-install/src/Distribution/Client/Cmd/UI.hs @@ -21,6 +21,7 @@ module Distribution.Client.Cmd.UI , cmdOptionParsers , cmdSpec , cmdListOptions + , commandNames , parseCommand , replaceCommandAlias , helpDescriptionOrSynopsis @@ -124,9 +125,21 @@ data ParsedCommand a = ParsedCommand type Examples = String -> String -> String +replaceText :: String -> String -> String -> String +replaceText old new = T.unpack . T.replace (T.pack old) (T.pack new) . T.pack + +commandNames :: CommandUI flags -> [String] +commandNames command = + [ replaceText "v2-" "" name + , replaceText "v2-" "new-" name + , name + ] + where + name = commandName command + replaceCommandAlias :: String -> ReplaceCommandAlias replaceCommandAlias commandName invokedName = - T.unpack . T.replace (T.pack commandName) (T.pack invokedName) . T.pack + replaceText commandName invokedName cmdSpec :: CommandUI flags @@ -135,7 +148,7 @@ cmdSpec cmdSpec command action = [CommandSpec ui (`commandAddAction` action) NormalCommand] where - defaultMsg = T.unpack . T.replace "v2-" "" . T.pack + defaultMsg = replaceText "v2-" "" ui = command { commandName = defaultMsg (commandName command) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 72406f2e17b..cf84847a31f 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -58,16 +58,6 @@ import Distribution.Simple.Flag (Flag, fromFlag, toFlag) import Distribution.Simple.Utils (dieWithException, wrapText) import Distribution.Verbosity (normal) --- | The command name and aliases for the @build@ command. --- --- >>> commandNames --- ["build","new-build","v2-build"] -commandNames :: [String] -commandNames = ["build", "new-build", commandName buildCommand] - -isCommandName :: String -> Bool -isCommandName name = name `elem` commandNames - parseCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) parseCommand = Cmd.UI.parseCommand diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index 4d912ce0913..afe3d4b09d5 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -182,7 +182,7 @@ import Distribution.PackageDescription , buildable ) -import Distribution.Client.Cmd.UI (cmdSpec) +import Distribution.Client.Cmd.UI (cmdSpec, commandNames) import Distribution.Client.Errors import Distribution.Compat.ResponseFile import Distribution.PackageDescription.PrettyPrint @@ -396,8 +396,8 @@ mainWorker args = do _ -> Nothing where parserForCommand name - | name `elem` ["build", "new-build", commandName CmdBuild.buildCommand] = Just CmdBuild.parseCommand - | name `elem` ["install", "new-install", commandName CmdInstall.installCommand] = Just CmdInstall.parseCommand + | name `elem` commandNames CmdBuild.buildCommand = Just CmdBuild.parseCommand + | name `elem` commandNames CmdInstall.installCommand = Just CmdInstall.parseCommand | otherwise = Nothing delegateToExternal From 4dde573fc208d6c8ffd44de777a8732f5cd3efc4 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 16 Aug 2026 14:22:58 -0400 Subject: [PATCH 75/85] Use replace from generic-sop-lens --- cabal-install/src/Distribution/Client/Cmd/UI.hs | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/cabal-install/src/Distribution/Client/Cmd/UI.hs b/cabal-install/src/Distribution/Client/Cmd/UI.hs index 2f740ebffda..74ccc2471e7 100644 --- a/cabal-install/src/Distribution/Client/Cmd/UI.hs +++ b/cabal-install/src/Distribution/Client/Cmd/UI.hs @@ -125,13 +125,22 @@ data ParsedCommand a = ParsedCommand type Examples = String -> String -> String +-- SEE: generic-sop-lens.hs replaceText :: String -> String -> String -> String -replaceText old new = T.unpack . T.replace (T.pack old) (T.pack new) . T.pack +replaceText needle replacement = go + where + go [] = [] + go input@(char : rest) + | Just remainder <- stripPrefix needle input = replacement ++ go remainder + | otherwise = char : go rest + +replaceV2 :: String -> String -> String +replaceV2 = replaceText "v2-" commandNames :: CommandUI flags -> [String] commandNames command = - [ replaceText "v2-" "" name - , replaceText "v2-" "new-" name + [ replaceV2 "" name + , replaceV2 "new-" name , name ] where @@ -148,7 +157,7 @@ cmdSpec cmdSpec command action = [CommandSpec ui (`commandAddAction` action) NormalCommand] where - defaultMsg = replaceText "v2-" "" + defaultMsg = replaceV2 "" ui = command { commandName = defaultMsg (commandName command) From 02bc75c71b42ccc0b0212445da5b28b9b93266d7 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 16 Aug 2026 14:27:17 -0400 Subject: [PATCH 76/85] Rename defaultMsg to stripVersionPrefix --- cabal-install/src/Distribution/Client/Cmd/UI.hs | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/cabal-install/src/Distribution/Client/Cmd/UI.hs b/cabal-install/src/Distribution/Client/Cmd/UI.hs index 74ccc2471e7..0948bca388f 100644 --- a/cabal-install/src/Distribution/Client/Cmd/UI.hs +++ b/cabal-install/src/Distribution/Client/Cmd/UI.hs @@ -137,9 +137,12 @@ replaceText needle replacement = go replaceV2 :: String -> String -> String replaceV2 = replaceText "v2-" +stripVersionPrefix :: String -> String +stripVersionPrefix = replaceV2 "" + commandNames :: CommandUI flags -> [String] commandNames command = - [ replaceV2 "" name + [ stripVersionPrefix name , replaceV2 "new-" name , name ] @@ -157,13 +160,12 @@ cmdSpec cmdSpec command action = [CommandSpec ui (`commandAddAction` action) NormalCommand] where - defaultMsg = replaceV2 "" ui = command - { commandName = defaultMsg (commandName command) - , commandUsage = defaultMsg . commandUsage command - , commandDescription = (defaultMsg .) <$> commandDescription command - , commandNotes = (defaultMsg .) <$> commandNotes command + { commandName = stripVersionPrefix (commandName command) + , commandUsage = stripVersionPrefix . commandUsage command + , commandDescription = (stripVersionPrefix .) <$> commandDescription command + , commandNotes = (stripVersionPrefix .) <$> commandNotes command } cmdListOptions :: CommandUI flags -> [String] From 0dedd2d6fd34f1444329f2f5e5bc85d25911c27f Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 16 Aug 2026 14:34:04 -0400 Subject: [PATCH 77/85] Move ReplaceCommandAlias --- cabal-install/src/Distribution/Client/Cmd/UI.hs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/cabal-install/src/Distribution/Client/Cmd/UI.hs b/cabal-install/src/Distribution/Client/Cmd/UI.hs index 0948bca388f..6ac8ea75538 100644 --- a/cabal-install/src/Distribution/Client/Cmd/UI.hs +++ b/cabal-install/src/Distribution/Client/Cmd/UI.hs @@ -124,6 +124,7 @@ data ParsedCommand a = ParsedCommand } type Examples = String -> String -> String +type ReplaceCommandAlias = String -> String -> String -- SEE: generic-sop-lens.hs replaceText :: String -> String -> String -> String @@ -150,8 +151,7 @@ commandNames command = name = commandName command replaceCommandAlias :: String -> ReplaceCommandAlias -replaceCommandAlias commandName invokedName = - replaceText commandName invokedName +replaceCommandAlias = replaceText cmdSpec :: CommandUI flags @@ -510,8 +510,6 @@ groupPredicates = , (ProgramOverrideOptions, keepProgOptions) ] -type ReplaceCommandAlias = String -> String -> String - helpText :: ReplaceCommandAlias -> CommandUI (NixStyleFlags a) -> String -> String -> String helpText replaceBuildAlias buildCommand invokedName pname = commandSynopsis buildCommand From a695203e2fa89de07e04c84d5c1e829847d85c5c Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 16 Aug 2026 21:21:23 -0400 Subject: [PATCH 78/85] Add haddocks to Examples --- cabal-install/src/Distribution/Client/Cmd/UI.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/cabal-install/src/Distribution/Client/Cmd/UI.hs b/cabal-install/src/Distribution/Client/Cmd/UI.hs index 6ac8ea75538..4ce3732ba7c 100644 --- a/cabal-install/src/Distribution/Client/Cmd/UI.hs +++ b/cabal-install/src/Distribution/Client/Cmd/UI.hs @@ -14,6 +14,7 @@ module Distribution.Client.Cmd.UI , optDescrToGetOpt -- * Command data types + , Examples , CmdItem (..) , ParsedCommand (..) , parsedCommandParser @@ -123,7 +124,11 @@ data ParsedCommand a = ParsedCommand , parsedListOptions :: Bool } -type Examples = String -> String -> String +type Examples + = String -- ^ program name + -> String -- ^ command name + -> String -- ^ examples text + type ReplaceCommandAlias = String -> String -> String -- SEE: generic-sop-lens.hs From 2b9518c3facc63886ce4927b53515767d5c897f1 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 16 Aug 2026 21:26:12 -0400 Subject: [PATCH 79/85] Addhaddocks for ReplaceCommandAlias --- cabal-install/src/Distribution/Client/Cmd/UI.hs | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/cabal-install/src/Distribution/Client/Cmd/UI.hs b/cabal-install/src/Distribution/Client/Cmd/UI.hs index 4ce3732ba7c..22b61716d48 100644 --- a/cabal-install/src/Distribution/Client/Cmd/UI.hs +++ b/cabal-install/src/Distribution/Client/Cmd/UI.hs @@ -15,6 +15,7 @@ module Distribution.Client.Cmd.UI -- * Command data types , Examples + , ReplaceCommandAlias , CmdItem (..) , ParsedCommand (..) , parsedCommandParser @@ -124,12 +125,20 @@ data ParsedCommand a = ParsedCommand , parsedListOptions :: Bool } +-- | Examples text for a command, given the program name and command name. type Examples = String -- ^ program name -> String -- ^ command name -> String -- ^ examples text -type ReplaceCommandAlias = String -> String -> String +-- | Replacements for v2- prefixed commands, such as; +-- +-- * v2-build -> new-build or +-- * v2-build -> build. +type ReplaceCommandAlias + = String -- ^ the new prefix + -> String -- ^ the command + -> String -- ^ the command name with the prefix replaced -- SEE: generic-sop-lens.hs replaceText :: String -> String -> String -> String From 22b3dd5fe01bf8730d65f15549f30b597147aa2d Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 16 Aug 2026 21:39:44 -0400 Subject: [PATCH 80/85] Add haddocks to prefix functions --- cabal-install/src/Distribution/Client/Cmd/UI.hs | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/cabal-install/src/Distribution/Client/Cmd/UI.hs b/cabal-install/src/Distribution/Client/Cmd/UI.hs index 22b61716d48..e0e6248ed7a 100644 --- a/cabal-install/src/Distribution/Client/Cmd/UI.hs +++ b/cabal-install/src/Distribution/Client/Cmd/UI.hs @@ -149,16 +149,21 @@ replaceText needle replacement = go | Just remainder <- stripPrefix needle input = replacement ++ go remainder | otherwise = char : go rest -replaceV2 :: String -> String -> String -replaceV2 = replaceText "v2-" +-- | Puts a prefix before a bare command name. +affixVersionPrefix :: String -> String -> String +affixVersionPrefix = replaceText "v2-" +-- | Removes the v2- prefix from a command name, leaving the bare command name. stripVersionPrefix :: String -> String -stripVersionPrefix = replaceV2 "" +stripVersionPrefix = affixVersionPrefix "" +-- | Assuming a v2- prefix for a command name, for the 'commandName' of the +-- given command, makes a list that includes the bare name, the new- prefixed +-- name, and the v2- prefixed name. commandNames :: CommandUI flags -> [String] commandNames command = [ stripVersionPrefix name - , replaceV2 "new-" name + , affixVersionPrefix "new-" name , name ] where From b400d3b1ccf1c3f2903aff37aa0ac763face2d99 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 16 Aug 2026 21:45:09 -0400 Subject: [PATCH 81/85] Add haddocks to replaceCommandAlias --- .../src/Distribution/Client/Cmd/UI.hs | 30 ++++++++++++------- 1 file changed, 19 insertions(+), 11 deletions(-) diff --git a/cabal-install/src/Distribution/Client/Cmd/UI.hs b/cabal-install/src/Distribution/Client/Cmd/UI.hs index e0e6248ed7a..23aeb1a673f 100644 --- a/cabal-install/src/Distribution/Client/Cmd/UI.hs +++ b/cabal-install/src/Distribution/Client/Cmd/UI.hs @@ -126,19 +126,30 @@ data ParsedCommand a = ParsedCommand } -- | Examples text for a command, given the program name and command name. -type Examples - = String -- ^ program name - -> String -- ^ command name - -> String -- ^ examples text +type Examples = + String + -- ^ program name + -> String + -- ^ command name + -> String + -- ^ examples text -- | Replacements for v2- prefixed commands, such as; -- -- * v2-build -> new-build or -- * v2-build -> build. -type ReplaceCommandAlias - = String -- ^ the new prefix - -> String -- ^ the command - -> String -- ^ the command name with the prefix replaced +type ReplaceCommandAlias = + String + -- ^ the new prefix + -> String + -- ^ the command + -> String + -- ^ the command name with the prefix replaced + +-- | Given a v2- prefixed command name, returns a function for replacing that +-- prefix with a new prefix. +replaceCommandAlias :: String -> ReplaceCommandAlias +replaceCommandAlias = replaceText -- SEE: generic-sop-lens.hs replaceText :: String -> String -> String -> String @@ -169,9 +180,6 @@ commandNames command = where name = commandName command -replaceCommandAlias :: String -> ReplaceCommandAlias -replaceCommandAlias = replaceText - cmdSpec :: CommandUI flags -> (flags -> [String] -> action) From 3436804fb343aae994292270d4cde5e0cb6631d2 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Tue, 18 Aug 2026 12:28:00 -0400 Subject: [PATCH 82/85] Move parseCommandWithOptParse to Cmd.UI --- cabal-install/src/Distribution/Client/Cmd/UI.hs | 15 +++++++++++++++ cabal-install/src/Distribution/Client/Main.hs | 17 +++++++---------- 2 files changed, 22 insertions(+), 10 deletions(-) diff --git a/cabal-install/src/Distribution/Client/Cmd/UI.hs b/cabal-install/src/Distribution/Client/Cmd/UI.hs index 23aeb1a673f..56ccb3ec842 100644 --- a/cabal-install/src/Distribution/Client/Cmd/UI.hs +++ b/cabal-install/src/Distribution/Client/Cmd/UI.hs @@ -24,6 +24,7 @@ module Distribution.Client.Cmd.UI , cmdSpec , cmdListOptions , commandNames + , parseCommandWithOptparse , parseCommand , replaceCommandAlias , helpDescriptionOrSynopsis @@ -228,6 +229,20 @@ parseCommand examples cmdui action replaceAlias invokedName cmdArgs = pInfo = parserInfo invokedName examples flagParsers cmdui flagParsers = cmdOptionParsers (commandOptions cmdui ParseArgs) +parseCommandWithOptparse + :: CommandUI globalFlags + -> (String -> Maybe (String -> [String] -> CommandParse action)) + -> [String] + -> Maybe (CommandParse (globalFlags, CommandParse action)) +parseCommandWithOptparse globalCommand parserForCommand argv = + case commandParseArgs globalCommand True argv of + CommandReadyToGo (mkGlobalFlags, cmdArgs0) -> do + cmdName : cmdArgs <- pure cmdArgs0 + cmdParser <- parserForCommand cmdName + let globalFlags = mkGlobalFlags (commandDefaultFlags globalCommand) + pure $ CommandReadyToGo (globalFlags, cmdParser cmdName cmdArgs) + _ -> Nothing + parserInfo :: String -> Examples -> [O.Parser (CmdItem a)] -> CommandUI flags -> ParserInfo (ParsedCommand a) parserInfo invokedName examples flagParsers cmdui = info diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index afe3d4b09d5..ed25e475ffd 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -182,7 +182,11 @@ import Distribution.PackageDescription , buildable ) -import Distribution.Client.Cmd.UI (cmdSpec, commandNames) +import Distribution.Client.Cmd.UI + ( cmdSpec + , commandNames + , parseCommandWithOptparse + ) import Distribution.Client.Errors import Distribution.Compat.ResponseFile import Distribution.PackageDescription.PrettyPrint @@ -200,7 +204,6 @@ import Distribution.Simple.Command , CommandUI (..) , commandAddAction , commandFromSpec - , commandParseArgs , commandShowOptions , commandsRunWithFallback , defaultCommandFallback @@ -386,14 +389,8 @@ mainWorker args = do Nothing -> commandsRunWithFallback globalCmd commands delegateToExternal argv parseBuildOrInstallWithOptparse :: [String] -> Maybe (CommandParse (GlobalFlags, CommandParse Action)) - parseBuildOrInstallWithOptparse argv = - case commandParseArgs globalCmd True argv of - CommandReadyToGo (mkGlobalFlags, cmdArgs0) -> do - cmdName : cmdArgs <- pure cmdArgs0 - cmdParser <- parserForCommand cmdName - let globalFlags = mkGlobalFlags (commandDefaultFlags globalCmd) - return $ CommandReadyToGo (globalFlags, cmdParser cmdName cmdArgs) - _ -> Nothing + parseBuildOrInstallWithOptparse = + parseCommandWithOptparse globalCmd parserForCommand where parserForCommand name | name `elem` commandNames CmdBuild.buildCommand = Just CmdBuild.parseCommand From 50af50b3561b1c805141cbf2aab87d59813ccdbd Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Tue, 18 Aug 2026 14:10:45 -0400 Subject: [PATCH 83/85] Remove parseCommand wrappers --- .../src/Distribution/Client/Cmd/UI.hs | 5 ++--- .../src/Distribution/Client/CmdBuild.hs | 19 ++----------------- .../src/Distribution/Client/CmdInstall.hs | 19 ++----------------- cabal-install/src/Distribution/Client/Main.hs | 7 +++++-- 4 files changed, 11 insertions(+), 39 deletions(-) diff --git a/cabal-install/src/Distribution/Client/Cmd/UI.hs b/cabal-install/src/Distribution/Client/Cmd/UI.hs index 56ccb3ec842..59dcc666184 100644 --- a/cabal-install/src/Distribution/Client/Cmd/UI.hs +++ b/cabal-install/src/Distribution/Client/Cmd/UI.hs @@ -206,11 +206,10 @@ parseCommand :: Examples -> CommandUI (NixStyleFlags a) -> (NixStyleFlags a -> [String] -> action) - -> ReplaceCommandAlias -> String -> [String] -> CommandParse action -parseCommand examples cmdui action replaceAlias invokedName cmdArgs = +parseCommand examples cmdui action invokedName cmdArgs = case execParserPure defaultPrefs pInfo cmdArgs of Success parsed -> if parsedListOptions parsed @@ -221,7 +220,7 @@ parseCommand examples cmdui action replaceAlias invokedName cmdArgs = Failure failure -> let (msg, exitCode) = renderFailure failure ("cabal " ++ invokedName) in if exitCode == ExitSuccess - then CommandHelp (helpText replaceAlias cmdui invokedName) + then CommandHelp (helpText (replaceCommandAlias (commandName cmdui)) cmdui invokedName) else CommandErrors [msg] CompletionInvoked _ -> CommandErrors ["Shell completion is not supported by this parser path."] diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index cf84847a31f..552161f86d9 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -5,12 +5,10 @@ module Distribution.Client.CmdBuild ( -- * The @build@ CLI command UI and action buildCommand , buildAction + , examples , BuildFlags (..) , defaultBuildFlags - -- * The @build@ CLI command spec and parser - , parseCommand - -- * Internals exposed for testing , selectPackageTargets , selectComponentTarget @@ -30,10 +28,6 @@ import Distribution.Client.TargetProblem ) import qualified Data.Map as Map -import Distribution.Client.Cmd.UI - ( replaceCommandAlias - ) -import qualified Distribution.Client.Cmd.UI as Cmd.UI import Distribution.Client.Errors import Distribution.Client.NixStyleOptions ( NixStyleFlags (..) @@ -49,8 +43,7 @@ import Distribution.Client.ScriptUtils ) import Distribution.Client.Setup (GlobalFlags, yesNoOpt) import Distribution.Simple.Command - ( CommandParse (..) - , CommandUI (..) + ( CommandUI (..) , option , usageAlternatives ) @@ -58,14 +51,6 @@ import Distribution.Simple.Flag (Flag, fromFlag, toFlag) import Distribution.Simple.Utils (dieWithException, wrapText) import Distribution.Verbosity (normal) -parseCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) -parseCommand = - Cmd.UI.parseCommand - examples - buildCommand - buildAction - (replaceCommandAlias (commandName buildCommand)) - description :: String description = "Build one or more targets from within the project. The available " diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index faf20051ece..c78c7fe85cf 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -7,9 +7,7 @@ module Distribution.Client.CmdInstall ( -- * The @install@ CLI command UI and action installCommand , installAction - - -- * The @install@ CLI command spec and parser - , parseCommand + , examples -- * Internals exposed for testing , selectPackageTargets @@ -34,10 +32,6 @@ import Distribution.Client.TargetProblem import Distribution.Client.CmdInstall.ClientInstallFlags import Distribution.Client.CmdInstall.ClientInstallTargetSelector -import Distribution.Client.Cmd.UI - ( replaceCommandAlias - ) -import qualified Distribution.Client.Cmd.UI as Cmd.UI import Distribution.Client.Config ( SavedConfig (..) , defaultInstallPath @@ -125,8 +119,7 @@ import Distribution.Simple.BuildPaths ( exeExtension ) import Distribution.Simple.Command - ( CommandParse (..) - , CommandUI (..) + ( CommandUI (..) , OptionField (..) , optionName , usageAlternatives @@ -294,14 +287,6 @@ data InstallExe = InstallExe -- store. } -parseCommand :: String -> [String] -> CommandParse (GlobalFlags -> IO ()) -parseCommand = - Cmd.UI.parseCommand - examples - installCommand - installAction - (replaceCommandAlias (commandName installCommand)) - description :: String description = "Installs one or more packages. This is done by installing them " diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index ed25e475ffd..08a9dcf124d 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -185,6 +185,7 @@ import Distribution.PackageDescription import Distribution.Client.Cmd.UI ( cmdSpec , commandNames + , parseCommand , parseCommandWithOptparse ) import Distribution.Client.Errors @@ -393,8 +394,10 @@ mainWorker args = do parseCommandWithOptparse globalCmd parserForCommand where parserForCommand name - | name `elem` commandNames CmdBuild.buildCommand = Just CmdBuild.parseCommand - | name `elem` commandNames CmdInstall.installCommand = Just CmdInstall.parseCommand + | name `elem` commandNames CmdBuild.buildCommand = + Just $ parseCommand CmdBuild.examples CmdBuild.buildCommand CmdBuild.buildAction + | name `elem` commandNames CmdInstall.installCommand = + Just $ parseCommand CmdInstall.examples CmdInstall.installCommand CmdInstall.installAction | otherwise = Nothing delegateToExternal From dcfb788630f58926edf198e996a278fc5274d9fe Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Tue, 18 Aug 2026 14:29:03 -0400 Subject: [PATCH 84/85] Add parseCommandWithOptparseMany --- .../src/Distribution/Client/Cmd/UI.hs | 38 +++++++++++++++++++ cabal-install/src/Distribution/Client/Main.hs | 20 +++++----- 2 files changed, 47 insertions(+), 11 deletions(-) diff --git a/cabal-install/src/Distribution/Client/Cmd/UI.hs b/cabal-install/src/Distribution/Client/Cmd/UI.hs index 59dcc666184..d157f24461b 100644 --- a/cabal-install/src/Distribution/Client/Cmd/UI.hs +++ b/cabal-install/src/Distribution/Client/Cmd/UI.hs @@ -24,7 +24,10 @@ module Distribution.Client.Cmd.UI , cmdSpec , cmdListOptions , commandNames + , NamedCommandParser (..) + , commandParserByName , parseCommandWithOptparse + , parseCommandWithOptparseMany , parseCommand , replaceCommandAlias , helpDescriptionOrSynopsis @@ -242,6 +245,41 @@ parseCommandWithOptparse globalCommand parserForCommand argv = pure $ CommandReadyToGo (globalFlags, cmdParser cmdName cmdArgs) _ -> Nothing +-- | A parser for one or more command names. +data NamedCommandParser action = NamedCommandParser + { namedCommandNames :: [String] + -- ^ The command name and its aliases. + , namedCommandParser :: String -> [String] -> CommandParse action + } + +-- | Wrap a command's optparse parser together with the names it should match. +commandParserByName + :: Examples + -> CommandUI (NixStyleFlags flags) + -> (NixStyleFlags flags -> [String] -> action) + -> NamedCommandParser action +commandParserByName examples command action = + NamedCommandParser + { namedCommandNames = commandNames command + , namedCommandParser = \name args -> parseCommand examples command action name args + } + +-- | Parse a command using a list of name/parser associations, picking the first +-- match in the list. +parseCommandWithOptparseMany + :: CommandUI globalFlags + -> [NamedCommandParser action] + -> [String] + -> Maybe (CommandParse (globalFlags, CommandParse action)) +parseCommandWithOptparseMany globalCommand commands argv = + case commandParseArgs globalCommand True argv of + CommandReadyToGo (mkGlobalFlags, cmdArgs0) -> do + cmdName : cmdArgs <- pure cmdArgs0 + parser <- find ((cmdName `elem`) . namedCommandNames) commands + let globalFlags = mkGlobalFlags (commandDefaultFlags globalCommand) + pure $ CommandReadyToGo (globalFlags, namedCommandParser parser cmdName cmdArgs) + _ -> Nothing + parserInfo :: String -> Examples -> [O.Parser (CmdItem a)] -> CommandUI flags -> ParserInfo (ParsedCommand a) parserInfo invokedName examples flagParsers cmdui = info diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index 08a9dcf124d..efb047e0462 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -184,9 +184,8 @@ import Distribution.PackageDescription import Distribution.Client.Cmd.UI ( cmdSpec - , commandNames - , parseCommand - , parseCommandWithOptparse + , commandParserByName + , parseCommandWithOptparseMany ) import Distribution.Client.Errors import Distribution.Compat.ResponseFile @@ -383,6 +382,8 @@ mainWorker args = do warnIfAssertionsAreEnabled action globalFlags where + -- Tries to parse the command line arguments with optparse-applicative + -- first, and if that fails, falls back to the standard command registry. commandsRunBuildOptparseFirst :: [String] -> IO (CommandParse (GlobalFlags, CommandParse Action)) commandsRunBuildOptparseFirst argv = case parseBuildOrInstallWithOptparse argv of @@ -391,14 +392,11 @@ mainWorker args = do parseBuildOrInstallWithOptparse :: [String] -> Maybe (CommandParse (GlobalFlags, CommandParse Action)) parseBuildOrInstallWithOptparse = - parseCommandWithOptparse globalCmd parserForCommand - where - parserForCommand name - | name `elem` commandNames CmdBuild.buildCommand = - Just $ parseCommand CmdBuild.examples CmdBuild.buildCommand CmdBuild.buildAction - | name `elem` commandNames CmdInstall.installCommand = - Just $ parseCommand CmdInstall.examples CmdInstall.installCommand CmdInstall.installAction - | otherwise = Nothing + parseCommandWithOptparseMany + globalCmd + [ commandParserByName CmdBuild.examples CmdBuild.buildCommand CmdBuild.buildAction + , commandParserByName CmdInstall.examples CmdInstall.installCommand CmdInstall.installAction + ] delegateToExternal :: [Command Action] From 329927f8bcc6fbedd5d83d648d0f22019ba6fad6 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Tue, 18 Aug 2026 15:00:11 -0400 Subject: [PATCH 85/85] Renaming and use parseMany --- cabal-install/src/Distribution/Client/Main.hs | 19 ++++++++----------- 1 file changed, 8 insertions(+), 11 deletions(-) diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index efb047e0462..17bbc3da55c 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -350,7 +350,7 @@ warnIfAssertionsAreEnabled = mainWorker :: [String] -> IO () mainWorker args = do topHandler (isUserException (Proxy @(VerboseException CabalInstallException))) $ do - command <- commandsRunBuildOptparseFirst args + command <- commandsParse args case command of CommandHelp help -> printGlobalHelp help CommandList opts -> printOptionsList opts @@ -384,19 +384,16 @@ mainWorker args = do where -- Tries to parse the command line arguments with optparse-applicative -- first, and if that fails, falls back to the standard command registry. - commandsRunBuildOptparseFirst :: [String] -> IO (CommandParse (GlobalFlags, CommandParse Action)) - commandsRunBuildOptparseFirst argv = - case parseBuildOrInstallWithOptparse argv of + commandsParse :: [String] -> IO (CommandParse (GlobalFlags, CommandParse Action)) + commandsParse argv = + case parseCommandWithOptparseMany globalCmd parsersByName argv of Just parsed -> pure parsed Nothing -> commandsRunWithFallback globalCmd commands delegateToExternal argv - parseBuildOrInstallWithOptparse :: [String] -> Maybe (CommandParse (GlobalFlags, CommandParse Action)) - parseBuildOrInstallWithOptparse = - parseCommandWithOptparseMany - globalCmd - [ commandParserByName CmdBuild.examples CmdBuild.buildCommand CmdBuild.buildAction - , commandParserByName CmdInstall.examples CmdInstall.installCommand CmdInstall.installAction - ] + parsersByName = + [ commandParserByName CmdBuild.examples CmdBuild.buildCommand CmdBuild.buildAction + , commandParserByName CmdInstall.examples CmdInstall.installCommand CmdInstall.installAction + ] delegateToExternal :: [Command Action]