Refactor PprDebug handling

If `-dppr-debug` is set, then PprUser and PprDump styles are silently
replaced with PprDebug style. This was done in `mkUserStyle` and
`mkDumpStyle` smart constructors. As a consequence they needed a
DynFlags parameter.

Now we keep the original PprUser and PprDump styles until they are used
to create an `SDocContext`. I.e. the substitution is only performed in
`initSDocContext`.

24 files changed, 73 insertions, 81 deletions

diff --git a/compiler/GHC.hs b/compiler/GHC.hs
index 088e121690..ce14dee795 100644
--- a/compiler/GHC.hs
+++ b/compiler/GHC.hs
@@ -611,7 +611,7 @@ setSessionDynFlags dflags = do
              | otherwise                      = ""
            msg = text "Starting " <> text prog
          tr <- if verbosity dflags >= 3
-                then return (logInfo dflags (defaultDumpStyle dflags) msg)
+                then return (logInfo dflags defaultDumpStyle msg)
                 else return (pure ())
          let
           conf = IServConfig
diff --git a/compiler/GHC/Cmm/Pipeline.hs b/compiler/GHC/Cmm/Pipeline.hs
index 8d8deac91d..2dc4ecb80e 100644
--- a/compiler/GHC/Cmm/Pipeline.hs
+++ b/compiler/GHC/Cmm/Pipeline.hs
@@ -368,6 +368,6 @@ dumpWith dflags flag txt fmt sdoc = do
     -- If `-ddump-cmm-verbose -ddump-to-file` is specified,
     -- dump each Cmm pipeline stage output to a separate file.  #16930
     when (dopt Opt_D_dump_cmm_verbose dflags)
-      $ dumpAction dflags (mkDumpStyle dflags alwaysQualify)
+      $ dumpAction dflags (mkDumpStyle alwaysQualify)
                    (dumpOptionsFromFlag flag) txt fmt sdoc
   dumpIfSet_dyn dflags Opt_D_dump_cmm_verbose_by_proc txt fmt sdoc
diff --git a/compiler/GHC/CmmToAsm.hs b/compiler/GHC/CmmToAsm.hs
index 34b877d696..544edc801e 100644
--- a/compiler/GHC/CmmToAsm.hs
+++ b/compiler/GHC/CmmToAsm.hs
@@ -390,7 +390,7 @@ finishNativeGen dflags modLoc bufh@(BufHandle _ _ h) us ngs
                 $ makeImportsDoc dflags (concat (ngs_imports ngs))
         return us'
   where
-    dump_stats = dumpAction dflags (mkDumpStyle dflags alwaysQualify)
+    dump_stats = dumpAction dflags (mkDumpStyle alwaysQualify)
                    (dumpOptionsFromFlag Opt_D_dump_asm_stats) "NCG stats"
                    FormatText
 
diff --git a/compiler/GHC/CmmToLlvm/Base.hs b/compiler/GHC/CmmToLlvm/Base.hs
index 99f5bd53a4..dc9e830751 100644
--- a/compiler/GHC/CmmToLlvm/Base.hs
+++ b/compiler/GHC/CmmToLlvm/Base.hs
@@ -519,7 +519,7 @@ strDisplayName_llvm lbl = do
     dflags <- getDynFlags
     let sdoc = pprCLabel dflags lbl
         depth = Outp.PartWay 1
-        style = Outp.mkUserStyle dflags Outp.reallyAlwaysQualify depth
+        style = Outp.mkUserStyle Outp.reallyAlwaysQualify depth
         str = Outp.renderWithStyle (initSDocContext dflags style) sdoc
     return (fsLit (dropInfoSuffix str))
 
@@ -536,7 +536,7 @@ strProcedureName_llvm lbl = do
     dflags <- getDynFlags
     let sdoc = pprCLabel dflags lbl
         depth = Outp.PartWay 1
-        style = Outp.mkUserStyle dflags Outp.neverQualify depth
+        style = Outp.mkUserStyle Outp.neverQualify depth
         str = Outp.renderWithStyle (initSDocContext dflags style) sdoc
     return (fsLit str)
 
diff --git a/compiler/GHC/Core/Lint.hs b/compiler/GHC/Core/Lint.hs
index bc74b7d393..b72bf0f1c5 100644
--- a/compiler/GHC/Core/Lint.hs
+++ b/compiler/GHC/Core/Lint.hs
@@ -299,7 +299,7 @@ dumpPassResult :: DynFlags
                -> IO ()
 dumpPassResult dflags unqual mb_flag hdr extra_info binds rules
   = do { forM_ mb_flag $ \flag -> do
-           let sty = mkDumpStyle dflags unqual
+           let sty = mkDumpStyle unqual
            dumpAction dflags sty (dumpOptionsFromFlag flag)
               (showSDoc dflags hdr) FormatCore dump_doc
 
@@ -372,7 +372,7 @@ displayLintResults :: DynFlags -> CoreToDo
 displayLintResults dflags pass warns errs binds
   | not (isEmptyBag errs)
   = do { putLogMsg dflags NoReason Err.SevDump noSrcSpan
-           (defaultDumpStyle dflags)
+           defaultDumpStyle
            (vcat [ lint_banner "errors" (ppr pass), Err.pprMessageBag errs
                  , text "*** Offending Program ***"
                  , pprCoreBindings binds
@@ -385,7 +385,7 @@ displayLintResults dflags pass warns errs binds
   -- If the Core linter encounters an error, output to stderr instead of
   -- stdout (#13342)
   = putLogMsg dflags NoReason Err.SevInfo noSrcSpan
-        (defaultDumpStyle dflags)
+        defaultDumpStyle
         (lint_banner "warnings" (ppr pass) $$ Err.pprMessageBag (mapBag ($$ blankLine) warns))
 
   | otherwise = return ()
@@ -416,7 +416,7 @@ lintInteractiveExpr what hsc_env expr
 
     display_lint_err err
       = do { putLogMsg dflags NoReason Err.SevDump
-               noSrcSpan (defaultDumpStyle dflags)
+               noSrcSpan defaultDumpStyle
                (vcat [ lint_banner "errors" (text what)
                      , err
                      , text "*** Offending Program ***"
@@ -2845,7 +2845,7 @@ lintAnnots pname pass guts = do
     when (not (null diffs)) $ GHC.Core.Opt.Monad.putMsg $ vcat
       [ lint_banner "warning" pname
       , text "Core changes with annotations:"
-      , withPprStyle (defaultDumpStyle dflags) $ nest 2 $ vcat diffs
+      , withPprStyle defaultDumpStyle $ nest 2 $ vcat diffs
       ]
   -- Return actual new guts
   return nguts
diff --git a/compiler/GHC/Core/Opt/Driver.hs b/compiler/GHC/Core/Opt/Driver.hs
index 2d75a22a5c..982f13be35 100644
--- a/compiler/GHC/Core/Opt/Driver.hs
+++ b/compiler/GHC/Core/Opt/Driver.hs
@@ -495,7 +495,7 @@ ruleCheckPass current_phase pat guts =
     ; let rule_fn fn = getRules (RuleEnv rb vis_orphs) fn
                         ++ (mg_rules guts)
     ; liftIO $ putLogMsg dflags NoReason Err.SevDump noSrcSpan
-                   (defaultDumpStyle dflags)
+                   defaultDumpStyle
                    (ruleCheckProgram current_phase pat
                       rule_fn (mg_binds guts))
     ; return guts }
diff --git a/compiler/GHC/Core/Opt/Monad.hs b/compiler/GHC/Core/Opt/Monad.hs
index 44023a1b57..0db18b5790 100644
--- a/compiler/GHC/Core/Opt/Monad.hs
+++ b/compiler/GHC/Core/Opt/Monad.hs
@@ -779,8 +779,8 @@ msg sev reason doc
                      SevDump    -> dump_sty
                      _          -> user_sty
              err_sty  = mkErrStyle dflags unqual
-             user_sty = mkUserStyle dflags unqual AllTheWay
-             dump_sty = mkDumpStyle dflags unqual
+             user_sty = mkUserStyle unqual AllTheWay
+             dump_sty = mkDumpStyle unqual
        ; liftIO $ putLogMsg dflags reason sev loc sty doc }
 
 -- | Output a String message to the screen
@@ -824,5 +824,5 @@ dumpIfSet_dyn flag str fmt doc
   = do { dflags <- getDynFlags
        ; unqual <- getPrintUnqualified
        ; when (dopt flag dflags) $ liftIO $ do
-         let sty = mkDumpStyle dflags unqual
+         let sty = mkDumpStyle unqual
          dumpAction dflags sty (dumpOptionsFromFlag flag) str fmt doc }
diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs
index 483bd5f38c..340efd2c9c 100644
--- a/compiler/GHC/Core/Opt/Simplify.hs
+++ b/compiler/GHC/Core/Opt/Simplify.hs
@@ -1804,7 +1804,7 @@ completeCall env var cont
 
     log_inlining doc
       = liftIO $ dumpAction dflags
-           (mkUserStyle dflags alwaysQualify AllTheWay)
+           (mkUserStyle alwaysQualify AllTheWay)
            (dumpOptionsFromFlag Opt_D_dump_inlinings)
            "" FormatText doc
 
@@ -2092,7 +2092,7 @@ tryRules env rules fn args call_cont
 
     log_rule dflags flag hdr details
       = liftIO $ do
-         let sty = mkDumpStyle dflags alwaysQualify
+         let sty = mkDumpStyle alwaysQualify
          dumpAction dflags sty (dumpOptionsFromFlag flag) "" FormatText $
            sep [text hdr, nest 4 details]
 
diff --git a/compiler/GHC/Core/Rules.hs b/compiler/GHC/Core/Rules.hs
index 4989b22ff0..668f273a1f 100644
--- a/compiler/GHC/Core/Rules.hs
+++ b/compiler/GHC/Core/Rules.hs
@@ -260,14 +260,14 @@ functions (lambdas) except by name, so in this case it seems like
 a good idea to treat 'M.k' as a roughTopName of the call.
 -}
 
-pprRulesForUser :: DynFlags -> [CoreRule] -> SDoc
+pprRulesForUser :: [CoreRule] -> SDoc
 -- (a) tidy the rules
 -- (b) sort them into order based on the rule name
 -- (c) suppress uniques (unless -dppr-debug is on)
 -- This combination makes the output stable so we can use in testing
 -- It's here rather than in GHC.Core.Ppr because it calls tidyRules
-pprRulesForUser dflags rules
-  = withPprStyle (defaultUserStyle dflags) $
+pprRulesForUser rules
+  = withPprStyle defaultUserStyle $
     pprRules $
     sortBy (comparing ruleName) $
     tidyRules emptyTidyEnv rules
diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs
index 041c63c60d..7bae489f22 100644
--- a/compiler/GHC/Driver/Backpack.hs
+++ b/compiler/GHC/Driver/Backpack.hs
@@ -515,9 +515,9 @@ mkBackpackMsg = do
 -- | 'PprStyle' for Backpack messages; here we usually want the module to
 -- be qualified (so we can tell how it was instantiated.) But we try not
 -- to qualify packages so we can use simple names for them.
-backpackStyle :: DynFlags -> PprStyle
-backpackStyle dflags =
-    mkUserStyle dflags
+backpackStyle :: PprStyle
+backpackStyle =
+    mkUserStyle
         (QueryQualify neverQualifyNames
                       alwaysQualifyModules
                       neverQualifyPackages) AllTheWay
@@ -537,7 +537,7 @@ msgUnitId pk = do
     level <- getBkpLevel
     liftIO . backpackProgressMsg level dflags
         $ "Instantiating " ++ renderWithStyle
-                                (initSDocContext dflags (backpackStyle dflags))
+                                (initSDocContext dflags backpackStyle)
                                 (ppr pk)
 
 -- | Message when we include a Backpack unit.
@@ -547,7 +547,7 @@ msgInclude (i,n) uid = do
     level <- getBkpLevel
     liftIO . backpackProgressMsg level dflags
         $ showModuleIndex (i, n) ++ "Including " ++
-          renderWithStyle (initSDocContext dflags (backpackStyle dflags))
+          renderWithStyle (initSDocContext dflags backpackStyle)
             (ppr uid)
 
 -- ----------------------------------------------------------------------------
diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs
index bc29a4a654..a733638934 100644
--- a/compiler/GHC/Driver/CodeOutput.hs
+++ b/compiler/GHC/Driver/CodeOutput.hs
@@ -86,7 +86,7 @@ codeOutput dflags this_mod filenm location foreign_stubs foreign_fps pkg_deps
                                                    NoReason
                                                    SevDump
                                                    noSrcSpan
-                                                   (defaultDumpStyle dflags)
+                                                   defaultDumpStyle
                                                    err
                                        ; ghcExit dflags 1
                                        }
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index afcf1bd0bb..563af47e1f 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -1913,7 +1913,7 @@ linkDynLibCheck dflags o_files dep_packages
  = do
     when (haveRtsOptsFlags dflags) $ do
       putLogMsg dflags NoReason SevInfo noSrcSpan
-          (defaultUserStyle dflags)
+          defaultUserStyle
           (text "Warning: -rtsopts and -with-rtsopts have no effect with -shared." $$
            text "    Call hs_init_ghc() from your main() function to set these options.")
 
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index ef6de96340..474c61b563 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -5217,4 +5217,4 @@ initSDocContext dflags style = SDC
 
 -- | Initialize the pretty-printing options using the default user style
 initDefaultSDocContext :: DynFlags -> SDocContext
-initDefaultSDocContext dflags = initSDocContext dflags (defaultUserStyle dflags)
+initDefaultSDocContext dflags = initSDocContext dflags defaultUserStyle
diff --git a/compiler/GHC/Iface/Binary.hs b/compiler/GHC/Iface/Binary.hs
index ef5b615f58..49e3b00e50 100644
--- a/compiler/GHC/Iface/Binary.hs
+++ b/compiler/GHC/Iface/Binary.hs
@@ -101,7 +101,7 @@ readBinIface_ dflags checkHiWay traceBinIFaceReading hi_path ncu = do
                                     NoReason
                                     SevOutput
                                     noSrcSpan
-                                    (defaultDumpStyle dflags)
+                                    defaultDumpStyle
                                     sd
                       QuietBinIFaceReading -> \_ -> return ()
 
diff --git a/compiler/GHC/Iface/Ext/Utils.hs b/compiler/GHC/Iface/Ext/Utils.hs
index 3b9bb2b4aa..9684a493b2 100644
--- a/compiler/GHC/Iface/Ext/Utils.hs
+++ b/compiler/GHC/Iface/Ext/Utils.hs
@@ -44,8 +44,7 @@ generateReferencesMap = foldr (\ast m -> M.unionWith (++) (go ast) m) M.empty
         this = fmap (pure . (nodeSpan ast,)) $ nodeIdentifiers $ nodeInfo ast
 
 renderHieType :: DynFlags -> HieTypeFix -> String
-renderHieType df ht = renderWithStyle (initSDocContext df sty) (ppr $ hieTypeToIface ht)
-  where sty = defaultUserStyle df
+renderHieType dflags ht = renderWithStyle (initSDocContext dflags defaultUserStyle) (ppr $ hieTypeToIface ht)
 
 resolveVisibility :: Type -> [Type] -> [(Bool,Type)]
 resolveVisibility kind ty_args
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index d208eb7433..b66bab1853 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -991,7 +991,6 @@ readIface :: Module -> FilePath
 readIface wanted_mod file_path
   = do  { res <- tryMostM $
                  readBinIface CheckHiWay QuietBinIFaceReading file_path
-        ; dflags <- getDynFlags
         ; case res of
             Right iface
                 -- NB: This check is NOT just a sanity check, it is
@@ -1002,7 +1001,7 @@ readIface wanted_mod file_path
                 | otherwise     -> return (Failed err)
                 where
                   actual_mod = mi_module iface
-                  err = hiModuleNameMismatchWarn dflags wanted_mod actual_mod
+                  err = hiModuleNameMismatchWarn wanted_mod actual_mod
 
             Left exn    -> return (Failed (text (showException exn)))
     }
@@ -1118,7 +1117,7 @@ showIface hsc_env filename = do
                                    neverQualifyModules
                                    neverQualifyPackages
    putLogMsg dflags NoReason SevDump noSrcSpan
-      (mkDumpStyle dflags print_unqual) (pprModIface iface)
+      (mkDumpStyle print_unqual) (pprModIface iface)
 
 -- Show a ModIface but don't display details; suitable for ModIfaces stored in
 -- the EPT.
@@ -1270,8 +1269,8 @@ badIfaceFile file err
   = vcat [text "Bad interface file:" <+> text file,
           nest 4 err]
 
-hiModuleNameMismatchWarn :: DynFlags -> Module -> Module -> MsgDoc
-hiModuleNameMismatchWarn dflags requested_mod read_mod
+hiModuleNameMismatchWarn :: Module -> Module -> MsgDoc
+hiModuleNameMismatchWarn requested_mod read_mod
  | moduleUnit requested_mod == moduleUnit read_mod =
     sep [text "Interface file contains module" <+> quotes (ppr read_mod) <> comma,
          text "but we were expecting module" <+> quotes (ppr requested_mod),
@@ -1282,7 +1281,7 @@ hiModuleNameMismatchWarn dflags requested_mod read_mod
  | otherwise =
   -- ToDo: This will fail to have enough qualification when the package IDs
   -- are the same
-  withPprStyle (mkUserStyle dflags alwaysQualify AllTheWay) $
+  withPprStyle (mkUserStyle alwaysQualify AllTheWay) $
     -- we want the Modules below to be qualified with package names,
     -- so reset the PrintUnqualified setting.
     hsep [ text "Something is amiss; requested module "
diff --git a/compiler/GHC/Iface/Tidy.hs b/compiler/GHC/Iface/Tidy.hs
index 2a6fce5f5c..430ef5ac7c 100644
--- a/compiler/GHC/Iface/Tidy.hs
+++ b/compiler/GHC/Iface/Tidy.hs
@@ -437,7 +437,7 @@ tidyProgram hsc_env  (ModGuts { mg_module    = mod
             Err.dumpIfSet_dyn dflags Opt_D_dump_rules
               (showSDoc dflags (ppr CoreTidy <+> text "rules"))
               Err.FormatText
-              (pprRulesForUser dflags tidy_rules)
+              (pprRulesForUser tidy_rules)
 
           -- Print one-line size info
         ; let cs = coreBindsStats tidy_binds
diff --git a/compiler/GHC/Runtime/Linker.hs b/compiler/GHC/Runtime/Linker.hs
index 18a8ad735d..a5ba2e6ef0 100644
--- a/compiler/GHC/Runtime/Linker.hs
+++ b/compiler/GHC/Runtime/Linker.hs
@@ -237,7 +237,7 @@ showLinkerState :: DynLinker -> DynFlags -> IO ()
 showLinkerState dl dflags
   = do pls <- readPLS dl
        putLogMsg dflags NoReason SevDump noSrcSpan
-          (defaultDumpStyle dflags)
+          defaultDumpStyle
                  (vcat [text "----- Linker state -----",
                         text "Pkgs:" <+> ppr (pkgs_loaded pls),
                         text "Objs:" <+> ppr (objs_loaded pls),
@@ -420,7 +420,7 @@ classifyLdInput dflags f
   | isDynLibFilename platform f = return (Just (DLLPath f))
   | otherwise          = do
         putLogMsg dflags NoReason SevInfo noSrcSpan
-            (defaultUserStyle dflags)
+            defaultUserStyle
             (text ("Warning: ignoring unrecognised input `" ++ f ++ "'"))
         return Nothing
     where platform = targetPlatform dflags
@@ -1414,7 +1414,7 @@ load_dyn hsc_env crash_early dll = do
           when (wopt Opt_WarnMissedExtraSharedLib dflags)
             $ putLogMsg dflags
                 (Reason Opt_WarnMissedExtraSharedLib) SevWarning
-                  noSrcSpan (defaultUserStyle dflags)(note err)
+                  noSrcSpan defaultUserStyle (note err)
   where
     note err = vcat $ map text
       [ err
@@ -1715,7 +1715,7 @@ maybePutStr dflags s
               NoReason
               SevInteractive
               noSrcSpan
-              (defaultUserStyle dflags)
+              defaultUserStyle
               (text s)
 
 maybePutStrLn :: DynFlags -> String -> IO ()
diff --git a/compiler/GHC/Stg/Lint.hs b/compiler/GHC/Stg/Lint.hs
index 0d57be2722..80ca8768f3 100644
--- a/compiler/GHC/Stg/Lint.hs
+++ b/compiler/GHC/Stg/Lint.hs
@@ -75,7 +75,7 @@ lintStgTopBindings dflags this_mod unarised whodunnit binds
         return ()
       Just msg -> do
         putLogMsg dflags NoReason Err.SevDump noSrcSpan
-          (defaultDumpStyle dflags)
+          defaultDumpStyle
           (vcat [ text "*** Stg Lint ErrMsgs: in" <+>
                         text whodunnit <+> text "***",
                   msg,
diff --git a/compiler/GHC/SysTools/ExtraObj.hs b/compiler/GHC/SysTools/ExtraObj.hs
index 7901a318b8..3d12158b5c 100644
--- a/compiler/GHC/SysTools/ExtraObj.hs
+++ b/compiler/GHC/SysTools/ExtraObj.hs
@@ -77,7 +77,7 @@ mkExtraObjToLinkIntoBinary :: DynFlags -> IO FilePath
 mkExtraObjToLinkIntoBinary dflags = do
   when (gopt Opt_NoHsMain dflags && haveRtsOptsFlags dflags) $ do
      putLogMsg dflags NoReason SevInfo noSrcSpan
-         (defaultUserStyle dflags)
+         defaultUserStyle
          (text "Warning: -rtsopts and -with-rtsopts have no effect with -no-hs-main." $$
           text "    Call hs_init_ghc() from your main() function to set these options.")
 
diff --git a/compiler/GHC/SysTools/Process.hs b/compiler/GHC/SysTools/Process.hs
index 83547ab06c..5482a4ef25 100644
--- a/compiler/GHC/SysTools/Process.hs
+++ b/compiler/GHC/SysTools/Process.hs
@@ -282,11 +282,11 @@ builderMainLoop dflags filter_fn pgm real_args mb_cwd mb_env = do
       case msg of
         BuildMsg msg -> do
           putLogMsg dflags NoReason SevInfo noSrcSpan
-              (defaultUserStyle dflags) msg
+              defaultUserStyle msg
           log_loop chan t
         BuildError loc msg -> do
           putLogMsg dflags NoReason SevError (mkSrcSpan loc loc)
-              (defaultUserStyle dflags) msg
+              defaultUserStyle msg
           log_loop chan t
         EOF ->
           log_loop chan  (t-1)
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index b256be47f2..6e21326f62 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -712,8 +712,8 @@ dumpTcRn useUserStyle dumpOpt title fmt doc = do
   printer <- getPrintUnqualified dflags
   real_doc <- wrapDocLoc doc
   let sty = if useUserStyle
-              then mkUserStyle dflags printer AllTheWay
-              else mkDumpStyle dflags printer
+              then mkUserStyle printer AllTheWay
+              else mkDumpStyle printer
   liftIO $ dumpAction dflags sty dumpOpt title fmt real_doc
 
 -- | Add current location if -dppr-debug
diff --git a/compiler/GHC/Utils/Error.hs b/compiler/GHC/Utils/Error.hs
index 4b3683465a..ed12d0104e 100644
--- a/compiler/GHC/Utils/Error.hs
+++ b/compiler/GHC/Utils/Error.hs
@@ -441,7 +441,7 @@ dumpIfSet dflags flag hdr doc
                             NoReason
                             SevDump
                             noSrcSpan
-                            (defaultDumpStyle dflags)
+                            defaultDumpStyle
                             (mkDumpDoc hdr doc)
 
 -- | a wrapper around 'dumpAction'.
@@ -459,7 +459,7 @@ dumpIfSet_dyn_printer :: PrintUnqualified -> DynFlags -> DumpFlag -> String
                          -> DumpFormat -> SDoc -> IO ()
 dumpIfSet_dyn_printer printer dflags flag hdr fmt doc
   = when (dopt flag dflags) $ do
-      let sty = mkDumpStyle dflags printer
+      let sty = mkDumpStyle printer
       dumpAction dflags sty (dumpOptionsFromFlag flag) hdr fmt doc
 
 mkDumpDoc :: String -> SDoc -> SDoc
@@ -627,12 +627,12 @@ compilationProgressMsg :: DynFlags -> String -> IO ()
 compilationProgressMsg dflags msg = do
     traceEventIO $ "GHC progress: " ++ msg
     ifVerbose dflags 1 $
-        logOutput dflags (defaultUserStyle dflags) (text msg)
+        logOutput dflags defaultUserStyle (text msg)
 
 showPass :: DynFlags -> String -> IO ()
 showPass dflags what
   = ifVerbose dflags 2 $
-    logInfo dflags (defaultUserStyle dflags) (text "***" <+> text what <> colon)
+    logInfo dflags defaultUserStyle (text "***" <+> text what <> colon)
 
 data PrintTimings = PrintTimings | DontPrintTimings
   deriving (Eq, Show)
@@ -727,7 +727,7 @@ withTiming' :: MonadIO m
 withTiming' dflags what force_result prtimings action
   = do if verbosity dflags >= 2 || dopt Opt_D_dump_timings dflags
           then do whenPrintTimings $
-                    logInfo dflags (defaultUserStyle dflags) $
+                    logInfo dflags defaultUserStyle $
                       text "***" <+> what <> colon
                   let ctx = initDefaultSDocContext dflags
                   eventBegins ctx what
@@ -743,7 +743,7 @@ withTiming' dflags what force_result prtimings action
                       time = realToFrac (end - start) * 1e-9
 
                   when (verbosity dflags >= 2 && prtimings == PrintTimings)
-                      $ liftIO $ logInfo dflags (defaultUserStyle dflags)
+                      $ liftIO $ logInfo dflags defaultUserStyle
                           (text "!!!" <+> what <> colon <+> text "finished in"
                            <+> doublePrec 2 time
                            <+> text "milliseconds"
@@ -775,17 +775,17 @@ withTiming' dflags what force_result prtimings action
 
 debugTraceMsg :: DynFlags -> Int -> MsgDoc -> IO ()
 debugTraceMsg dflags val msg = ifVerbose dflags val $
-                               logInfo dflags (defaultDumpStyle dflags) msg
+                               logInfo dflags defaultDumpStyle msg
 putMsg :: DynFlags -> MsgDoc -> IO ()
-putMsg dflags msg = logInfo dflags (defaultUserStyle dflags) msg
+putMsg dflags msg = logInfo dflags defaultUserStyle msg
 
 printInfoForUser :: DynFlags -> PrintUnqualified -> MsgDoc -> IO ()
 printInfoForUser dflags print_unqual msg
-  = logInfo dflags (mkUserStyle dflags print_unqual AllTheWay) msg
+  = logInfo dflags (mkUserStyle print_unqual AllTheWay) msg
 
 printOutputForUser :: DynFlags -> PrintUnqualified -> MsgDoc -> IO ()
 printOutputForUser dflags print_unqual msg
-  = logOutput dflags (mkUserStyle dflags print_unqual AllTheWay) msg
+  = logOutput dflags (mkUserStyle print_unqual AllTheWay) msg
 
 logInfo :: DynFlags -> PprStyle -> MsgDoc -> IO ()
 logInfo dflags sty msg
diff --git a/compiler/GHC/Utils/Outputable.hs b/compiler/GHC/Utils/Outputable.hs
index 1f046d2354..b103d3494b 100644
--- a/compiler/GHC/Utils/Outputable.hs
+++ b/compiler/GHC/Utils/Outputable.hs
@@ -64,7 +64,7 @@ module GHC.Utils.Outputable (
         -- * Controlling the style in which output is printed
         BindingSite(..),
 
-        PprStyle, CodeStyle(..), PrintUnqualified(..),
+        PprStyle(..), CodeStyle(..), PrintUnqualified(..),
         QueryQualifyName, QueryQualifyModule, QueryQualifyPackage,
         reallyAlwaysQualify, reallyAlwaysQualifyNames,
         alwaysQualify, alwaysQualifyNames, alwaysQualifyModules,
@@ -252,19 +252,15 @@ neverQualify  = QueryQualify neverQualifyNames
                              neverQualifyModules
                              neverQualifyPackages
 
-defaultUserStyle :: DynFlags -> PprStyle
-defaultUserStyle dflags = mkUserStyle dflags neverQualify AllTheWay
+defaultUserStyle :: PprStyle
+defaultUserStyle = mkUserStyle neverQualify AllTheWay
 
-defaultDumpStyle :: DynFlags -> PprStyle
+defaultDumpStyle :: PprStyle
  -- Print without qualifiers to reduce verbosity, unless -dppr-debug
-defaultDumpStyle dflags
-   | hasPprDebug dflags = PprDebug
-   | otherwise          = PprDump neverQualify
+defaultDumpStyle = PprDump neverQualify
 
-mkDumpStyle :: DynFlags -> PrintUnqualified -> PprStyle
-mkDumpStyle dflags print_unqual
-   | hasPprDebug dflags = PprDebug
-   | otherwise          = PprDump print_unqual
+mkDumpStyle :: PrintUnqualified -> PprStyle
+mkDumpStyle print_unqual = PprDump print_unqual
 
 defaultErrStyle :: DynFlags -> PprStyle
 -- Default style for error messages, when we don't know PrintUnqualified
@@ -276,15 +272,13 @@ defaultErrStyle dflags = mkErrStyle dflags neverQualify
 -- | Style for printing error messages
 mkErrStyle :: DynFlags -> PrintUnqualified -> PprStyle
 mkErrStyle dflags qual =
-   mkUserStyle dflags qual (PartWay (pprUserLength dflags))
+   mkUserStyle qual (PartWay (pprUserLength dflags))
 
-cmdlineParserStyle :: DynFlags -> PprStyle
-cmdlineParserStyle dflags = mkUserStyle dflags alwaysQualify AllTheWay
+cmdlineParserStyle :: PprStyle
+cmdlineParserStyle = mkUserStyle alwaysQualify AllTheWay
 
-mkUserStyle :: DynFlags -> PrintUnqualified -> Depth -> PprStyle
-mkUserStyle dflags unqual depth
-   | hasPprDebug dflags = PprDebug
-   | otherwise          = PprUser unqual depth Uncoloured
+mkUserStyle :: PrintUnqualified -> Depth -> PprStyle
+mkUserStyle unqual depth = PprUser unqual depth Uncoloured
 
 withUserStyle :: PrintUnqualified -> Depth -> SDoc -> SDoc
 withUserStyle unqual depth doc = sdocOption sdocPprDebug $ \case
@@ -502,13 +496,13 @@ printSDocLn ctx mode handle doc =
 printForUser :: DynFlags -> Handle -> PrintUnqualified -> SDoc -> IO ()
 printForUser dflags handle unqual doc
   = printSDocLn ctx PageMode handle doc
-    where ctx = initSDocContext dflags (mkUserStyle dflags unqual AllTheWay)
+    where ctx = initSDocContext dflags (mkUserStyle unqual AllTheWay)
 
 printForUserPartWay :: DynFlags -> Handle -> Int -> PrintUnqualified -> SDoc
                     -> IO ()
 printForUserPartWay dflags handle d unqual doc
   = printSDocLn ctx PageMode handle doc
-    where ctx = initSDocContext dflags (mkUserStyle dflags unqual (PartWay d))
+    where ctx = initSDocContext dflags (mkUserStyle unqual (PartWay d))
 
 -- | Like 'printSDocLn' but specialized with 'LeftMode' and
 -- @'PprCode' 'CStyle'@.  This is typically used to output C-- code.
@@ -533,7 +527,7 @@ mkCodeStyle = PprCode
 -- However, Doc *is* an instance of Show
 -- showSDoc just blasts it out as a string
 showSDoc :: DynFlags -> SDoc -> String
-showSDoc dflags sdoc = renderWithStyle (initSDocContext dflags (defaultUserStyle dflags)) sdoc
+showSDoc dflags sdoc = renderWithStyle (initSDocContext dflags defaultUserStyle) sdoc
 
 -- showSDocUnsafe is unsafe, because `unsafeGlobalDynFlags` might not be
 -- initialised yet.
@@ -550,10 +544,10 @@ showSDocUnqual dflags sdoc = showSDoc dflags sdoc
 showSDocForUser :: DynFlags -> PrintUnqualified -> SDoc -> String
 -- Allows caller to specify the PrintUnqualified to use
 showSDocForUser dflags unqual doc
- = renderWithStyle (initSDocContext dflags (mkUserStyle dflags unqual AllTheWay)) doc
+ = renderWithStyle (initSDocContext dflags (mkUserStyle unqual AllTheWay)) doc
 
 showSDocDump :: DynFlags -> SDoc -> String
-showSDocDump dflags d = renderWithStyle (initSDocContext dflags (defaultDumpStyle dflags)) d
+showSDocDump dflags d = renderWithStyle (initSDocContext dflags defaultDumpStyle) d
 
 showSDocDebug :: DynFlags -> SDoc -> String
 showSDocDebug dflags d = renderWithStyle (initSDocContext dflags PprDebug) d
@@ -579,7 +573,7 @@ showSDocDumpOneLine dflags d
  = let s = Pretty.style{ Pretty.mode = OneLineMode,
                          Pretty.lineLength = irrelevantNCols } in
    Pretty.renderStyle s $
-      runSDoc d (initSDocContext dflags (defaultDumpStyle dflags))
+      runSDoc d (initSDocContext dflags defaultDumpStyle)
 
 irrelevantNCols :: Int
 -- Used for OneLineMode and LeftMode when number of cols isn't used