withContextAndSelectors taking verbosity

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

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

@@ -124,6 +124,7 @@ haddockProjectAction flags _extraArgs globalFlags = do
   --
 
   withContextAndSelectors
+    verbosity
     RejectNoTargets
     Nothing
     (commandDefaultFlags CmdBuild.buildCommand)

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

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!

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

@@ -179,7 +179,7 @@ import Distribution.Client.ReplFlags
   , topReplOptions
   )
 import Distribution.Compat.Binary (decode)
-import Distribution.Simple.Flag (Flag (Flag), fromFlagOrDefault, toFlag)
+import Distribution.Simple.Flag (Flag (Flag), fromFlagOrDefault)
 import Distribution.Simple.Program.Builtin (ghcProgram)
 import Distribution.Simple.Program.Db (requireProgram)
 import Distribution.Simple.Program.Run
@@ -289,33 +289,13 @@ multiReplDecision ctx compiler flags =
 -- "Distribution.Client.ProjectOrchestration"
 replAction :: NixStyleFlags ReplFlags -> [String] -> GlobalFlags -> IO ()
 replAction flags@NixStyleFlags{extraFlags = r@ReplFlags{..}, ..} targetStrings' globalFlags = do
-  let withCtx verbosity' strings =
-        let flags' =
-              maybe
-                flags
-                ( \v ->
-                    let NixStyleFlags{configFlags = f1} = flags
-                        ConfigFlags{configCommonFlags = f2} = f1
-                     in flags
-                          { configFlags =
-                              f1
-                                { configCommonFlags =
-                                    f2
-                                      { setupVerbosity = v
-                                      }
-                                }
-                          }
-                )
-                verbosity'
-         in withContextAndSelectors AcceptNoTargets (Just LibKind) flags' strings globalFlags ReplCommand
-
   -- NOTE: The REPL will work with no targets in the context of a project if a
   -- sole package is in the same directory as the project file. To have the same
   -- behaviour when the package is somewhere else we adjust the targets.
   targetStrings <-
     if null targetStrings'
       then
-        withCtx (Just $ toFlag silent) targetStrings' $ \targetCtx ctx _ ->
+        withCtx silent targetStrings' $ \targetCtx ctx _ ->
         return . fromMaybe [] $ case targetCtx of
           ProjectContext ->
             let pkgs = projectPackages $ projectConfig ctx
@@ -325,7 +305,7 @@ replAction flags@NixStyleFlags{extraFlags = r@ReplFlags{..}, ..} targetStrings'
           _ -> Nothing
       else return targetStrings'
 
-  withCtx Nothing targetStrings $ \targetCtx ctx targetSelectors -> do
+  withCtx verbosity targetStrings $ \targetCtx ctx targetSelectors -> do
     when (buildSettingOnlyDeps (buildSettings ctx)) $
       dieWithException verbosity ReplCommandDoesn'tSupport
     let projectRoot = distProjectRootDirectory $ distDirLayout ctx
@@ -566,6 +546,9 @@ replAction flags@NixStyleFlags{extraFlags = r@ReplFlags{..}, ..} targetStrings'
         go m ("PATH", Just s) = foldl' (\m' f -> Map.insertWith (+) f 1 m') m (splitSearchPath s)
         go m _ = m
 
+    withCtx ctxVerbosity strings =
+        withContextAndSelectors ctxVerbosity AcceptNoTargets (Just LibKind) flags strings globalFlags ReplCommand
+
     verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)
     tempFileOptions = commonSetupTempFileOptions $ configCommonFlags configFlags
 

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

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)