Be less verbose when printing Names when we don't know what's in scope

Previously we always printed qualified names, but that makes a lot of debug or
warning output very verbose. So now we only print qualified names with -dppr-debug.

Civilised output (from pukka error messages, with the environment available) is
unaffected

10 files changed, 56 insertions, 64 deletions

diff --git a/compiler/stranal/WwLib.lhs b/compiler/stranal/WwLib.lhs
index 68292839ed..4610b58734 100644
--- a/compiler/stranal/WwLib.lhs
+++ b/compiler/stranal/WwLib.lhs
@@ -732,7 +732,7 @@ mk_absent_let dflags arg
   where
     arg_ty  = idType arg
     abs_rhs = mkRuntimeErrorApp aBSENT_ERROR_ID arg_ty msg
-    msg     = showSDocDebug dflags (ppr arg <+> ppr (idType arg))
+    msg     = showSDoc dflags (ppr arg <+> ppr (idType arg))
 
 mk_seq_case :: Id -> CoreExpr -> CoreExpr
 mk_seq_case arg body = Case (Var arg) (sanitiseCaseBndr arg) (exprType body) [(DEFAULT, [], body)]
diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs
index e8d9347767..85d3d03557 100644
--- a/compiler/utils/Outputable.lhs
+++ b/compiler/utils/Outputable.lhs
@@ -190,31 +190,30 @@ neverQualify  = (neverQualifyNames,  neverQualifyModules)
 
 defaultUserStyle, defaultDumpStyle :: PprStyle
 
-defaultUserStyle = mkUserStyle alwaysQualify AllTheWay
+defaultUserStyle = mkUserStyle neverQualify AllTheWay
+ -- Print without qualifiers to reduce verbosity, unless -dppr-debug
 
 defaultDumpStyle |  opt_PprStyle_Debug = PprDebug
                  |  otherwise          = PprDump
 
+defaultErrStyle :: DynFlags -> PprStyle
+-- 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 dflags = mkErrStyle dflags neverQualify
+
 -- | Style for printing error messages
 mkErrStyle :: DynFlags -> PrintUnqualified -> PprStyle
 mkErrStyle dflags qual = mkUserStyle qual (PartWay (pprUserLength dflags))
 
-defaultErrStyle :: DynFlags -> PprStyle
--- Default style for error messages
--- 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
-defaultErrStyle dflags = mkUserStyle alwaysQualify depth
-    where depth = if opt_PprStyle_Debug
-                  then AllTheWay
-                  else PartWay (pprUserLength dflags)
+cmdlineParserStyle :: PprStyle
+cmdlineParserStyle = mkUserStyle alwaysQualify AllTheWay
 
 mkUserStyle :: PrintUnqualified -> Depth -> PprStyle
 mkUserStyle unqual depth
    | opt_PprStyle_Debug = PprDebug
    | otherwise          = PprUser unqual depth
-
-cmdlineParserStyle :: PprStyle
-cmdlineParserStyle = PprUser alwaysQualify AllTheWay
 \end{code}
 
 Orthogonal to the above printing styles are (possibly) some
@@ -979,7 +978,7 @@ assertPprPanic file line msg
 
 pprDebugAndThen :: DynFlags -> (String -> a) -> String -> SDoc -> a
 pprDebugAndThen dflags cont heading pretty_msg
- = cont (showSDocDebug dflags doc)
+ = cont (showSDoc dflags doc)
  where
      doc = sep [text heading, nest 4 pretty_msg]
 \end{code}
diff --git a/testsuite/tests/plugins/plugins02.stderr b/testsuite/tests/plugins/plugins02.stderr
index 2fee69361e..185d13be9a 100644
--- a/testsuite/tests/plugins/plugins02.stderr
+++ b/testsuite/tests/plugins/plugins02.stderr
@@ -1 +1 @@
-<command line>: The value Simple.BadlyTypedPlugin.plugin did not have the type CoreMonad.Plugin as required
+<command line>: The value plugin did not have the type Plugin as required
diff --git a/testsuite/tests/quasiquotation/T7918.stdout b/testsuite/tests/quasiquotation/T7918.stdout
index 43de631493..f4d406b591 100644
--- a/testsuite/tests/quasiquotation/T7918.stdout
+++ b/testsuite/tests/quasiquotation/T7918.stdout
@@ -1,27 +1,27 @@
-(GHC.Types.True, T7918B.hs:6:11-14)
-(GHC.Base.id, T7918B.hs:7:11-14)
-(GHC.Types.True, T7918B.hs:7:11-14)
-(GHC.Types.True, T7918B.hs:8:11-14)
-(GHC.Classes.||, T7918B.hs:8:11-14)
-(GHC.Types.False, T7918B.hs:8:11-14)
-(GHC.Types.False, T7918B.hs:9:11-14)
-(GHC.Err.undefined, T7918B.hs:11:7-15)
-(GHC.Types.Bool, T7918B.hs:11:24-27)
-(GHC.Err.undefined, T7918B.hs:12:7-15)
-(Data.Maybe.Maybe, T7918B.hs:12:24-27)
-(GHC.Types.Bool, T7918B.hs:12:24-27)
-(GHC.Err.undefined, T7918B.hs:13:7-15)
-(Data.Either.Either, T7918B.hs:13:24-27)
-(GHC.Types.Bool, T7918B.hs:13:24-27)
-(GHC.Types.Int, T7918B.hs:13:24-27)
-(GHC.Err.undefined, T7918B.hs:14:7-15)
-(GHC.Types.Int, T7918B.hs:14:24-27)
+(True, T7918B.hs:6:11-14)
+(id, T7918B.hs:7:11-14)
+(True, T7918B.hs:7:11-14)
+(True, T7918B.hs:8:11-14)
+(||, T7918B.hs:8:11-14)
+(False, T7918B.hs:8:11-14)
+(False, T7918B.hs:9:11-14)
+(undefined, T7918B.hs:11:7-15)
+(Bool, T7918B.hs:11:24-27)
+(undefined, T7918B.hs:12:7-15)
+(Maybe, T7918B.hs:12:24-27)
+(Bool, T7918B.hs:12:24-27)
+(undefined, T7918B.hs:13:7-15)
+(Either, T7918B.hs:13:24-27)
+(Bool, T7918B.hs:13:24-27)
+(Int, T7918B.hs:13:24-27)
+(undefined, T7918B.hs:14:7-15)
+(Int, T7918B.hs:14:24-27)
 (x, T7918B.hs:16:9-12)
-(GHC.Err.undefined, T7918B.hs:16:16-24)
+(undefined, T7918B.hs:16:16-24)
 (x, T7918B.hs:17:9-12)
-(GHC.Err.undefined, T7918B.hs:17:16-24)
+(undefined, T7918B.hs:17:16-24)
 (x, T7918B.hs:18:9-12)
 (y, T7918B.hs:18:9-12)
-(GHC.Err.undefined, T7918B.hs:18:16-24)
+(undefined, T7918B.hs:18:16-24)
 (y, T7918B.hs:19:9-12)
-(GHC.Err.undefined, T7918B.hs:19:16-24)
+(undefined, T7918B.hs:19:16-24)
diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr b/testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr
index 41fa100504..5aed2c55ef 100644
--- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr
+++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr
@@ -1,2 +1,2 @@
-SafeLang15: SafeLang15.hs:22:9-37: Irrefutable pattern failed for pattern Data.Maybe.Just p'
+SafeLang15: SafeLang15.hs:22:9-37: Irrefutable pattern failed for pattern Just p'
 
diff --git a/testsuite/tests/simplCore/should_compile/T5776.stdout b/testsuite/tests/simplCore/should_compile/T5776.stdout
index b8626c4cff..00750edc07 100644
--- a/testsuite/tests/simplCore/should_compile/T5776.stdout
+++ b/testsuite/tests/simplCore/should_compile/T5776.stdout
@@ -1 +1 @@
-4
+3
diff --git a/testsuite/tests/simplCore/should_compile/T7785.stderr b/testsuite/tests/simplCore/should_compile/T7785.stderr
index fbe217cd24..d32eacce48 100644
--- a/testsuite/tests/simplCore/should_compile/T7785.stderr
+++ b/testsuite/tests/simplCore/should_compile/T7785.stderr
@@ -1,9 +1,8 @@
 
 ==================== Tidy Core rules ====================
 "SPEC Foo.shared [[]]" [ALWAYS]
-    forall ($dMyFunctor :: Foo.MyFunctor [])
-           (irred :: Foo.Domain [] GHC.Types.Int).
-      Foo.shared @ [] $dMyFunctor irred
-      = Foo.bar_$sshared
+    forall ($dMyFunctor :: MyFunctor []) (irred :: Domain [] Int).
+      shared @ [] $dMyFunctor irred
+      = bar_$sshared
 
 
diff --git a/testsuite/tests/simplCore/should_compile/T8848.stderr b/testsuite/tests/simplCore/should_compile/T8848.stderr
index 1a6286882e..ed815141b5 100644
--- a/testsuite/tests/simplCore/should_compile/T8848.stderr
+++ b/testsuite/tests/simplCore/should_compile/T8848.stderr
@@ -3,7 +3,7 @@ Rule fired: Class op fmap
 Rule fired: Class op pure
 Rule fired: Class op <*>
 Rule fired: Class op <*>
-Rule fired: SPEC T8848.map2
+Rule fired: SPEC map2
 Rule fired: Class op $p1Applicative
 Rule fired: Class op <*>
 Rule fired: Class op $p1Applicative
diff --git a/testsuite/tests/simplCore/should_compile/T8848a.stderr b/testsuite/tests/simplCore/should_compile/T8848a.stderr
index 781d537e68..9d06c08461 100644
--- a/testsuite/tests/simplCore/should_compile/T8848a.stderr
+++ b/testsuite/tests/simplCore/should_compile/T8848a.stderr
@@ -1,8 +1,6 @@
 
 ==================== Tidy Core rules ====================
-"SPEC T8848a.f" [ALWAYS]
-    forall (@ b) ($dOrd :: GHC.Classes.Ord [GHC.Types.Int]).
-      T8848a.f @ b @ [GHC.Types.Int] $dOrd
-      = T8848a.f_$sf @ b
+"SPEC f" [ALWAYS]
+    forall (@ b) ($dOrd :: Ord [Int]). f @ b @ [Int] $dOrd = f_$sf @ b
 
 
diff --git a/testsuite/tests/simplCore/should_run/T2486.stderr b/testsuite/tests/simplCore/should_run/T2486.stderr
index 968e8dbdb4..c85297c5cb 100644
--- a/testsuite/tests/simplCore/should_run/T2486.stderr
+++ b/testsuite/tests/simplCore/should_run/T2486.stderr
@@ -1,24 +1,20 @@
 
 ==================== Tidy Core rules ====================
 "SPEC Main.fib [GHC.Types.Double]" [ALWAYS]
-    forall ($dNum :: GHC.Num.Num GHC.Types.Double)
-           ($dOrd :: GHC.Classes.Ord GHC.Types.Double).
-      Main.fib @ GHC.Types.Double $dNum $dOrd
-      = Main.fib_$sfib1
+    forall ($dNum :: Num Double) ($dOrd :: Ord Double).
+      fib @ Double $dNum $dOrd
+      = fib_$sfib1
 "SPEC Main.fib [GHC.Types.Int]" [ALWAYS]
-    forall ($dNum :: GHC.Num.Num GHC.Types.Int)
-           ($dOrd :: GHC.Classes.Ord GHC.Types.Int).
-      Main.fib @ GHC.Types.Int $dNum $dOrd
-      = Main.fib_$sfib
+    forall ($dNum :: Num Int) ($dOrd :: Ord Int).
+      fib @ Int $dNum $dOrd
+      = fib_$sfib
 "SPEC Main.tak [GHC.Types.Double]" [ALWAYS]
-    forall ($dNum :: GHC.Num.Num GHC.Types.Double)
-           ($dOrd :: GHC.Classes.Ord GHC.Types.Double).
-      Main.tak @ GHC.Types.Double $dNum $dOrd
-      = Main.tak_$stak1
+    forall ($dNum :: Num Double) ($dOrd :: Ord Double).
+      tak @ Double $dNum $dOrd
+      = tak_$stak1
 "SPEC Main.tak [GHC.Types.Int]" [ALWAYS]
-    forall ($dNum :: GHC.Num.Num GHC.Types.Int)
-           ($dOrd :: GHC.Classes.Ord GHC.Types.Int).
-      Main.tak @ GHC.Types.Int $dNum $dOrd
-      = Main.tak_$stak
+    forall ($dNum :: Num Int) ($dOrd :: Ord Int).
+      tak @ Int $dNum $dOrd
+      = tak_$stak