Add some TcRn diagnostic messages

This commit converts some TcRn diagnostic into proper structured
errors.

Ported by this commit:

* Add TcRnImplicitLift

    This commit adds the TcRnImplicitLift diagnostic message and a prototype
    API to be able to log messages which requires additional err info.

* Add TcRnUnusedPatternBinds
* Add TcRnDodgyExports
* Add TcRnDodgyImports message
* Add TcRnMissingImportList

2 files changed, 123 insertions, 7 deletions

diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index c6da9f1b9b..ffabf0f69c 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -1,10 +1,60 @@
+{-# LANGUAGE LambdaCase #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-} -- instance Diagnostic TcRnMessage
 
-module GHC.Tc.Errors.Ppr where
+module GHC.Tc.Errors.Ppr (
+  ) where
+
+import GHC.Prelude
 
 import GHC.Tc.Errors.Types
 import GHC.Types.Error
+import GHC.Driver.Flags
+import GHC.Hs
+import GHC.Utils.Outputable
 
 instance Diagnostic TcRnMessage where
-  diagnosticMessage (TcRnUnknownMessage m) = diagnosticMessage m
-  diagnosticReason  (TcRnUnknownMessage m) = diagnosticReason m
+  diagnosticMessage = \case
+    TcRnUnknownMessage m
+      -> diagnosticMessage m
+    TcRnImplicitLift id_or_name errInfo
+      -> mkDecorated [text "The variable" <+> quotes (ppr id_or_name) <+>
+                      text "is implicitly lifted in the TH quotation"
+                     , getErrInfo errInfo
+                     ]
+    TcRnUnusedPatternBinds bind
+      -> mkDecorated [hang (text "This pattern-binding binds no variables:") 2 (ppr bind)]
+    TcRnDodgyImports name
+      -> mkDecorated [dodgy_msg (text "import") name (dodgy_msg_insert name :: IE GhcPs)]
+    TcRnDodgyExports name
+      -> mkDecorated [dodgy_msg (text "export") name (dodgy_msg_insert name :: IE GhcRn)]
+    TcRnMissingImportList ie
+      -> mkDecorated [ text "The import item" <+> quotes (ppr ie) <+>
+                       text "does not have an explicit import list"
+                     ]
+  diagnosticReason = \case
+    TcRnUnknownMessage m
+      -> diagnosticReason m
+    TcRnImplicitLift{}
+      -> WarningWithFlag Opt_WarnImplicitLift
+    TcRnUnusedPatternBinds{}
+      -> WarningWithFlag Opt_WarnUnusedPatternBinds
+    TcRnDodgyImports{}
+      -> WarningWithFlag Opt_WarnDodgyImports
+    TcRnDodgyExports{}
+      -> WarningWithFlag Opt_WarnDodgyExports
+    TcRnMissingImportList{}
+      -> WarningWithFlag Opt_WarnMissingImportList
+
+dodgy_msg :: (Outputable a, Outputable b) => SDoc -> a -> b -> SDoc
+dodgy_msg kind tc ie
+  = sep [ text "The" <+> kind <+> text "item"
+                     <+> quotes (ppr ie)
+                <+> text "suggests that",
+          quotes (ppr tc) <+> text "has (in-scope) constructors or class methods,",
+          text "but it has none" ]
+
+dodgy_msg_insert :: forall p . IdP (GhcPass p) -> IE (GhcPass p)
+dodgy_msg_insert tc = IEThingAll noAnn ii
+  where
+    ii :: LIEWrappedName (IdP (GhcPass p))
+    ii = noLocA (IEName $ noLocA tc)
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index 1241735191..6da4cd6613 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -1,12 +1,78 @@
+{-# LANGUAGE GADTs #-}
 module GHC.Tc.Errors.Types (
   -- * Main types
     TcRnMessage(..)
+  , ErrInfo(..)
   ) where
 
+import GHC.Hs
 import GHC.Types.Error
+import GHC.Types.Name (Name)
+import GHC.Types.Name.Reader
+import GHC.Utils.Outputable
+import Data.Typeable
+
+-- The majority of TcRn messages come with extra context about the error,
+-- and this newtype captures it.
+newtype ErrInfo = ErrInfo { getErrInfo :: SDoc }
 
 -- | An error which might arise during typechecking/renaming.
-data TcRnMessage
-  = TcRnUnknownMessage !DiagnosticMessage
-  -- ^ Simply rewraps a generic 'DiagnosticMessage'. More
-  -- constructors will be added in the future (#18516).
+data TcRnMessage where
+  {-| Simply wraps a generic 'Diagnostic' message @a@. It can be used by plugins
+      to provide custom diagnostic messages originated during typechecking/renaming.
+  -}
+  TcRnUnknownMessage :: (Diagnostic a, Typeable a) => a -> TcRnMessage
+  {-| TcRnImplicitLift is a warning (controlled with -Wimplicit-lift) that occurs when
+      a Template Haskell quote implicitly uses 'lift'.
+
+     Example:
+       warning1 :: Lift t => t -> Q Exp
+       warning1 x = [| x |]
+
+     Test cases: th/T17804
+  -}
+  TcRnImplicitLift :: Outputable var => var -> !ErrInfo -> TcRnMessage
+  {-| TcRnUnusedPatternBinds is a warning (controlled with -Wunused-pattern-binds)
+      that occurs if a pattern binding binds no variables at all, unless it is a
+      lone wild-card pattern, or a banged pattern.
+
+     Example:
+        Just _ = rhs3    -- Warning: unused pattern binding
+        (_, _) = rhs4    -- Warning: unused pattern binding
+        _  = rhs3        -- No warning: lone wild-card pattern
+        !() = rhs4       -- No warning: banged pattern; behaves like seq
+
+     Test cases: rename/{T13646,T17c,T17e,T7085}
+  -}
+  TcRnUnusedPatternBinds :: HsBind GhcRn -> TcRnMessage
+  {-| TcRnDodgyImports is a warning (controlled with -Wdodgy-imports) that occurs when
+      a datatype 'T' is imported with all constructors, i.e. 'T(..)', but has been exported
+      abstractly, i.e. 'T'.
+
+     Test cases: rename/should_compile/T7167
+  -}
+  TcRnDodgyImports :: RdrName -> TcRnMessage
+  {-| TcRnDodgyExports is a warning (controlled by -Wdodgy-exports) that occurs when a datatype
+      'T' is exported with all constructors, i.e. 'T(..)', but is it just a type synonym or a
+      type/data family.
+
+     Example:
+       module Foo (
+           T(..)  -- Warning: T is a type synonym
+         , A(..)  -- Warning: A is a type family
+         , C(..)  -- Warning: C is a data family
+         ) where
+
+       type T = Int
+       type family A :: * -> *
+       data family C :: * -> *
+
+     Test cases: warnings/should_compile/DodgyExports01
+  -}
+  TcRnDodgyExports :: Name -> TcRnMessage
+  {-| TcRnMissingImportList is a warning (controlled by -Wmissing-import-lists) that occurs when
+      an import declaration does not explicitly list all the names brought into scope.
+
+     Test cases: rename/should_compile/T4489
+  -}
+  TcRnMissingImportList :: IE GhcPs -> TcRnMessage