withContextAndSelectors taking verbosity

Author: philderbeast

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

@@ -127,6 +127,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

@@ -226,7 +226,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/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

@@ -76,9 +76,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)