Remove Outputable Char instancewip/cleanup-outputable

Use 'text' instead of 'ppr'.
Using 'ppr' on the list "hello" rendered as "h,e,l,l,o".

13 files changed, 26 insertions, 24 deletions

diff --git a/compiler/GHC/CmmToAsm.hs b/compiler/GHC/CmmToAsm.hs
index 6ad90496b5..a3417fb368 100644
--- a/compiler/GHC/CmmToAsm.hs
+++ b/compiler/GHC/CmmToAsm.hs
@@ -698,7 +698,7 @@ maybeDumpCfg logger (Just cfg) msg proc_name
 checkLayout :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr]
             -> [NatCmmDecl statics instr]
 checkLayout procsUnsequenced procsSequenced =
-        assertPpr (setNull diff) (ppr "Block sequencing dropped blocks:" <> ppr diff)
+        assertPpr (setNull diff) (text "Block sequencing dropped blocks:" <> ppr diff)
         procsSequenced
   where
         blocks1 = foldl' (setUnion) setEmpty $
diff --git a/compiler/GHC/CmmToAsm/CFG.hs b/compiler/GHC/CmmToAsm/CFG.hs
index 8a8907e6b4..fd20bd1c9f 100644
--- a/compiler/GHC/CmmToAsm/CFG.hs
+++ b/compiler/GHC/CmmToAsm/CFG.hs
@@ -660,7 +660,7 @@ getCfg platform weights graph =
         (CmmCall { cml_cont = Nothing })   -> []
         other ->
             panic "Foo" $
-            assertPpr False (ppr "Unknown successor cause:" <>
+            assertPpr False (text "Unknown successor cause:" <>
               (pdoc platform branch <+> text "=>" <> pdoc platform (G.successors other))) $
             map (\x -> ((bid,x),mkEdgeInfo 0)) $ G.successors other
       where
diff --git a/compiler/GHC/CmmToAsm/X86/CodeGen.hs b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
index 295cd9f555..3c34109c64 100644
--- a/compiler/GHC/CmmToAsm/X86/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
@@ -2015,10 +2015,10 @@ genCondBranch' _ bid id false bool = do
                   -- Use ASSERT so we don't break releases if
                   -- LTT/LE creep in somehow.
                   LTT ->
-                    assertPpr False (ppr "Should have been turned into >")
+                    assertPpr False (text "Should have been turned into >")
                     and_ordered
                   LE  ->
-                    assertPpr False (ppr "Should have been turned into >=")
+                    assertPpr False (text "Should have been turned into >=")
                     and_ordered
                   _   -> and_ordered
 
@@ -3088,9 +3088,9 @@ condFltReg is32Bit cond x y = condFltReg_sse2
                 GU  -> plain_test   dst
                 GEU -> plain_test   dst
                 -- Use ASSERT so we don't break releases if these creep in.
-                LTT -> assertPpr False (ppr "Should have been turned into >") $
+                LTT -> assertPpr False (text "Should have been turned into >") $
                        and_ordered  dst
-                LE  -> assertPpr False (ppr "Should have been turned into >=") $
+                LE  -> assertPpr False (text "Should have been turned into >=") $
                        and_ordered  dst
                 _   -> and_ordered  dst)
 
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index cd2c3e93be..242887b353 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -589,7 +589,7 @@ compileForeign hsc_env lang stub_c = do
           -- This should never happen as viaCPipeline should only return `Nothing` when the stop phase is `StopC`.
           -- and the same should never happen for asPipeline
           -- Future refactoring to not check StopC for this case
-          Nothing -> pprPanic "compileForeign" (ppr stub_c)
+          Nothing -> pprPanic "compileForeign" (text stub_c)
           Just fp -> return fp
 
 compileEmptyStub :: DynFlags -> HscEnv -> FilePath -> ModLocation -> ModuleName -> IO ()
diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs
index f19cb05ab5..72a9e49278 100644
--- a/compiler/GHC/Driver/Pipeline/Execute.hs
+++ b/compiler/GHC/Driver/Pipeline/Execute.hs
@@ -860,9 +860,11 @@ getOutputFilename logger tmpfs stop_phase output basename dflags next_phase mayb
  | otherwise                             = newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule
    suffix
     where
-          getOutputFile_ dflags = case outputFile_ dflags of
-                                    Nothing -> pprPanic "SpecificFile: No filename" (ppr $ (dynamicNow dflags, outputFile_ dflags, dynOutputFile_ dflags))
-                                    Just fn -> fn
+          getOutputFile_ dflags =
+            case outputFile_ dflags of
+              Nothing -> pprPanic "SpecificFile: No filename" (ppr (dynamicNow dflags) $$
+                                                               text (fromMaybe "-" (dynOutputFile_ dflags)))
+              Just fn -> fn
 
           hcsuf      = hcSuf dflags
           odir       = objectDir dflags
diff --git a/compiler/GHC/Hs/Binds.hs b/compiler/GHC/Hs/Binds.hs
index 7ce59266c4..1e759208c1 100644
--- a/compiler/GHC/Hs/Binds.hs
+++ b/compiler/GHC/Hs/Binds.hs
@@ -848,7 +848,7 @@ pprTcSpecPrags (SpecPrags ps)  = vcat (map (ppr . unLoc) ps)
 
 instance Outputable TcSpecPrag where
   ppr (SpecPrag var _ inl)
-    = ppr (extractSpecPragName $ inl_src inl) <+> pprSpec var (text "<type>") inl
+    = text (extractSpecPragName $ inl_src inl) <+> pprSpec var (text "<type>") inl
 
 pprMinimalSig :: (OutputableBndr name)
               => LBooleanFormula (GenLocated l name) -> SDoc
diff --git a/compiler/GHC/Iface/Binary.hs b/compiler/GHC/Iface/Binary.hs
index 8e6fb6f5b7..5d5bacc123 100644
--- a/compiler/GHC/Iface/Binary.hs
+++ b/compiler/GHC/Iface/Binary.hs
@@ -118,7 +118,7 @@ readBinIfaceHeader profile _name_cache checkHiWay traceBinIFace hi_path = do
 
     check_tag <- get bh
     let tag = profileBuildTag profile
-    wantedGot "Way" tag check_tag ppr
+    wantedGot "Way" tag check_tag text
     when (checkHiWay == CheckHiWay) $
         errorOnMismatch "mismatched interface file profile tag" tag check_tag
 
@@ -381,7 +381,7 @@ getSymtabName _name_cache _dict symtab bh = do
         in
           return $! case lookupKnownKeyName u of
                       Nothing -> pprPanic "getSymtabName:unknown known-key unique"
-                                          (ppr i $$ ppr (unpkUnique u))
+                                          (ppr i $$ ppr u)
                       Just n  -> n
 
       _ -> pprPanic "getSymtabName:unknown name tag" (ppr i)
diff --git a/compiler/GHC/Iface/Ext/Binary.hs b/compiler/GHC/Iface/Ext/Binary.hs
index 1e2e4f7127..86dc042e63 100644
--- a/compiler/GHC/Iface/Ext/Binary.hs
+++ b/compiler/GHC/Iface/Ext/Binary.hs
@@ -331,7 +331,7 @@ fromHieName nc hie_name = do
 
     KnownKeyName u -> case lookupKnownKeyName u of
       Nothing -> pprPanic "fromHieName:unknown known-key unique"
-                          (ppr (unpkUnique u))
+                          (ppr u)
       Just n -> pure n
 
 -- ** Reading and writing `HieName`'s
diff --git a/compiler/GHC/Iface/Ext/Types.hs b/compiler/GHC/Iface/Ext/Types.hs
index a0a8a41ece..44619808af 100644
--- a/compiler/GHC/Iface/Ext/Types.hs
+++ b/compiler/GHC/Iface/Ext/Types.hs
@@ -774,7 +774,7 @@ hieNameOcc (KnownKeyName u) =
   case lookupKnownKeyName u of
     Just n -> nameOccName n
     Nothing -> pprPanic "hieNameOcc:unknown known-key unique"
-                        (ppr (unpkUnique u))
+                        (ppr u)
 
 toHieName :: Name -> HieName
 toHieName name
diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs
index 1a978f9000..860833077f 100644
--- a/compiler/GHC/Iface/Recomp.hs
+++ b/compiler/GHC/Iface/Recomp.hs
@@ -653,14 +653,14 @@ checkDependencies hsc_env summary iface
       text "package " <> quotes (ppr old) <>
         text "no longer in dependencies"
      return $ needsRecompileBecause $ UnitDepRemoved old
-   check_packages (new:news) olds
+   check_packages ((new_name, new_unit):news) olds
     | Just (old, olds') <- uncons olds
-    , snd new == old = check_packages (dropWhile ((== (snd new)) . snd) news) olds'
+    , new_unit == old = check_packages (dropWhile ((== new_unit) . snd) news) olds'
     | otherwise = do
         trace_hi_diffs logger $
-         text "imported package " <> quotes (ppr new) <>
-           text " not among previous dependencies"
-        return $ needsRecompileBecause $ ModulePackageChanged $ fst new
+         text "imported package" <+> text new_name <+> ppr new_unit <+>
+           text "not among previous dependencies"
+        return $ needsRecompileBecause $ ModulePackageChanged new_name
 
 
 needInterface :: Module -> (ModIface -> IO RecompileRequired)
diff --git a/compiler/GHC/Linker/Types.hs b/compiler/GHC/Linker/Types.hs
index ac01f35e33..25df199b0f 100644
--- a/compiler/GHC/Linker/Types.hs
+++ b/compiler/GHC/Linker/Types.hs
@@ -244,7 +244,7 @@ data LibrarySpec
    | Framework String   -- Only used for darwin, but does no harm
 
 instance Outputable LibrarySpec where
-  ppr (Objects objs) = text "Objects" <+> ppr objs
+  ppr (Objects objs) = text "Objects" <+> ppr (map text objs)
   ppr (Archive a) = text "Archive" <+> text a
   ppr (DLL s) = text "DLL" <+> text s
   ppr (DLLPath f) = text "DLLPath" <+> text f
diff --git a/compiler/GHC/Tc/Deriv.hs b/compiler/GHC/Tc/Deriv.hs
index 7df65bd367..f12fefcffe 100644
--- a/compiler/GHC/Tc/Deriv.hs
+++ b/compiler/GHC/Tc/Deriv.hs
@@ -1926,7 +1926,7 @@ genFamInsts spec@(DS { ds_tvs = tyvars, ds_mechanism = mechanism
           -- canDeriveAnyClass should ensure that this code can't be reached
           -- unless -XDeriveAnyClass is enabled.
           assertPpr (xopt LangExt.DeriveAnyClass dflags)
-                    (ppr "genFamInsts: bad derived class" <+> ppr clas) $
+                    (text "genFamInsts: bad derived class" <+> ppr clas) $
           mapM (tcATDefault loc mini_subst emptyNameSet)
                (classATItems clas)
         pure $ concat tyfam_insts
diff --git a/compiler/GHC/Utils/Outputable.hs b/compiler/GHC/Utils/Outputable.hs
index bd8204f856..a9b8ca384e 100644
--- a/compiler/GHC/Utils/Outputable.hs
+++ b/compiler/GHC/Utils/Outputable.hs
@@ -895,8 +895,8 @@ keyword = coloured Col.colBold
 class Outputable a where
     ppr :: a -> SDoc
 
-instance Outputable Char where
-    ppr c = text [c]
+-- There's no Outputable for Char; it's too easy to use Outputable
+-- on String and have ppr "hello" rendered as "h,e,l,l,o".
 
 instance Outputable Bool where
     ppr True  = text "True"