diff --git a/Cabal/src/Distribution/Make.hs b/Cabal/src/Distribution/Make.hs
index 716347ec8fb..45824d75b33 100644
--- a/Cabal/src/Distribution/Make.hs
+++ b/Cabal/src/Distribution/Make.hs
@@ -1,5 +1,7 @@
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ViewPatterns #-}
 
 -----------------------------------------------------------------------------
 
@@ -65,6 +67,7 @@ module Distribution.Make
   , defaultMainArgsWithHandles
   ) where
 
+import Data.Monoid (Last (..))
 import Distribution.Compat.Prelude
 import Prelude ()
 
@@ -149,7 +152,7 @@ defaultMainHelperWithHandles verbHandles args = do
 configureAction :: VerbosityHandles -> ConfigFlags -> [String] -> IO ()
 configureAction verbHandles flags args = do
   noExtraFlags args
-  let verbosity = mkVerbosity verbHandles $ fromFlag $ configVerbosity flags
+  let FlagVerbosity verbosity = (verbHandles, configVerbosity flags)
       mbWorkDir = flagToMaybe $ configWorkingDir flags
   rawSystemExit verbosity mbWorkDir "sh" $
     "configure"
@@ -160,7 +163,7 @@ configureAction verbHandles flags args = do
 copyAction :: VerbosityHandles -> CopyFlags -> [String] -> IO ()
 copyAction verbHandles flags args = do
   noExtraFlags args
-  let verbosity = mkVerbosity verbHandles $ fromFlag $ copyVerbosity flags
+  let FlagVerbosity verbosity = (verbHandles, copyVerbosity flags)
       mbWorkDir = flagToMaybe $ copyWorkingDir flags
       destArgs = case fromFlag $ copyDest flags of
         NoCopyDest -> ["install"]
@@ -172,7 +175,7 @@ copyAction verbHandles flags args = do
 installAction :: VerbosityHandles -> InstallFlags -> [String] -> IO ()
 installAction verbHandles flags args = do
   noExtraFlags args
-  let verbosity = mkVerbosity verbHandles $ fromFlag $ installVerbosity flags
+  let FlagVerbosity verbosity = (verbHandles, installVerbosity flags)
       mbWorkDir = flagToMaybe $ installWorkingDir flags
   rawSystemExit verbosity mbWorkDir "make" ["install"]
   rawSystemExit verbosity mbWorkDir "make" ["register"]
@@ -180,7 +183,7 @@ installAction verbHandles flags args = do
 haddockAction :: VerbosityHandles -> HaddockFlags -> [String] -> IO ()
 haddockAction verbHandles flags args = do
   noExtraFlags args
-  let verbosity = mkVerbosity verbHandles $ fromFlag $ haddockVerbosity flags
+  let FlagVerbosity verbosity = (verbHandles, haddockVerbosity flags)
       mbWorkDir = flagToMaybe $ haddockWorkingDir flags
   rawSystemExit verbosity mbWorkDir "make" ["docs"]
     `catchIO` \_ ->
@@ -189,34 +192,38 @@ haddockAction verbHandles flags args = do
 buildAction :: VerbosityHandles -> BuildFlags -> [String] -> IO ()
 buildAction verbHandles flags args = do
   noExtraFlags args
-  let verbosity = mkVerbosity verbHandles $ fromFlag $ buildVerbosity flags
+  let FlagVerbosity verbosity = (verbHandles, buildVerbosity flags)
       mbWorkDir = flagToMaybe $ buildWorkingDir flags
   rawSystemExit verbosity mbWorkDir "make" []
 
 cleanAction :: VerbosityHandles -> CleanFlags -> [String] -> IO ()
 cleanAction verbHandles flags args = do
   noExtraFlags args
-  let verbosity = mkVerbosity verbHandles $ fromFlag $ cleanVerbosity flags
+  let FlagVerbosity verbosity = (verbHandles, cleanVerbosity flags)
       mbWorkDir = flagToMaybe $ cleanWorkingDir flags
   rawSystemExit verbosity mbWorkDir "make" ["clean"]
 
 sdistAction :: VerbosityHandles -> SDistFlags -> [String] -> IO ()
 sdistAction verbHandles flags args = do
   noExtraFlags args
-  let verbosity = mkVerbosity verbHandles $ fromFlag $ sDistVerbosity flags
+  let FlagVerbosity verbosity = (verbHandles, sDistVerbosity flags)
       mbWorkDir = flagToMaybe $ sDistWorkingDir flags
   rawSystemExit verbosity mbWorkDir "make" ["dist"]
 
 registerAction :: VerbosityHandles -> RegisterFlags -> [String] -> IO ()
 registerAction verbHandles flags args = do
   noExtraFlags args
-  let verbosity = mkVerbosity verbHandles $ fromFlag $ registerVerbosity flags
+  let FlagVerbosity verbosity = (verbHandles, registerVerbosity flags)
       mbWorkDir = flagToMaybe $ registerWorkingDir flags
   rawSystemExit verbosity mbWorkDir "make" ["register"]
 
 unregisterAction :: VerbosityHandles -> RegisterFlags -> [String] -> IO ()
 unregisterAction verbHandles flags args = do
   noExtraFlags args
-  let verbosity = mkVerbosity verbHandles $ fromFlag $ registerVerbosity flags
+  let FlagVerbosity verbosity = (verbHandles, registerVerbosity flags)
       mbWorkDir = flagToMaybe $ registerWorkingDir flags
   rawSystemExit verbosity mbWorkDir "make" ["unregister"]
+
+pattern FlagVerbosity :: Verbosity -> (VerbosityHandles, Last VerbosityFlags)
+pattern FlagVerbosity v <- (uncurry mkVerbosity . fmap fromFlag -> v)
+{-# COMPLETE FlagVerbosity #-}
diff --git a/Cabal/src/Distribution/Simple.hs b/Cabal/src/Distribution/Simple.hs
index 9877e861ea5..d635484cdec 100644
--- a/Cabal/src/Distribution/Simple.hs
+++ b/Cabal/src/Distribution/Simple.hs
@@ -416,7 +416,7 @@ configureAction verbHandles globalFlags hooks flags args = do
           { configCommonFlags = commonFlags'
           }
       mbWorkDir = flagToMaybe $ setupWorkingDir commonFlags'
-      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity commonFlags')
+      CommonSetupVerbosity verbosity = (verbHandles, commonFlags')
 
   -- See docs for 'HookedBuildInfo'
   pbi <- preConf hooks args flags'
@@ -472,7 +472,7 @@ getCommonFlags
   -> IO (LocalBuildInfo, CommonSetupFlags)
 getCommonFlags verbHandles globalFlags hooks commonFlags args = do
   distPref <- findDistPrefOrDefault (setupDistPref commonFlags)
-  let verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity commonFlags)
+  let CommonSetupVerbosity verbosity = (verbHandles, commonFlags)
   lbi <- getBuildConfig globalFlags hooks verbosity distPref
   let common' = configCommonFlags $ configFlags lbi
   return
@@ -491,7 +491,7 @@ getCommonFlags verbHandles globalFlags hooks commonFlags args = do
 buildAction :: VerbosityHandles -> GlobalFlags -> UserHooks -> BuildFlags -> Args -> IO ()
 buildAction verbHandles globalFlags hooks flags args = do
   let common = buildCommonFlags flags
-      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)
+      CommonSetupVerbosity verbosity = (verbHandles, common)
   (lbi, common') <- getCommonFlags verbHandles globalFlags hooks common args
   let flags' = flags{buildCommonFlags = common'}
 
@@ -515,7 +515,7 @@ buildAction verbHandles globalFlags hooks flags args = do
 replAction :: VerbosityHandles -> GlobalFlags -> UserHooks -> ReplFlags -> Args -> IO ()
 replAction verbHandles globalFlags hooks flags args = do
   let common = replCommonFlags flags
-      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)
+      CommonSetupVerbosity verbosity = (verbHandles, common)
   (lbi, common') <- getCommonFlags verbHandles globalFlags hooks common args
   let flags' = flags{replCommonFlags = common'}
   progs <-
@@ -543,7 +543,7 @@ replAction verbHandles globalFlags hooks flags args = do
 hscolourAction :: VerbosityHandles -> GlobalFlags -> UserHooks -> HscolourFlags -> Args -> IO ()
 hscolourAction verbHandles globalFlags hooks flags args = do
   let common = hscolourCommonFlags flags
-      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)
+      CommonSetupVerbosity verbosity = (verbHandles, common)
   (_lbi, common') <- getCommonFlags verbHandles globalFlags hooks common args
   let flags' = flags{hscolourCommonFlags = common'}
       distPref = fromFlag $ setupDistPref common'
@@ -561,7 +561,7 @@ hscolourAction verbHandles globalFlags hooks flags args = do
 haddockAction :: VerbosityHandles -> GlobalFlags -> UserHooks -> HaddockFlags -> Args -> IO ()
 haddockAction verbHandles globalFlags hooks flags args = do
   let common = haddockCommonFlags flags
-      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)
+      CommonSetupVerbosity verbosity = (verbHandles, common)
   (lbi, common') <- getCommonFlags verbHandles globalFlags hooks common args
   let flags' = flags{haddockCommonFlags = common'}
 
@@ -585,7 +585,7 @@ haddockAction verbHandles globalFlags hooks flags args = do
 cleanAction :: VerbosityHandles -> GlobalFlags -> UserHooks -> CleanFlags -> Args -> IO ()
 cleanAction verbHandles globalFlags hooks flags args = do
   let common = cleanCommonFlags flags
-      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)
+      CommonSetupVerbosity verbosity = (verbHandles, common)
   distPref <- findDistPrefOrDefault (setupDistPref common)
   elbi <- tryGetBuildConfig globalFlags hooks verbosity distPref
   let common' =
@@ -633,7 +633,7 @@ cleanAction verbHandles globalFlags hooks flags args = do
 copyAction :: VerbosityHandles -> GlobalFlags -> UserHooks -> CopyFlags -> Args -> IO ()
 copyAction verbHandles globalFlags hooks flags args = do
   let common = copyCommonFlags flags
-      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)
+      CommonSetupVerbosity verbosity = (verbHandles, common)
   (_lbi, common') <- getCommonFlags verbHandles globalFlags hooks common args
   let flags' = flags{copyCommonFlags = common'}
       distPref = fromFlag $ setupDistPref common'
@@ -650,7 +650,7 @@ copyAction verbHandles globalFlags hooks flags args = do
 installAction :: VerbosityHandles -> GlobalFlags -> UserHooks -> InstallFlags -> Args -> IO ()
 installAction verbHandles globalFlags hooks flags args = do
   let common = installCommonFlags flags
-      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)
+      CommonSetupVerbosity verbosity = (verbHandles, common)
   (_lbi, common') <- getCommonFlags verbHandles globalFlags hooks common args
   let flags' = flags{installCommonFlags = common'}
       distPref = fromFlag $ setupDistPref common'
@@ -672,12 +672,12 @@ sdistAction verbHandles _globalFlags _hooks flags _args = do
   let pkg_descr = flattenPackageDescription ppd
   sdist verbHandles pkg_descr flags srcPref knownSuffixHandlers
   where
-    verbosity = mkVerbosity verbHandles $ fromFlag (setupVerbosity $ sDistCommonFlags flags)
+    CommonSetupVerbosity verbosity = (verbHandles, sDistCommonFlags flags)
 
 testAction :: VerbosityHandles -> GlobalFlags -> UserHooks -> TestFlags -> Args -> IO ()
 testAction verbHandles globalFlags hooks flags args = do
   let common = testCommonFlags flags
-      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)
+      CommonSetupVerbosity verbosity = (verbHandles, common)
   (_lbi, common') <- getCommonFlags verbHandles globalFlags hooks common args
   let flags' = flags{testCommonFlags = common'}
       distPref = fromFlag $ setupDistPref common'
@@ -694,7 +694,7 @@ testAction verbHandles globalFlags hooks flags args = do
 benchAction :: VerbosityHandles -> GlobalFlags -> UserHooks -> BenchmarkFlags -> Args -> IO ()
 benchAction verbHandles globalFlags hooks flags args = do
   let common = benchmarkCommonFlags flags
-      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)
+      CommonSetupVerbosity verbosity = (verbHandles, common)
   (_lbi, common') <- getCommonFlags verbHandles globalFlags hooks common args
   let flags' = flags{benchmarkCommonFlags = common'}
       distPref = fromFlag $ setupDistPref common'
@@ -711,7 +711,7 @@ benchAction verbHandles globalFlags hooks flags args = do
 registerAction :: VerbosityHandles -> GlobalFlags -> UserHooks -> RegisterFlags -> Args -> IO ()
 registerAction verbHandles globalFlags hooks flags args = do
   let common = registerCommonFlags flags
-      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)
+      CommonSetupVerbosity verbosity = (verbHandles, common)
   (_lbi, common') <- getCommonFlags verbHandles globalFlags hooks common args
   let flags' = flags{registerCommonFlags = common'}
       distPref = fromFlag $ setupDistPref common'
@@ -728,7 +728,7 @@ registerAction verbHandles globalFlags hooks flags args = do
 unregisterAction :: VerbosityHandles -> GlobalFlags -> UserHooks -> RegisterFlags -> Args -> IO ()
 unregisterAction verbHandles globalFlags hooks flags args = do
   let common = registerCommonFlags flags
-      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)
+      CommonSetupVerbosity verbosity = (verbHandles, common)
   (_lbi, common') <- getCommonFlags verbHandles globalFlags hooks common args
   let flags' = flags{registerCommonFlags = common'}
       distPref = fromFlag $ setupDistPref common'
@@ -898,7 +898,7 @@ getBuildConfig globalFlags hooks verbosity distPref = do
 clean :: VerbosityHandles -> PackageDescription -> CleanFlags -> IO ()
 clean verbHandles pkg_descr flags = do
   let common = cleanCommonFlags flags
-      verbosity = mkVerbosity verbHandles (fromFlag (setupVerbosity common))
+      CommonSetupVerbosity verbosity = (verbHandles, common)
       distPref = fromFlagOrDefault defaultDistPref $ setupDistPref common
       mbWorkDir = flagToMaybe $ setupWorkingDir common
       i = interpretSymbolicPath mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path
@@ -956,9 +956,7 @@ simpleUserHooksWithHandles verbHandles =
     finalChecks _args flags pkg_descr lbi =
       checkForeignDeps pkg_descr lbi (modifyVerbosityFlags lessVerbose verbosity)
       where
-        verbosity =
-          mkVerbosity verbHandles $
-            fromFlag (setupVerbosity $ configCommonFlags flags)
+        CommonSetupVerbosity verbosity = (verbHandles, configCommonFlags flags)
 
 -- | Basic autoconf 'UserHooks':
 --
@@ -995,7 +993,7 @@ autoconfUserHooks =
     defaultPostConf args flags pkg_descr lbi =
       do
         let common = configCommonFlags flags
-            verbosity = mkVerbosity defaultVerbosityHandles (fromFlag $ setupVerbosity common)
+            CommonSetupVerbosity verbosity = (defaultVerbosityHandles, common)
             mbWorkDir = flagToMaybe $ setupWorkingDir common
         runConfigureScript
           defaultVerbosityHandles
@@ -1016,7 +1014,7 @@ autoconfUserHooks =
       -> IO HookedBuildInfo
     readHookWithArgs get_common_flags _args flags = do
       let common = get_common_flags flags
-          verbosity = mkVerbosity defaultVerbosityHandles (fromFlag (setupVerbosity common))
+          CommonSetupVerbosity verbosity = (defaultVerbosityHandles, common)
           mbWorkDir = flagToMaybe $ setupWorkingDir common
           distPref = setupDistPref common
       dist_dir <- findDistPrefOrDefault distPref
@@ -1029,7 +1027,7 @@ autoconfUserHooks =
       -> IO HookedBuildInfo
     readHook get_common_flags args flags = do
       let common = get_common_flags flags
-          verbosity = mkVerbosity defaultVerbosityHandles (fromFlag (setupVerbosity common))
+          CommonSetupVerbosity verbosity = (defaultVerbosityHandles, common)
           mbWorkDir = flagToMaybe $ setupWorkingDir common
           distPref = setupDistPref common
       noExtraFlags args
@@ -1216,6 +1214,4 @@ defaultRegHook verbHandles pkg_descr localbuildinfo _ flags
         "Package contains no library to register:"
         (packageId pkg_descr)
   where
-    verbosity =
-      mkVerbosity verbHandles $
-        fromFlag (setupVerbosity $ registerCommonFlags flags)
+    CommonSetupVerbosity verbosity = (verbHandles, registerCommonFlags flags)
diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs
index 79ab53f364a..6468b6cc52d 100644
--- a/Cabal/src/Distribution/Simple/Configure.hs
+++ b/Cabal/src/Distribution/Simple/Configure.hs
@@ -2,10 +2,12 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE ViewPatterns #-}
 
 -----------------------------------------------------------------------------
 
@@ -197,6 +199,10 @@ import qualified Data.Maybe as M
 import qualified Data.Set as Set
 import qualified Distribution.Compat.NonEmptySet as NES
 
+pattern ConfigVerbosity :: Verbosity -> (VerbosityHandles, ConfigFlags)
+pattern ConfigVerbosity v <- (fmap configCommonFlags -> CommonSetupVerbosity v)
+{-# COMPLETE ConfigVerbosity #-}
+
 type UseExternalInternalDeps = Bool
 
 -- | The errors that can be thrown when reading the @setup-config@ file.
@@ -784,8 +790,7 @@ computeLocalBuildConfig
   -> ProgramDb
   -> IO LBC.LocalBuildConfig
 computeLocalBuildConfig verbHandles cfg comp programDb = do
-  let common = configCommonFlags cfg
-      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)
+  let ConfigVerbosity verbosity = (verbHandles, cfg)
   rawBuildOptions <- buildOptionsFromConfigFlags verbosity cfg comp
   buildOptions <- adjustBuildOptionsAndWarn verbosity comp programDb rawBuildOptions
   return $
@@ -1061,8 +1066,7 @@ configurePackage
   -> PackageDBStack
   -> IO (LBC.LocalBuildConfig, LBC.PackageBuildDescr)
 configurePackage verbHandles cfg lbc0 pkg_descr00 flags enabled comp platform packageDbs = do
-  let common = configCommonFlags cfg
-      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)
+  let ConfigVerbosity verbosity = (verbHandles, cfg)
       programDb0 = LBC.withPrograms lbc0
 
       -- add extra include/lib dirs as specified in cfg
@@ -1160,9 +1164,8 @@ computePackageInfo
   -> Compiler
   -> IO ([PackageVersionConstraint], PackageInfo)
 computePackageInfo verbHandles cfg lbc0 g_pkg_descr comp = do
-  let common = configCommonFlags cfg
-      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)
-      mbWorkDir = flagToMaybe $ setupWorkingDir common
+  let ConfigVerbosity verbosity = (verbHandles, cfg)
+      mbWorkDir = flagToMaybe . setupWorkingDir $ configCommonFlags cfg
 
   let programDb0 = LBC.withPrograms lbc0
       -- What package database(s) to use
@@ -1235,8 +1238,7 @@ finalizePackageDescription
   -> PackageInfo
   -> IO (PackageDBStack, PackageDescription, FlagAssignment)
 finalizePackageDescription verbHandles cfg g_pkg_descr comp platform enabled allConstraints pkgInfo = do
-  let common = configCommonFlags cfg
-      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)
+  let ConfigVerbosity verbosity = (verbHandles, cfg)
 
   -- What package database(s) to use
   let packageDbs :: PackageDBStack
@@ -1351,9 +1353,8 @@ finalCheckPackage
     )
   hookedBuildInfo =
     do
-      let common = configCommonFlags cfg
-          verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)
-          cabalFileDir = packageRoot common
+      let ConfigVerbosity verbosity = (verbHandles, cfg)
+          cabalFileDir = packageRoot $ configCommonFlags cfg
 
       checkCompilerProblems verbosity comp pkg_descr enabled
       checkPackageProblems
@@ -1414,8 +1415,7 @@ configureComponents
   promisedDepsSet
   externalPkgDeps =
     do
-      let common = configCommonFlags cfg
-          verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)
+      let ConfigVerbosity verbosity = (verbHandles, cfg)
           use_external_internal_deps =
             case enabled of
               OneComponentRequestedSpec{} -> True
@@ -2649,8 +2649,7 @@ configCompilerAuxEx
   -> IO (Compiler, Platform, ProgramDb)
 configCompilerAuxEx verbHandles cfg = do
   programDb <- mkProgramDb verbHandles cfg defaultProgramDb
-  let common = configCommonFlags cfg
-      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)
+  let ConfigVerbosity verbosity = (verbHandles, cfg)
   configCompilerEx
     (flagToMaybe $ configHcFlavor cfg)
     (flagToMaybe $ configHcPath cfg)
diff --git a/Cabal/src/Distribution/Simple/ConfigureScript.hs b/Cabal/src/Distribution/Simple/ConfigureScript.hs
index 454503eb679..6236d4a0a0d 100644
--- a/Cabal/src/Distribution/Simple/ConfigureScript.hs
+++ b/Cabal/src/Distribution/Simple/ConfigureScript.hs
@@ -59,7 +59,7 @@ runConfigureScript
   -> IO ()
 runConfigureScript verbHandles cfg flags programDb hp = do
   let commonCfg = configCommonFlags cfg
-      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity commonCfg)
+      CommonSetupVerbosity verbosity = (verbHandles, commonCfg)
   dist_dir <- findDistPrefOrDefault $ setupDistPref commonCfg
   let build_dir = dist_dir </> makeRelativePathEx "build"
       mbWorkDir = flagToMaybe $ setupWorkingDir commonCfg
diff --git a/Cabal/src/Distribution/Simple/GHC/Build/Link.hs b/Cabal/src/Distribution/Simple/GHC/Build/Link.hs
index a1f07219e3e..aa9c0f0a86f 100644
--- a/Cabal/src/Distribution/Simple/GHC/Build/Link.hs
+++ b/Cabal/src/Distribution/Simple/GHC/Build/Link.hs
@@ -733,7 +733,7 @@ runReplOrWriteFlags ghcProg verbHandles lbi rflags ghcOpts pkg_name target =
       platform = hostPlatform lbi
       common = configCommonFlags $ configFlags lbi
       mbWorkDir = mbWorkDirLBI lbi
-      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)
+      CommonSetupVerbosity verbosity = (verbHandles, common)
       tempFileOptions = commonSetupTempFileOptions common
    in case replOptionsFlagOutput (replReplOptions rflags) of
         NoFlag -> do
diff --git a/Cabal/src/Distribution/Simple/Haddock.hs b/Cabal/src/Distribution/Simple/Haddock.hs
index d22645d5970..e2d888bd2d1 100644
--- a/Cabal/src/Distribution/Simple/Haddock.hs
+++ b/Cabal/src/Distribution/Simple/Haddock.hs
@@ -58,7 +58,6 @@ import Distribution.Simple.Errors
 import Distribution.Simple.FileMonitor.Types
   ( MonitorFilePath
   )
-import Distribution.Simple.Flag
 import Distribution.Simple.Glob (matchDirFileGlob)
 import Distribution.Simple.InstallDirs
 import Distribution.Simple.LocalBuildInfo hiding (substPathTemplate)
@@ -1529,7 +1528,7 @@ hscolour'
         onNoHsColour $ exceptionMessage excep
         return []
       common = hscolourCommonFlags flags
-      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)
+      CommonSetupVerbosity verbosity = (verbHandles, common)
       distPref = fromFlag $ setupDistPref common
       mbWorkDir = mbWorkDirLBI lbi
       i = interpretSymbolicPathLBI lbi -- See Note [Symbolic paths] in Distribution.Utils.Path
diff --git a/Cabal/src/Distribution/Simple/Install.hs b/Cabal/src/Distribution/Simple/Install.hs
index 162c4469d84..b69f9362730 100644
--- a/Cabal/src/Distribution/Simple/Install.hs
+++ b/Cabal/src/Distribution/Simple/Install.hs
@@ -143,7 +143,7 @@ install_setupHooks
     where
       common = copyCommonFlags flags
       distPref = fromFlag $ setupDistPref common
-      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)
+      CommonSetupVerbosity verbosity = (verbHandles, common)
       copydest = fromFlag (copyDest flags)
 
       checkHasLibsOrExes =
diff --git a/Cabal/src/Distribution/Simple/Register.hs b/Cabal/src/Distribution/Simple/Register.hs
index 3e603a14d6a..e1ed0dd2020 100644
--- a/Cabal/src/Distribution/Simple/Register.hs
+++ b/Cabal/src/Distribution/Simple/Register.hs
@@ -171,7 +171,7 @@ generateOne verbHandles pkg lib lbi clbi regFlags =
         withPackageDB lbi
           ++ maybeToList (flagToMaybe (regPackageDB regFlags))
     distPref = fromFlag $ setupDistPref common
-    verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)
+    CommonSetupVerbosity verbosity = (verbHandles, common)
     mbWorkDir = flagToMaybe $ setupWorkingDir common
 
 registerAll
@@ -232,7 +232,7 @@ registerAll verbHandles pkg lbi regFlags ipis =
         withPackageDB lbi
           ++ maybeToList (flagToMaybe (regPackageDB regFlags))
     common = registerCommonFlags regFlags
-    verbosity = mkVerbosity verbHandles (fromFlag (setupVerbosity common))
+    CommonSetupVerbosity verbosity = (verbHandles, common)
     mbWorkDir = mbWorkDirLBI lbi
 
     writeRegistrationFileOrDirectory = do
@@ -731,7 +731,7 @@ unregisterWithHandles verbHandles pkg lbi regFlags = do
   let pkgid = packageId pkg
       common = registerCommonFlags regFlags
       genScript = fromFlag (regGenScript regFlags)
-      verbosity = mkVerbosity verbHandles (fromFlag (setupVerbosity common))
+      CommonSetupVerbosity verbosity = (verbHandles, common)
       packageDb =
         fromFlagOrDefault
           (registrationPackageDB (withPackageDB lbi))
diff --git a/Cabal/src/Distribution/Simple/Setup.hs b/Cabal/src/Distribution/Simple/Setup.hs
index d9d179f9d96..788151fea4b 100644
--- a/Cabal/src/Distribution/Simple/Setup.hs
+++ b/Cabal/src/Distribution/Simple/Setup.hs
@@ -37,6 +37,8 @@ module Distribution.Simple.Setup
   , defaultGlobalFlags
   , globalCommand
   , CommonSetupFlags (..)
+  , pattern CommonSetupVerbosity
+  , pattern DefaultCommonSetupVerbosity
   , defaultCommonSetupFlags
   , commonSetupTempFileOptions
   , ConfigFlags (..)
diff --git a/Cabal/src/Distribution/Simple/Setup/Common.hs b/Cabal/src/Distribution/Simple/Setup/Common.hs
index 595ecfc6dae..b5c2f9eb17d 100644
--- a/Cabal/src/Distribution/Simple/Setup/Common.hs
+++ b/Cabal/src/Distribution/Simple/Setup/Common.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ViewPatterns #-}
 
 -- |
 -- Module      :  Distribution.Simple.Setup.Common
@@ -17,6 +18,8 @@
 -- See: @Distribution.Simple.Setup@
 module Distribution.Simple.Setup.Common
   ( CommonSetupFlags (..)
+  , pattern CommonSetupVerbosity
+  , pattern DefaultCommonSetupVerbosity
   , defaultCommonSetupFlags
   , withCommonSetupOptions
   , commonSetupTempFileOptions
@@ -115,6 +118,19 @@ defaultCommonSetupFlags =
     , setupKeepTempFiles = NoFlag
     }
 
+-- | From the provided handles and 'fromFlag' to get the setup verbosity from
+-- the provided flags, constructs a verbosity.
+pattern CommonSetupVerbosity :: Verbosity -> (VerbosityHandles, CommonSetupFlags)
+pattern CommonSetupVerbosity v <- (uncurry mkVerbosity . fmap (fromFlag . setupVerbosity) -> v)
+
+-- | Same as 'CommonSetupVerbosity', but using the default verbosity handles and
+-- 'fromFlagOrDefault' to get the verbosity from the flags.
+pattern DefaultCommonSetupVerbosity :: Verbosity -> CommonSetupFlags
+pattern DefaultCommonSetupVerbosity v <- (mkVerbosity defaultVerbosityHandles . fromFlagOrDefault normal . setupVerbosity -> v)
+
+{-# COMPLETE CommonSetupVerbosity #-}
+{-# COMPLETE DefaultCommonSetupVerbosity #-}
+
 -- | Get `TempFileOptions` that respect the `setupKeepTempFiles` flag.
 commonSetupTempFileOptions :: CommonSetupFlags -> TempFileOptions
 commonSetupTempFileOptions options =
diff --git a/Cabal/src/Distribution/Simple/SrcDist.hs b/Cabal/src/Distribution/Simple/SrcDist.hs
index fd6b3756ebb..c413cc2b8f0 100644
--- a/Cabal/src/Distribution/Simple/SrcDist.hs
+++ b/Cabal/src/Distribution/Simple/SrcDist.hs
@@ -124,7 +124,7 @@ sdist verbHandles pkg flags mkTmpDir pps = do
         overwriteSnapshotPackageDesc verbosity pkg' targetDir
 
     common = sDistCommonFlags flags
-    verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)
+    CommonSetupVerbosity verbosity = (verbHandles, common)
     mbWorkDir = flagToMaybe $ setupWorkingDir common
     i = interpretSymbolicPath mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path
     snapshot = fromFlag (sDistSnapshot flags)
diff --git a/Cabal/src/Distribution/Simple/Test.hs b/Cabal/src/Distribution/Simple/Test.hs
index fba96b9352f..a1878b20a13 100644
--- a/Cabal/src/Distribution/Simple/Test.hs
+++ b/Cabal/src/Distribution/Simple/Test.hs
@@ -73,7 +73,7 @@ test
 test args verbHandles pkg_descr lbi0 flags = do
   curDir <- LBI.absoluteWorkingDirLBI lbi0
   let common = testCommonFlags flags
-      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)
+      CommonSetupVerbosity verbosity = (verbHandles, common)
       distPref = fromFlag $ setupDistPref common
       i = LBI.interpretSymbolicPathLBI lbi -- See Note [Symbolic paths] in Distribution.Utils.Path
       machineTemplate = fromFlag $ testMachineLog flags
diff --git a/Cabal/src/Distribution/Simple/Test/ExeV10.hs b/Cabal/src/Distribution/Simple/Test/ExeV10.hs
index 722d83d554e..d01177dd1fc 100644
--- a/Cabal/src/Distribution/Simple/Test/ExeV10.hs
+++ b/Cabal/src/Distribution/Simple/Test/ExeV10.hs
@@ -204,7 +204,7 @@ runTest verbHandles pkg_descr lbi clbi hpcMarkupInfo flags suite = do
     testName' = unUnqualComponentName $ PD.testName suite
 
     distPref = fromFlag $ setupDistPref commonFlags
-    verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity commonFlags)
+    CommonSetupVerbosity verbosity = (verbHandles, commonFlags)
     details = fromFlag $ testShowDetails flags
     testLogDir = distPref </> makeRelativePathEx "test"
 
diff --git a/Cabal/src/Distribution/Simple/Test/LibV09.hs b/Cabal/src/Distribution/Simple/Test/LibV09.hs
index 71fa7c985f4..b0b7489ce74 100644
--- a/Cabal/src/Distribution/Simple/Test/LibV09.hs
+++ b/Cabal/src/Distribution/Simple/Test/LibV09.hs
@@ -214,7 +214,7 @@ runTest verbHandles pkg_descr lbi clbi hpcMarkupInfo flags suite = do
       hClose h >> return f
 
     distPref = fromFlag $ setupDistPref common
-    verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)
+    CommonSetupVerbosity verbosity = (verbHandles, common)
 
 -- TODO: This is abusing the notion of a 'PathTemplate'.  The result isn't
 -- necessarily a path.
diff --git a/cabal-install/src/Distribution/Client/CmdHaddockProject.hs b/cabal-install/src/Distribution/Client/CmdHaddockProject.hs
index 247eb3e2bd4..ffc8d50f421 100644
--- a/cabal-install/src/Distribution/Client/CmdHaddockProject.hs
+++ b/cabal-install/src/Distribution/Client/CmdHaddockProject.hs
@@ -47,11 +47,7 @@ import Distribution.Client.ScriptUtils
   , updateContextAndWriteProjectFile
   , withContextAndSelectors
   )
-import Distribution.Client.Setup
-  ( CommonSetupFlags (setupVerbosity)
-  , ConfigFlags (..)
-  , GlobalFlags (..)
-  )
+import Distribution.Client.Setup (ConfigFlags (..), GlobalFlags (..))
 import Distribution.Client.TargetProblem (TargetProblem (..))
 
 import Distribution.Simple.BuildPaths
@@ -90,6 +86,7 @@ import Distribution.Simple.Setup
   , Visibility (..)
   , defaultHaddockFlags
   , haddockProjectCommand
+  , pattern DefaultCommonSetupVerbosity
   )
 import Distribution.Simple.Utils
   ( copyDirectoryRecursive
@@ -105,11 +102,6 @@ import Distribution.Types.PackageName (unPackageName)
 import Distribution.Types.UnitId (unUnitId)
 import Distribution.Types.Version (mkVersion)
 import Distribution.Types.VersionRange (orLaterVersion)
-import Distribution.Verbosity as Verbosity
-  ( defaultVerbosityHandles
-  , mkVerbosity
-  , normal
-  )
 
 import Distribution.Client.Errors
 import System.Directory (doesDirectoryExist, doesFileExist)
@@ -360,10 +352,7 @@ haddockProjectAction flags _extraArgs globalFlags = do
   where
     -- build all packages with appropriate haddock flags
     commonFlags = haddockProjectCommonFlags flags
-
-    verbosity =
-      mkVerbosity defaultVerbosityHandles $
-        fromFlagOrDefault normal (setupVerbosity commonFlags)
+    DefaultCommonSetupVerbosity verbosity = commonFlags
 
     haddockFlags =
       defaultHaddockFlags
diff --git a/cabal-install/src/Distribution/Client/CmdLegacy.hs b/cabal-install/src/Distribution/Client/CmdLegacy.hs
index cbfbf5e24b0..201abcc691c 100644
--- a/cabal-install/src/Distribution/Client/CmdLegacy.hs
+++ b/cabal-install/src/Distribution/Client/CmdLegacy.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RecordWildCards #-}
 
 module Distribution.Client.CmdLegacy (legacyCmd, legacyWrapperCmd, newCmd) where
@@ -19,20 +20,12 @@ import Distribution.Client.SetupWrapper
   , setupWrapper
   )
 import Distribution.Simple.Command
+import Distribution.Simple.Setup (pattern DefaultCommonSetupVerbosity)
 import qualified Distribution.Simple.Setup as Setup
-import Distribution.Simple.Utils
-  ( wrapText
-  )
-import Distribution.Verbosity
-  ( VerbosityFlags
-  , defaultVerbosityHandles
-  , mkVerbosity
-  , normal
-  )
+import Distribution.Simple.Utils (wrapText)
+import Distribution.Verbosity (VerbosityFlags, normal)
 
-import Control.Exception
-  ( try
-  )
+import Control.Exception (try)
 import qualified Data.Text as T
 
 -- Tweaked versions of code from Main.
@@ -60,9 +53,7 @@ wrapperAction command getCommonFlags =
       }
     $ \flags extraArgs globalFlags -> do
       let common = getCommonFlags flags
-          verbosity' =
-            mkVerbosity defaultVerbosityHandles $
-              Setup.fromFlagOrDefault normal (Setup.setupVerbosity common)
+          DefaultCommonSetupVerbosity verbosity' = common
           mbWorkDir = Setup.flagToMaybe $ Setup.setupWorkingDir common
 
       load <- try (loadConfigOrSandboxConfig verbosity' globalFlags)
diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs
index fc49cb5148d..8ea637daa0f 100644
--- a/cabal-install/src/Distribution/Client/Main.hs
+++ b/cabal-install/src/Distribution/Client/Main.hs
@@ -90,6 +90,7 @@ import Distribution.Simple.Setup
   , fromFlagOrDefault
   , hscolourCommand
   , toFlag
+  , pattern DefaultCommonSetupVerbosity
   , pattern Flag
   , pattern NoFlag
   )
@@ -553,10 +554,7 @@ wrapperAction command getCommonFlags =
       }
     $ \flags extraArgs globalFlags -> do
       let common = getCommonFlags flags
-          verbosity =
-            mkVerbosity defaultVerbosityHandles $
-              fromFlagOrDefault normal $
-                setupVerbosity common
+          DefaultCommonSetupVerbosity verbosity = common
           mbWorkDir = flagToMaybe $ setupWorkingDir common
       load <- try (loadConfigOrSandboxConfig verbosity globalFlags)
       let config = either (\(SomeException _) -> mempty) id load
@@ -582,10 +580,7 @@ configureAction
   -> Action
 configureAction (configFlags, configExFlags) extraArgs globalFlags = do
   let common = configCommonFlags configFlags
-      verbosity =
-        mkVerbosity defaultVerbosityHandles $
-          fromFlagOrDefault normal $
-            setupVerbosity common
+      DefaultCommonSetupVerbosity verbosity = common
 
   config <-
     updateInstallDirs (configUserInstall configFlags)
@@ -624,9 +619,7 @@ reconfigureAction
   -> Action
 reconfigureAction flags@(configFlags, _) _ globalFlags = do
   let common = configCommonFlags configFlags
-      verbosity =
-        mkVerbosity defaultVerbosityHandles $
-          fromFlagOrDefault normal (setupVerbosity common)
+      DefaultCommonSetupVerbosity verbosity = common
   config <-
     updateInstallDirs (configUserInstall configFlags)
       <$> loadConfigOrSandboxConfig verbosity globalFlags
@@ -657,10 +650,7 @@ reconfigureAction flags@(configFlags, _) _ globalFlags = do
 buildAction :: BuildFlags -> [String] -> Action
 buildAction buildFlags extraArgs globalFlags = do
   let common = buildCommonFlags buildFlags
-      verbosity =
-        mkVerbosity defaultVerbosityHandles $
-          fromFlagOrDefault normal $
-            setupVerbosity common
+      DefaultCommonSetupVerbosity verbosity = common
   config <- loadConfigOrSandboxConfig verbosity globalFlags
   distPref <- findSavedDistPref config (setupDistPref common)
   -- Calls 'configureAction' to do the real work, so nothing special has to be
@@ -739,10 +729,7 @@ filterBuildFlags' version config buildFlags
 replAction :: ReplFlags -> [String] -> Action
 replAction replFlags extraArgs globalFlags = do
   let common = replCommonFlags replFlags
-      verbosity =
-        mkVerbosity defaultVerbosityHandles $
-          fromFlagOrDefault normal $
-            setupVerbosity common
+      DefaultCommonSetupVerbosity verbosity = common
   config <- loadConfigOrSandboxConfig verbosity globalFlags
   distPref <- findSavedDistPref config (setupDistPref common)
   pkgDesc <- findPackageDesc Nothing
@@ -822,9 +809,7 @@ installAction
 installAction (configFlags, _, installFlags, _, _, _) _ globalFlags
   | fromFlagOrDefault False (installOnly installFlags) = do
       let common = configCommonFlags configFlags
-          verb =
-            mkVerbosity defaultVerbosityHandles $
-              fromFlagOrDefault normal (setupVerbosity common)
+          DefaultCommonSetupVerbosity verb = common
       config <- loadConfigOrSandboxConfig verb globalFlags
       dist <- findSavedDistPref config (setupDistPref common)
       let setupOpts = defaultSetupScriptOptions{useDistPref = dist}
@@ -848,10 +833,7 @@ installAction
   extraArgs
   globalFlags = do
     let common = configCommonFlags configFlags
-        verb =
-          mkVerbosity defaultVerbosityHandles $
-            fromFlagOrDefault normal $
-              setupVerbosity common
+        DefaultCommonSetupVerbosity verb = common
     config <-
       updateInstallDirs (configUserInstall configFlags)
         <$> loadConfigOrSandboxConfig verb globalFlags
@@ -1139,10 +1121,7 @@ benchmarkAction
 haddockAction :: HaddockFlags -> [String] -> Action
 haddockAction haddockFlags extraArgs globalFlags = do
   let common = haddockCommonFlags haddockFlags
-      verbosity =
-        mkVerbosity defaultVerbosityHandles $
-          fromFlag $
-            setupVerbosity common
+      DefaultCommonSetupVerbosity verbosity = common
   config <- loadConfigOrSandboxConfig verbosity globalFlags
   distPref <- findSavedDistPref config (setupDistPref common)
   config' <-
@@ -1192,10 +1171,7 @@ haddockAction haddockFlags extraArgs globalFlags = do
 cleanAction :: CleanFlags -> [String] -> Action
 cleanAction cleanFlags extraArgs globalFlags = do
   let common = cleanCommonFlags cleanFlags
-      verbosity =
-        mkVerbosity defaultVerbosityHandles $
-          fromFlagOrDefault normal $
-            setupVerbosity common
+      DefaultCommonSetupVerbosity verbosity = common
   load <- try (loadConfigOrSandboxConfig verbosity globalFlags)
   let config = either (\(SomeException _) -> mempty) id load
   distPref <- findSavedDistPref config $ setupDistPref common
@@ -1464,10 +1440,7 @@ reportAction reportFlags extraArgs globalFlags = do
 runAction :: BuildFlags -> [String] -> Action
 runAction buildFlags extraArgs globalFlags = do
   let common = buildCommonFlags buildFlags
-      verbosity =
-        mkVerbosity defaultVerbosityHandles $
-          fromFlagOrDefault normal $
-            setupVerbosity common
+      DefaultCommonSetupVerbosity verbosity = common
   config <- loadConfigOrSandboxConfig verbosity globalFlags
   distPref <- findSavedDistPref config $ setupDistPref common
   config' <-