Fully remove PprDebug

PprDebug was a pain to deal with consistently as it is implied by
`-dppr-debug` but it isn't really a PprStyle. We remove it completely
and query the appropriate SDoc flag instead (`sdocPprDebug`) via
helpers (`getPprDebug` and its friends).

13 files changed, 102 insertions, 94 deletions

diff --git a/compiler/GHC/Core/Ppr.hs b/compiler/GHC/Core/Ppr.hs
index e9c746d7a6..c0b2749359 100644
--- a/compiler/GHC/Core/Ppr.hs
+++ b/compiler/GHC/Core/Ppr.hs
@@ -375,8 +375,8 @@ pprCoreBinder LetBind binder
 
 -- Lambda bound type variables are preceded by "@"
 pprCoreBinder bind_site bndr
-  = getPprStyle $ \ sty ->
-    pprTypedLamBinder bind_site (debugStyle sty) bndr
+  = getPprDebug $ \debug ->
+    pprTypedLamBinder bind_site debug bndr
 
 pprUntypedBinder :: Var -> SDoc
 pprUntypedBinder binder
diff --git a/compiler/GHC/Core/TyCo/Ppr.hs b/compiler/GHC/Core/TyCo/Ppr.hs
index 973641bf5c..6678a00559 100644
--- a/compiler/GHC/Core/TyCo/Ppr.hs
+++ b/compiler/GHC/Core/TyCo/Ppr.hs
@@ -93,7 +93,8 @@ pprPrecType = pprPrecTypeX emptyTidyEnv
 pprPrecTypeX :: TidyEnv -> PprPrec -> Type -> SDoc
 pprPrecTypeX env prec ty
   = getPprStyle $ \sty ->
-    if debugStyle sty           -- Use debugPprType when in
+    getPprDebug $ \debug ->
+    if debug                    -- Use debugPprType when in
     then debug_ppr_ty prec ty   -- when in debug-style
     else pprPrecIfaceType prec (tidyToIfaceTypeStyX env ty sty)
     -- NB: debug-style is used for -dppr-debug
diff --git a/compiler/GHC/Core/TyCon.hs b/compiler/GHC/Core/TyCon.hs
index 863c3b2f46..0f850f2278 100644
--- a/compiler/GHC/Core/TyCon.hs
+++ b/compiler/GHC/Core/TyCon.hs
@@ -2576,9 +2576,11 @@ instance Outputable TyCon where
   -- corresponding TyCon, so we add the quote to distinguish it here
   ppr tc = pprPromotionQuote tc <> ppr (tyConName tc) <> pp_tc
     where
-      pp_tc = getPprStyle $ \sty -> if ((debugStyle sty || dumpStyle sty) && isTcTyCon tc)
-                                    then text "[tc]"
-                                    else empty
+      pp_tc = getPprStyle $ \sty ->
+              getPprDebug $ \debug ->
+               if ((debug || dumpStyle sty) && isTcTyCon tc)
+                  then text "[tc]"
+                  else empty
 
 -- | Paints a picture of what a 'TyCon' represents, in broad strokes.
 -- This is used towards more informative error messages.
diff --git a/compiler/GHC/Hs/Binds.hs b/compiler/GHC/Hs/Binds.hs
index 0252656203..ccc5a8d422 100644
--- a/compiler/GHC/Hs/Binds.hs
+++ b/compiler/GHC/Hs/Binds.hs
@@ -630,11 +630,10 @@ instance (OutputableBndrId pl, OutputableBndrId pr)
    = pprDeclList (pprLHsBindsForUser binds sigs)
 
   ppr (XValBindsLR (NValBinds sccs sigs))
-    = getPprStyle $ \ sty ->
-      if debugStyle sty then    -- Print with sccs showing
-        vcat (map ppr sigs) $$ vcat (map ppr_scc sccs)
-     else
-        pprDeclList (pprLHsBindsForUser (unionManyBags (map snd sccs)) sigs)
+    = getPprDebug $ \case
+        -- Print with sccs showing
+        True  -> vcat (map ppr sigs) $$ vcat (map ppr_scc sccs)
+        False -> pprDeclList (pprLHsBindsForUser (unionManyBags (map snd sccs)) sigs)
    where
      ppr_scc (rec_flag, binds) = pp_rec rec_flag <+> pprLHsBinds binds
      pp_rec Recursive    = text "rec"
@@ -784,9 +783,11 @@ pprTicks :: SDoc -> SDoc -> SDoc
 -- Also print ticks in dumpStyle, so that -ddump-hpc actually does
 -- something useful.
 pprTicks pp_no_debug pp_when_debug
-  = getPprStyle (\ sty -> if debugStyle sty || dumpStyle sty
-                             then pp_when_debug
-                             else pp_no_debug)
+  = getPprStyle $ \sty ->
+    getPprDebug $ \debug ->
+      if debug || dumpStyle sty
+         then pp_when_debug
+         else pp_no_debug
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index 97eab7d3aa..2ef0d62db4 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -17,6 +17,7 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeFamilyDependencies #-}
+{-# LANGUAGE LambdaCase #-}
 
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
@@ -187,8 +188,8 @@ instance Outputable SyntaxExprTc where
                     , syn_arg_wraps = arg_wraps
                     , syn_res_wrap  = res_wrap })
     = sdocOption sdocPrintExplicitCoercions $ \print_co ->
-      getPprStyle $ \s ->
-      if debugStyle s || print_co
+      getPprDebug $ \debug ->
+      if debug || print_co
       then ppr expr <> braces (pprWithCommas ppr arg_wraps)
                     <> braces (ppr res_wrap)
       else ppr expr
@@ -1141,9 +1142,9 @@ can see the structure of the parse tree.
 pprDebugParendExpr :: (OutputableBndrId p)
                    => PprPrec -> LHsExpr (GhcPass p) -> SDoc
 pprDebugParendExpr p expr
-  = getPprStyle (\sty ->
-    if debugStyle sty then pprParendLExpr p expr
-                      else pprLExpr      expr)
+  = getPprDebug $ \case
+      True  -> pprParendLExpr p expr
+      False -> pprLExpr         expr
 
 pprParendLExpr :: (OutputableBndrId p)
                => PprPrec -> LHsExpr (GhcPass p) -> SDoc
diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs
index 4f73aa3e98..50d3cf4aef 100644
--- a/compiler/GHC/Hs/Pat.hs
+++ b/compiler/GHC/Hs/Pat.hs
@@ -514,14 +514,13 @@ hsRecUpdFieldOcc = fmap unambiguousFieldOcc . hsRecFieldLbl
 instance OutputableBndrId p => Outputable (Pat (GhcPass p)) where
     ppr = pprPat
 
+-- | Print with type info if -dppr-debug is on
 pprPatBndr :: OutputableBndr name => name -> SDoc
-pprPatBndr var                  -- Print with type info if -dppr-debug is on
-  = getPprStyle $ \ sty ->
-    if debugStyle sty then
-        parens (pprBndr LambdaBind var)         -- Could pass the site to pprPat
-                                                -- but is it worth it?
-    else
-        pprPrefixOcc var
+pprPatBndr var
+  = getPprDebug $ \case
+      True -> parens (pprBndr LambdaBind var) -- Could pass the site to pprPat
+                                              -- but is it worth it?
+      False -> pprPrefixOcc var
 
 pprParendLPat :: (OutputableBndrId p)
               => PprPrec -> LPat (GhcPass p) -> SDoc
diff --git a/compiler/GHC/Iface/Type.hs b/compiler/GHC/Iface/Type.hs
index 5c2172f96f..40ba0d54a1 100644
--- a/compiler/GHC/Iface/Type.hs
+++ b/compiler/GHC/Iface/Type.hs
@@ -692,7 +692,8 @@ if_print_coercions :: SDoc  -- ^ if printing coercions
 if_print_coercions yes no
   = sdocOption sdocPrintExplicitCoercions $ \print_co ->
     getPprStyle $ \style ->
-    if print_co || dumpStyle style || debugStyle style
+    getPprDebug $ \debug ->
+    if print_co || dumpStyle style || debug
     then yes
     else no
 
@@ -1286,12 +1287,12 @@ pprIfaceTypeApp prec tc args = pprTyTcApp prec tc args
 pprTyTcApp :: PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
 pprTyTcApp ctxt_prec tc tys =
     sdocOption sdocPrintExplicitKinds $ \print_kinds ->
-    getPprStyle $ \style ->
-    pprTyTcApp' ctxt_prec tc tys (PrintExplicitKinds print_kinds) style
+    getPprDebug $ \debug ->
+    pprTyTcApp' ctxt_prec tc tys (PrintExplicitKinds print_kinds) debug
 
 pprTyTcApp' :: PprPrec -> IfaceTyCon -> IfaceAppArgs
-            -> PrintExplicitKinds -> PprStyle -> SDoc
-pprTyTcApp' ctxt_prec tc tys printExplicitKinds style
+            -> PrintExplicitKinds -> Bool -> SDoc
+pprTyTcApp' ctxt_prec tc tys printExplicitKinds debug
   | ifaceTyConName tc `hasKey` ipClassKey
   , IA_Arg (IfaceLitTy (IfaceStrTyLit n))
            Required (IA_Arg ty Required IA_Nil) <- tys
@@ -1299,7 +1300,7 @@ pprTyTcApp' ctxt_prec tc tys printExplicitKinds style
     $ char '?' <> ftext n <> text "::" <> ppr_ty topPrec ty
 
   | IfaceTupleTyCon arity sort <- ifaceTyConSort info
-  , not (debugStyle style)
+  , not debug
   , arity == ifaceVisAppArgsLength tys
   = pprTuple ctxt_prec sort (ifaceTyConIsPromoted info) tys
 
@@ -1382,8 +1383,9 @@ ppr_equality ctxt_prec tc args
         sdocOption sdocPrintExplicitKinds $ \print_kinds ->
         sdocOption sdocPrintEqualityRelations $ \print_eqs ->
         getPprStyle      $ \style  ->
+        getPprDebug      $ \debug  ->
         print_equality' args print_kinds
-          (print_eqs || dumpStyle style || debugStyle style)
+          (print_eqs || dumpStyle style || debug)
 
     print_equality' (ki1, ki2, ty1, ty2) print_kinds print_eqs
       | -- If -fprint-equality-relations is on, just print the original TyCon
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index 6c7e121bd6..b0d797885b 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -11,6 +11,7 @@ This module converts Template Haskell syntax into Hs syntax
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE LambdaCase #-}
 
 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns   #-}
@@ -134,15 +135,15 @@ wrapMsg :: (Show a, TH.Ppr a) => String -> a -> CvtM b -> CvtM b
 -- E.g  wrapMsg "declaration" dec thing
 wrapMsg what item (CvtM m)
   = CvtM $ \origin loc -> case m origin loc of
-      Left err -> Left (err $$ getPprStyle msg)
+      Left err -> Left (err $$ msg)
       Right v  -> Right v
   where
         -- Show the item in pretty syntax normally,
         -- but with all its constructors if you say -dppr-debug
-    msg sty = hang (text "When splicing a TH" <+> text what <> colon)
-                 2 (if debugStyle sty
-                    then text (show item)
-                    else text (pprint item))
+    msg = hang (text "When splicing a TH" <+> text what <> colon)
+                 2 (getPprDebug $ \case
+                     True  -> text (show item)
+                     False -> text (pprint item))
 
 wrapL :: CvtM a -> CvtM (Located a)
 wrapL (CvtM m) = CvtM $ \origin loc -> case m origin loc of
diff --git a/compiler/GHC/Types/Name.hs b/compiler/GHC/Types/Name.hs
index fe316542ae..e587b08d0a 100644
--- a/compiler/GHC/Types/Name.hs
+++ b/compiler/GHC/Types/Name.hs
@@ -531,24 +531,25 @@ instance OutputableBndr Name where
 
 pprName :: Name -> SDoc
 pprName (Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
-  = getPprStyle $ \ sty ->
+  = getPprStyle $ \sty ->
+    getPprDebug $ \debug ->
     case sort of
-      WiredIn mod _ builtin   -> pprExternal sty uniq mod occ True  builtin
-      External mod            -> pprExternal sty uniq mod occ False UserSyntax
-      System                  -> pprSystem sty uniq occ
-      Internal                -> pprInternal sty uniq occ
+      WiredIn mod _ builtin   -> pprExternal debug sty uniq mod occ True  builtin
+      External mod            -> pprExternal debug sty uniq mod occ False UserSyntax
+      System                  -> pprSystem   debug sty uniq occ
+      Internal                -> pprInternal debug sty uniq occ
 
 -- | Print the string of Name unqualifiedly directly.
 pprNameUnqualified :: Name -> SDoc
 pprNameUnqualified Name { n_occ = occ } = ppr_occ_name occ
 
-pprExternal :: PprStyle -> Unique -> Module -> OccName -> Bool -> BuiltInSyntax -> SDoc
-pprExternal sty uniq mod occ is_wired is_builtin
+pprExternal :: Bool -> PprStyle -> Unique -> Module -> OccName -> Bool -> BuiltInSyntax -> SDoc
+pprExternal debug sty uniq mod occ is_wired is_builtin
   | codeStyle sty = ppr mod <> char '_' <> ppr_z_occ_name occ
         -- In code style, always qualify
         -- ToDo: maybe we could print all wired-in things unqualified
         --       in code style, to reduce symbol table bloat?
-  | debugStyle sty = pp_mod <> ppr_occ_name occ
+  | debug         = pp_mod <> ppr_occ_name occ
                      <> braces (hsep [if is_wired then text "(w)" else empty,
                                       pprNameSpaceBrief (occNameSpace occ),
                                       pprUnique uniq])
@@ -563,10 +564,10 @@ pprExternal sty uniq mod occ is_wired is_builtin
     pp_mod = ppUnlessOption sdocSuppressModulePrefixes
                (ppr mod <> dot)
 
-pprInternal :: PprStyle -> Unique -> OccName -> SDoc
-pprInternal sty uniq occ
+pprInternal :: Bool -> PprStyle -> Unique -> OccName -> SDoc
+pprInternal debug sty uniq occ
   | codeStyle sty  = pprUniqueAlways uniq
-  | debugStyle sty = ppr_occ_name occ <> braces (hsep [pprNameSpaceBrief (occNameSpace occ),
+  | debug          = ppr_occ_name occ <> braces (hsep [pprNameSpaceBrief (occNameSpace occ),
                                                        pprUnique uniq])
   | dumpStyle sty  = ppr_occ_name occ <> ppr_underscore_unique uniq
                         -- For debug dumps, we're not necessarily dumping
@@ -574,10 +575,10 @@ pprInternal sty uniq occ
   | otherwise      = ppr_occ_name occ   -- User style
 
 -- Like Internal, except that we only omit the unique in Iface style
-pprSystem :: PprStyle -> Unique -> OccName -> SDoc
-pprSystem sty uniq occ
+pprSystem :: Bool -> PprStyle -> Unique -> OccName -> SDoc
+pprSystem debug sty uniq occ
   | codeStyle sty  = pprUniqueAlways uniq
-  | debugStyle sty = ppr_occ_name occ <> ppr_underscore_unique uniq
+  | debug          = ppr_occ_name occ <> ppr_underscore_unique uniq
                      <> braces (pprNameSpaceBrief (occNameSpace occ))
   | otherwise      = ppr_occ_name occ <> ppr_underscore_unique uniq
                                 -- If the tidy phase hasn't run, the OccName
diff --git a/compiler/GHC/Types/Name/Occurrence.hs b/compiler/GHC/Types/Name/Occurrence.hs
index 4c5ac689f2..d7f7cc8c9d 100644
--- a/compiler/GHC/Types/Name/Occurrence.hs
+++ b/compiler/GHC/Types/Name/Occurrence.hs
@@ -273,11 +273,8 @@ pprOccName (OccName sp occ)
   = getPprStyle $ \ sty ->
     if codeStyle sty
     then ztext (zEncodeFS occ)
-    else pp_occ <> pp_debug sty
+    else pp_occ <> whenPprDebug (braces (pprNameSpaceBrief sp))
   where
-    pp_debug sty | debugStyle sty = braces (pprNameSpaceBrief sp)
-                 | otherwise      = empty
-
     pp_occ = sdocOption sdocSuppressUniques $ \case
                True  -> text (strip_th_unique (unpackFS occ))
                False -> ftext occ
diff --git a/compiler/GHC/Types/Var.hs b/compiler/GHC/Types/Var.hs
index 1479856fb4..d58065305e 100644
--- a/compiler/GHC/Types/Var.hs
+++ b/compiler/GHC/Types/Var.hs
@@ -300,21 +300,29 @@ After CoreTidy, top-level LocalIds are turned into GlobalIds
 
 instance Outputable Var where
   ppr var = sdocOption sdocSuppressVarKinds $ \supp_var_kinds ->
-            getPprStyle $ \ppr_style ->
-            if |  debugStyle ppr_style && (not supp_var_kinds)
-                 -> parens (ppr (varName var) <+> ppr_debug var ppr_style <+>
+            getPprDebug $ \debug ->
+            getPprStyle $ \sty ->
+            let
+              ppr_var = case var of
+                  (TyVar {})
+                     | debug
+                     -> brackets (text "tv")
+
+                  (TcTyVar {tc_tv_details = d})
+                     | dumpStyle sty || debug
+                     -> brackets (pprTcTyVarDetails d)
+
+                  (Id { idScope = s, id_details = d })
+                     | debug
+                     -> brackets (ppr_id_scope s <> pprIdDetails d)
+
+                  _  -> empty
+            in if
+               |  debug && (not supp_var_kinds)
+                 -> parens (ppr (varName var) <+> ppr_var <+>
                           dcolon <+> pprKind (tyVarKind var))
                |  otherwise
-                 -> ppr (varName var) <> ppr_debug var ppr_style
-
-ppr_debug :: Var -> PprStyle -> SDoc
-ppr_debug (TyVar {}) sty
-  | debugStyle sty = brackets (text "tv")
-ppr_debug (TcTyVar {tc_tv_details = d}) sty
-  | dumpStyle sty || debugStyle sty = brackets (pprTcTyVarDetails d)
-ppr_debug (Id { idScope = s, id_details = d }) sty
-  | debugStyle sty = brackets (ppr_id_scope s <> pprIdDetails d)
-ppr_debug _ _ = empty
+                 -> ppr (varName var) <> ppr_var
 
 ppr_id_scope :: IdScope -> SDoc
 ppr_id_scope GlobalId              = text "gid"
diff --git a/compiler/GHC/Unit/Types.hs b/compiler/GHC/Unit/Types.hs
index a42f0c0c78..7282b385b6 100644
--- a/compiler/GHC/Unit/Types.hs
+++ b/compiler/GHC/Unit/Types.hs
@@ -506,10 +506,10 @@ instance Uniquable UnitId where
 
 instance Outputable UnitId where
     ppr uid@(UnitId fs) =
-        getPprStyle $ \sty ->
+        getPprDebug $ \debug ->
         sdocWithDynFlags $ \dflags ->
           case displayUnitId (pkgState dflags) uid of
-            Just str | not (debugStyle sty) -> text str
+            Just str | not debug -> text str
             _ -> ftext fs
 
 -- | A 'DefUnitId' is an 'UnitId' with the invariant that
@@ -562,8 +562,8 @@ instance Uniquable unit => Uniquable (Indefinite unit) where
 instance Outputable unit => Outputable (Indefinite unit) where
   ppr (Indefinite uid Nothing)        = ppr uid
   ppr (Indefinite uid (Just pprinfo)) =
-    getPprStyle $ \sty ->
-      if debugStyle sty
+    getPprDebug $ \debug ->
+      if debug
          then ppr uid
          else ppr pprinfo
 
diff --git a/compiler/GHC/Utils/Outputable.hs b/compiler/GHC/Utils/Outputable.hs
index b103d3494b..ba843cef30 100644
--- a/compiler/GHC/Utils/Outputable.hs
+++ b/compiler/GHC/Utils/Outputable.hs
@@ -76,7 +76,7 @@ module GHC.Utils.Outputable (
         SDocContext (..), sdocWithContext,
         getPprStyle, withPprStyle, setStyleColoured,
         pprDeeper, pprDeeperList, pprSetDepth,
-        codeStyle, userStyle, debugStyle, dumpStyle, asmStyle,
+        codeStyle, userStyle, dumpStyle, asmStyle,
         qualName, qualModule, qualPackage,
         mkErrStyle, defaultErrStyle, defaultDumpStyle, mkDumpStyle, defaultUserStyle,
         mkUserStyle, cmdlineParserStyle, Depth(..),
@@ -155,12 +155,10 @@ data PprStyle
                 -- printed without uniques.
 
   | PprDump PrintUnqualified
-                -- For -ddump-foo; less verbose than PprDebug, but more than PprUser
+                -- For -ddump-foo; less verbose than in ppr-debug mode, but more than PprUser
                 -- Does not assume tidied code: non-external names
                 -- are printed with uniques.
 
-  | PprDebug    -- Full debugging output
-
   | PprCode CodeStyle
                 -- Print code; either C or assembler
 
@@ -262,11 +260,10 @@ defaultDumpStyle = PprDump neverQualify
 mkDumpStyle :: PrintUnqualified -> PprStyle
 mkDumpStyle print_unqual = PprDump print_unqual
 
-defaultErrStyle :: DynFlags -> PprStyle
--- Default style for error messages, when we don't know PrintUnqualified
+-- | Default style for error messages, when we don't know PrintUnqualified
 -- It's a bit of a hack because it doesn't take into account what's in scope
 -- Only used for desugarer warnings, and typechecker errors in interface sigs
--- NB that -dppr-debug will still get into PprDebug style
+defaultErrStyle :: DynFlags -> PprStyle
 defaultErrStyle dflags = mkErrStyle dflags neverQualify
 
 -- | Style for printing error messages
@@ -281,9 +278,7 @@ mkUserStyle :: PrintUnqualified -> Depth -> PprStyle
 mkUserStyle unqual depth = PprUser unqual depth Uncoloured
 
 withUserStyle :: PrintUnqualified -> Depth -> SDoc -> SDoc
-withUserStyle unqual depth doc = sdocOption sdocPprDebug $ \case
-   True  -> withPprStyle PprDebug doc
-   False -> withPprStyle (PprUser unqual depth Uncoloured) doc
+withUserStyle unqual depth doc = withPprStyle (PprUser unqual depth Uncoloured) doc
 
 withErrStyle :: PrintUnqualified -> SDoc -> SDoc
 withErrStyle unqual doc =
@@ -303,7 +298,6 @@ instance Outputable PprStyle where
   ppr (PprUser {})  = text "user-style"
   ppr (PprCode {})  = text "code-style"
   ppr (PprDump {})  = text "dump-style"
-  ppr (PprDebug {}) = text "debug-style"
 
 {-
 Orthogonal to the above printing styles are (possibly) some
@@ -457,23 +451,20 @@ dumpStyle :: PprStyle -> Bool
 dumpStyle (PprDump {}) = True
 dumpStyle _other       = False
 
-debugStyle :: PprStyle -> Bool
-debugStyle PprDebug = True
-debugStyle _other   = False
-
 userStyle ::  PprStyle -> Bool
 userStyle (PprUser {}) = True
 userStyle _other       = False
 
+-- | Indicate if -dppr-debug mode is enabled
 getPprDebug :: (Bool -> SDoc) -> SDoc
-getPprDebug d = getPprStyle $ \ sty -> d (debugStyle sty)
+getPprDebug d = sdocWithContext $ \ctx -> d (sdocPprDebug ctx)
 
+-- | Says what to do with and without -dppr-debug
 ifPprDebug :: SDoc -> SDoc -> SDoc
--- ^ Says what to do with and without -dppr-debug
-ifPprDebug yes no = getPprDebug $ \ dbg -> if dbg then yes else no
+ifPprDebug yes no = getPprDebug $ \dbg -> if dbg then yes else no
 
+-- | Says what to do with -dppr-debug; without, return empty
 whenPprDebug :: SDoc -> SDoc        -- Empty for non-debug style
--- ^ Says what to do with -dppr-debug; without, return empty
 whenPprDebug d = ifPprDebug d empty
 
 -- | The analog of 'Pretty.printDoc_' for 'SDoc', which tries to make sure the
@@ -550,7 +541,11 @@ showSDocDump :: DynFlags -> SDoc -> String
 showSDocDump dflags d = renderWithStyle (initSDocContext dflags defaultDumpStyle) d
 
 showSDocDebug :: DynFlags -> SDoc -> String
-showSDocDebug dflags d = renderWithStyle (initSDocContext dflags PprDebug) d
+showSDocDebug dflags d = renderWithStyle ctx d
+   where
+      ctx = (initSDocContext dflags defaultDumpStyle)
+               { sdocPprDebug = True
+               }
 
 renderWithStyle :: SDocContext -> SDoc -> String
 renderWithStyle ctx sdoc
@@ -580,7 +575,7 @@ irrelevantNCols :: Int
 irrelevantNCols = 1
 
 isEmpty :: SDocContext -> SDoc -> Bool
-isEmpty ctx sdoc = Pretty.isEmpty $ runSDoc sdoc (ctx {sdocStyle = PprDebug})
+isEmpty ctx sdoc = Pretty.isEmpty $ runSDoc sdoc (ctx {sdocPprDebug = True})
 
 docToSDoc :: Doc -> SDoc
 docToSDoc d = SDoc (\_ -> d)