From 52bd5aa9e019395ee8a0be3cb92e95e80896a51b Mon Sep 17 00:00:00 2001
From: Oleg Grenrus <oleg.grenrus@iki.fi>
Date: Sun, 21 Mar 2021 01:52:07 +0200
Subject: Implement -Wmissing-kind-signatures

Fixes #19564

(cherry picked from commit 0d5d344d45c200a5e731e7d067598acd2a4f7050)
---
 compiler/GHC/Rename/Names.hs | 28 +++++++++++++++++++++++++++-
 1 file changed, 27 insertions(+), 1 deletion(-)

(limited to 'compiler/GHC/Rename')

diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index 6c99bf7b5b..835e39a246 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -52,6 +52,7 @@ import GHC.Parser.PostProcess ( setRdrNameSpace )
 import GHC.Core.Type
 import GHC.Core.PatSyn
 import GHC.Core.TyCo.Ppr
+import GHC.Core.TyCon ( TyCon, tyConName, tyConKind )
 import qualified GHC.LanguageExtensions as LangExt
 
 import GHC.Utils.Outputable as Outputable
@@ -1417,7 +1418,8 @@ reportUnusedNames gbl_env hsc_src
         ; traceRn "RUN" (ppr (tcg_dus gbl_env))
         ; warnUnusedImportDecls gbl_env hsc_src
         ; warnUnusedTopBinds $ unused_locals keep
-        ; warnMissingSignatures gbl_env }
+        ; warnMissingSignatures gbl_env
+        ; warnMissingKindSignatures gbl_env }
   where
     used_names :: NameSet -> NameSet
     used_names keep = findUses (tcg_dus gbl_env) emptyNameSet `unionNameSet` keep
@@ -1519,6 +1521,30 @@ warnMissingSignatures gbl_env
 
        ; add_sig_warns }
 
+-- | Warn the user about tycons that lack kind signatures.
+-- Called /after/ type (and kind) inference, so that we can report the
+-- inferred kinds.
+warnMissingKindSignatures :: TcGblEnv -> RnM ()
+warnMissingKindSignatures gbl_env
+  = do { warn_missing_kind_sigs  <- woptM Opt_WarnMissingKindSignatures
+       ; cusks_enabled <- xoptM LangExt.CUSKs
+       ; when (warn_missing_kind_sigs) (mapM_ (add_ty_warn cusks_enabled) tcs)
+       }
+  where
+    tcs = tcg_tcs gbl_env
+    ksig_ns = tcg_ksigs gbl_env
+
+    add_ty_warn :: Bool -> TyCon -> IOEnv (Env TcGblEnv TcLclEnv) ()
+    add_ty_warn cusks_enabled tyCon = when (name `elemNameSet` ksig_ns) $
+        addWarnAt (Reason Opt_WarnMissingKindSignatures) (getSrcSpan name) $
+            hang msg 2 (text "type" <+> pprPrefixName name <+> dcolon <+> ki_msg)
+      where
+        msg | cusks_enabled = text "Top-level type constructor with no standalone kind signature or CUSK:"
+            | otherwise     = text "Top-level type constructor with no standalone kind signature:"
+        name = tyConName tyCon
+        ki = tyConKind tyCon
+        ki_msg :: SDoc
+        ki_msg = pprKind ki
 
 {-
 *********************************************************
-- 
cgit v1.2.1