From ef2ab12efa8cfd3b9101e3b7d030cd26d7fe5732 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 29 Dec 2024 07:01:22 -0500 Subject: [PATCH] withContextAndSelectors taking verbosity --- cabal-install/src/Distribution/Client/CmdBuild.hs | 2 +- .../src/Distribution/Client/CmdHaddockProject.hs | 1 + cabal-install/src/Distribution/Client/CmdListBin.hs | 2 +- cabal-install/src/Distribution/Client/CmdPath.hs | 2 +- cabal-install/src/Distribution/Client/CmdRun.hs | 5 +++-- .../src/Distribution/Client/ScriptUtils.hs | 13 ++++--------- 6 files changed, 11 insertions(+), 14 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index 44f1c4e0f27..21231988eca 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -135,7 +135,7 @@ defaultBuildFlags = -- "Distribution.Client.ProjectOrchestration" buildAction :: NixStyleFlags BuildFlags -> [String] -> GlobalFlags -> IO () buildAction flags@NixStyleFlags{extraFlags = buildFlags, ..} targetStrings globalFlags = - withContextAndSelectors RejectNoTargets Nothing flags targetStrings globalFlags BuildCommand $ \targetCtx ctx targetSelectors -> do + withContextAndSelectors verbosity RejectNoTargets Nothing flags targetStrings globalFlags BuildCommand $ \targetCtx ctx targetSelectors -> do -- TODO: This flags defaults business is ugly let onlyConfigure = fromFlag diff --git a/cabal-install/src/Distribution/Client/CmdHaddockProject.hs b/cabal-install/src/Distribution/Client/CmdHaddockProject.hs index 0635a77d68e..8a631d9a989 100644 --- a/cabal-install/src/Distribution/Client/CmdHaddockProject.hs +++ b/cabal-install/src/Distribution/Client/CmdHaddockProject.hs @@ -124,6 +124,7 @@ haddockProjectAction flags _extraArgs globalFlags = do -- withContextAndSelectors + verbosity RejectNoTargets Nothing (commandDefaultFlags CmdBuild.buildCommand) diff --git a/cabal-install/src/Distribution/Client/CmdListBin.hs b/cabal-install/src/Distribution/Client/CmdListBin.hs index df16b98e1a2..ec9b5d7a76e 100644 --- a/cabal-install/src/Distribution/Client/CmdListBin.hs +++ b/cabal-install/src/Distribution/Client/CmdListBin.hs @@ -94,7 +94,7 @@ listbinAction flags@NixStyleFlags{..} args globalFlags = do _ -> dieWithException verbosity OneTargetRequired -- configure and elaborate target selectors - withContextAndSelectors RejectNoTargets (Just ExeKind) flags [target] globalFlags OtherCommand $ \targetCtx ctx targetSelectors -> do + withContextAndSelectors verbosity RejectNoTargets (Just ExeKind) flags [target] globalFlags OtherCommand $ \targetCtx ctx targetSelectors -> do baseCtx <- case targetCtx of ProjectContext -> return ctx GlobalContext -> return ctx diff --git a/cabal-install/src/Distribution/Client/CmdPath.hs b/cabal-install/src/Distribution/Client/CmdPath.hs index 7c294d0b9a2..d4e3eead31b 100644 --- a/cabal-install/src/Distribution/Client/CmdPath.hs +++ b/cabal-install/src/Distribution/Client/CmdPath.hs @@ -228,7 +228,7 @@ pathName ConfigPathInstallDir = "installdir" -- | Entry point for the 'path' command. pathAction :: NixStyleFlags PathFlags -> [String] -> GlobalFlags -> IO () -pathAction flags@NixStyleFlags{extraFlags = pathFlags', ..} cliTargetStrings globalFlags = withContextAndSelectors AcceptNoTargets Nothing flags [] globalFlags OtherCommand $ \_ baseCtx _ -> do +pathAction flags@NixStyleFlags{extraFlags = pathFlags', ..} cliTargetStrings globalFlags = withContextAndSelectors verbosity AcceptNoTargets Nothing flags [] globalFlags OtherCommand $ \_ baseCtx _ -> do let pathFlags = if pathCompiler pathFlags' == NoFlag && pathDirectories pathFlags' == NoFlag then -- if not a single key to query is given, query everything! diff --git a/cabal-install/src/Distribution/Client/CmdRun.hs b/cabal-install/src/Distribution/Client/CmdRun.hs index 0000a2927a1..e2241f95c79 100644 --- a/cabal-install/src/Distribution/Client/CmdRun.hs +++ b/cabal-install/src/Distribution/Client/CmdRun.hs @@ -206,13 +206,13 @@ runCommand = -- "Distribution.Client.ProjectOrchestration" runAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO () runAction flags@NixStyleFlags{..} targetAndArgs globalFlags = - withContextAndSelectors RejectNoTargets (Just ExeKind) flags targetStr globalFlags OtherCommand $ \targetCtx ctx targetSelectors -> do + withContextAndSelectors (cfgVerbosity normal) RejectNoTargets (Just ExeKind) flags targetStr globalFlags OtherCommand $ \targetCtx ctx targetSelectors -> do (baseCtx, defaultVerbosity) <- case targetCtx of ProjectContext -> return (ctx, normal) GlobalContext -> return (ctx, normal) ScriptContext path exemeta -> (,silent) <$> updateContextAndWriteProjectFile ctx path exemeta - let verbosity = fromFlagOrDefault defaultVerbosity (setupVerbosity $ configCommonFlags configFlags) + let verbosity = cfgVerbosity defaultVerbosity buildCtx <- runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do @@ -360,6 +360,7 @@ runAction flags@NixStyleFlags{..} targetAndArgs globalFlags = elaboratedPlan } where + cfgVerbosity v = fromFlagOrDefault v (setupVerbosity $ configCommonFlags configFlags) (targetStr, args) = splitAt 1 targetAndArgs -- | Used by the main CLI parser as heuristic to decide whether @cabal@ was diff --git a/cabal-install/src/Distribution/Client/ScriptUtils.hs b/cabal-install/src/Distribution/Client/ScriptUtils.hs index f397f4342c5..673a6e96acc 100644 --- a/cabal-install/src/Distribution/Client/ScriptUtils.hs +++ b/cabal-install/src/Distribution/Client/ScriptUtils.hs @@ -75,9 +75,7 @@ import Distribution.Client.RebuildMonad ( runRebuild ) import Distribution.Client.Setup - ( CommonSetupFlags (..) - , ConfigFlags (..) - , GlobalFlags (..) + ( GlobalFlags (..) ) import Distribution.Client.TargetSelector ( TargetSelectorProblem (..) @@ -177,9 +175,6 @@ import Distribution.Types.UnqualComponentName import Distribution.Utils.NubList ( fromNubList ) -import Distribution.Verbosity - ( normal - ) import Language.Haskell.Extension ( Language (..) ) @@ -281,7 +276,8 @@ data TargetContext -- In the case that the context refers to a temporary directory, -- delete it after the action finishes. withContextAndSelectors - :: AcceptNoTargets + :: Verbosity + -> AcceptNoTargets -- ^ What your command should do when no targets are found. -> Maybe ComponentKind -- ^ A target filter @@ -296,7 +292,7 @@ withContextAndSelectors -> (TargetContext -> ProjectBaseContext -> [TargetSelector] -> IO b) -- ^ The body of your command action. -> IO b -withContextAndSelectors noTargets kind flags@NixStyleFlags{..} targetStrings globalFlags cmd act = +withContextAndSelectors verbosity noTargets kind flags@NixStyleFlags{..} targetStrings globalFlags cmd act = withTemporaryTempDirectory $ \mkTmpDir -> do (tc, ctx) <- withProjectOrGlobalConfig @@ -337,7 +333,6 @@ withContextAndSelectors noTargets kind flags@NixStyleFlags{..} targetStrings glo act tc' ctx' sels where - verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags) ignoreProject = flagIgnoreProject projectFlags cliConfig = commandLineFlagsToProjectConfig globalFlags flags mempty globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig)