Print the Type kind qualified when ambiguous (#20627)

The Type kind is printed unqualified:
	ghci> :set -XNoStarIsType
	ghci> :k (->)
	(->) :: Type -> Type -> Type

This is the desired behavior unless the user has defined
their own Type:
	ghci> data Type

Then we want to resolve the ambiguity by qualification:
	ghci> :k (->)
	(->) :: GHC.Types.Type -> GHC.Types.Type -> GHC.Types.Type

6 files changed, 83 insertions, 18 deletions

diff --git a/compiler/GHC/Builtin/Types.hs-boot b/compiler/GHC/Builtin/Types.hs-boot
index e2b279d7ae..73b6fc16fe 100644
--- a/compiler/GHC/Builtin/Types.hs-boot
+++ b/compiler/GHC/Builtin/Types.hs-boot
@@ -16,6 +16,8 @@ coercibleTyCon, heqTyCon :: TyCon
 
 unitTy :: Type
 
+liftedTypeKindTyConName :: Name
+
 liftedTypeKind :: Kind
 unliftedTypeKind :: Kind
 
diff --git a/compiler/GHC/Iface/Type.hs b/compiler/GHC/Iface/Type.hs
index 6251798a0a..c3ef8b9b65 100644
--- a/compiler/GHC/Iface/Type.hs
+++ b/compiler/GHC/Iface/Type.hs
@@ -80,6 +80,7 @@ import GHC.Core.TyCon hiding ( pprPromotionQuote )
 import GHC.Core.Coercion.Axiom
 import GHC.Types.Var
 import GHC.Builtin.Names
+import {-# SOURCE #-} GHC.Builtin.Types ( liftedTypeKindTyConName )
 import GHC.Types.Name
 import GHC.Types.Basic
 import GHC.Utils.Binary
@@ -1503,7 +1504,7 @@ pprTyTcApp ctxt_prec tc tys =
 
 ppr_kind_type :: PprPrec -> SDoc
 ppr_kind_type ctxt_prec = sdocOption sdocStarIsType $ \case
-   False -> text "Type"
+   False -> pprPrefixOcc liftedTypeKindTyConName
    True  -> maybeParen ctxt_prec starPrec $
               unicodeSyntax (char '★') (char '*')
 
diff --git a/compiler/GHC/Types/Name/Ppr.hs b/compiler/GHC/Types/Name/Ppr.hs
index d357d9e5bf..96a60b61ae 100644
--- a/compiler/GHC/Types/Name/Ppr.hs
+++ b/compiler/GHC/Types/Name/Ppr.hs
@@ -13,8 +13,6 @@ import GHC.Prelude
 import GHC.Unit
 import GHC.Unit.Env
 
-import GHC.Core.TyCon
-
 import GHC.Types.Name
 import GHC.Types.Name.Reader
 
@@ -83,18 +81,9 @@ mkPrintUnqualified unit_env env
                        -- the right one, then we can use the unqualified name
 
         | [] <- unqual_gres
-        , any is_name forceUnqualNames
+        , pretendNameIsInScopeForPpr
         , not (isDerivedOccName occ)
-        = NameUnqual   -- Don't qualify names that come from modules
-                       -- that come with GHC, often appear in error messages,
-                       -- but aren't typically in scope. Doing this does not
-                       -- cause ambiguity, and it reduces the amount of
-                       -- qualification in error messages thus improving
-                       -- readability.
-                       --
-                       -- A motivating example is 'Constraint'. It's often not
-                       -- in scope, but printing GHC.Prim.Constraint seems
-                       -- overkill.
+        = NameUnqual   -- See Note [pretendNameIsInScopeForPpr]
 
         | [gre] <- qual_gres
         = NameQual (greQualModName gre)
@@ -112,10 +101,15 @@ mkPrintUnqualified unit_env env
         is_name name = assertPpr (isExternalName name) (ppr name) $
                        nameModule name == mod && nameOccName name == occ
 
-        forceUnqualNames :: [Name]
-        forceUnqualNames =
-          map tyConName [ constraintKindTyCon, heqTyCon, coercibleTyCon ]
-          ++ [ eqTyConName ]
+        -- See Note [pretendNameIsInScopeForPpr]
+        pretendNameIsInScopeForPpr :: Bool
+        pretendNameIsInScopeForPpr =
+          any is_name
+            [ liftedTypeKindTyConName
+            , constraintKindTyConName
+            , heqTyConName
+            , coercibleTyConName
+            , eqTyConName ]
 
         right_name gre = greDefinitionModule gre == Just mod
 
@@ -126,6 +120,43 @@ mkPrintUnqualified unit_env env
     -- "import M" would resolve unambiguously to P:M.  (if P is the
     -- current package we can just assume it is unqualified).
 
+{- Note [pretendNameIsInScopeForPpr]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Normally, a name is printed unqualified if it's in scope and unambiguous:
+  ghci> :t not
+  not :: Bool -> Bool
+
+Out of scope names are qualified:
+  ghci> import Prelude hiding (Bool)
+  ghci> :t not
+  not :: GHC.Types.Bool -> GHC.Types.Bool
+
+And so are ambiguous names:
+  ghci> data Bool
+  ghci> :t not
+  not :: Prelude.Bool -> Prelude.Bool
+
+However, these rules alone would lead to excessive qualification:
+  ghci> :k Functor
+  Functor :: (GHC.Types.Type -> GHC.Types.Type) -> GHC.Types.Constraint
+
+Even if the user has not imported Data.Kind, we would rather print:
+  Functor :: (Type -> Type) -> Constraint
+
+So we maintain a list of names for which we only require that they are
+unambiguous. It reduces the amount of qualification in GHCi output and error
+messages thus improving readability.
+
+One potential problem here is that external tooling that relies on parsing GHCi
+output (e.g. Emacs mode for Haskell) requires names to be properly qualified to
+make sense of the output (see #11208). So extend this list with care.
+
+Side note (int-index):
+  This function is distinct from GHC.Bulitin.Names.pretendNameIsInScope (used
+  when filtering out instances), and perhaps we could unify them by taking a
+  union, but I have not looked into what that would entail.
+-}
+
 -- | Creates a function for formatting modules based on two heuristics:
 -- (1) if the module is the current module, don't qualify, and (2) if there
 -- is only one exposed package which exports this module, don't qualify.
diff --git a/testsuite/tests/ghci/scripts/T20627.script b/testsuite/tests/ghci/scripts/T20627.script
new file mode 100644
index 0000000000..b9f7478767
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T20627.script
@@ -0,0 +1,17 @@
+:set -XNoStarIsType
+
+putStrLn "\nType and Constraint unqualified:"
+:k (->)
+:k Functor
+
+data Type
+
+putStrLn "\nType qualified, Constraint unqualified:"
+:k (->)
+:k Functor
+
+data Constraint
+
+putStrLn "\nType and Constraint qualified:"
+:k (->)
+:k Functor
diff --git a/testsuite/tests/ghci/scripts/T20627.stdout b/testsuite/tests/ghci/scripts/T20627.stdout
new file mode 100644
index 0000000000..e9cadc1a33
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T20627.stdout
@@ -0,0 +1,13 @@
+
+Type and Constraint unqualified:
+(->) :: Type -> Type -> Type
+Functor :: (Type -> Type) -> Constraint
+
+Type qualified, Constraint unqualified:
+(->) :: GHC.Types.Type -> GHC.Types.Type -> GHC.Types.Type
+Functor :: (GHC.Types.Type -> GHC.Types.Type) -> Constraint
+
+Type and Constraint qualified:
+(->) :: GHC.Types.Type -> GHC.Types.Type -> GHC.Types.Type
+Functor :: (GHC.Types.Type -> GHC.Types.Type)
+           -> GHC.Types.Constraint
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index 4db3ba2f7b..d67ff95308 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -347,3 +347,4 @@ test('T20101', normal, ghci_script, ['T20101.script'])
 test('T20206', normal, ghci_script, ['T20206.script'])
 test('T20217', normal, ghci_script, ['T20217.script'])
 test('T7388', normal, ghci_script, ['T7388.script'])
+test('T20627', normal, ghci_script, ['T20627.script'])