Add and use new constructors to TcRnMessagewip/adinapoli-issue-20119-part-1

This commit adds the following constructors to the TcRnMessage type and
uses them to replace sdoc-based diagnostics in some parts of GHC (e.g.
TcRnUnknownMessage). It includes:

* Add TcRnMonomorphicBindings diagnostic
* Convert TcRnUnknownMessage in Tc.Solver.Interact
* Add and use the TcRnOrphanInstance constructor to TcRnMessage
* Add TcRnFunDepConflict and TcRnDupInstanceDecls constructors to TcRnMessage
* Add and use TcRnConflictingFamInstDecls constructor to TcRnMessage
* Get rid of TcRnUnknownMessage from GHC.Tc.Instance.Family

15 files changed, 338 insertions, 130 deletions

diff --git a/compiler/GHC/HsToCore/Errors/Ppr.hs b/compiler/GHC/HsToCore/Errors/Ppr.hs
index eba5c12e74..3109370543 100644
--- a/compiler/GHC/HsToCore/Errors/Ppr.hs
+++ b/compiler/GHC/HsToCore/Errors/Ppr.hs
@@ -304,7 +304,7 @@ instance Diagnostic DsMessage where
     DsNotYetHandledByTH{}                       -> noHints
     DsAggregatedViewExpressions{}               -> noHints
     DsUnbangedStrictPatterns{}                  -> noHints
-    DsCannotMixPolyAndUnliftedBindings{}        -> [SuggestAddTypeSignature]
+    DsCannotMixPolyAndUnliftedBindings{}        -> [SuggestAddTypeSignatures UnnamedBinding]
     DsWrongDoBind rhs _                         -> [SuggestBindToWildcard rhs]
     DsUnusedDoBind rhs _                        -> [SuggestBindToWildcard rhs]
     DsRecBindsNotAllowedForUnliftedTys{}        -> noHints
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index c07a3a7057..ef140f7e70 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -10,18 +10,22 @@ module GHC.Tc.Errors.Ppr (
 import GHC.Prelude
 
 import GHC.Core.Class (Class(..))
-import GHC.Core.TyCo.Ppr (pprKind, pprParendType, pprType, pprWithTYPE)
+import GHC.Core.Coercion (pprCoAxBranchUser)
+import GHC.Core.Coercion.Axiom (coAxiomTyCon, coAxiomSingleBranch)
+import GHC.Core.FamInstEnv (famInstAxiom)
+import GHC.Core.InstEnv
+import GHC.Core.TyCo.Ppr (pprKind, pprParendType, pprType, pprWithTYPE, pprWithExplicitKindsWhen)
 import GHC.Core.Type
 import GHC.Data.Bag
 import GHC.Tc.Errors.Types
 import GHC.Tc.Types.Rank (Rank(..))
 import GHC.Tc.Utils.TcType (tcSplitForAllTyVars)
 import GHC.Types.Error
-import GHC.Types.Name (pprPrefixName)
+import GHC.Types.Name
 import GHC.Types.Name.Reader (pprNameProvenance)
 import GHC.Types.SrcLoc (GenLocated(..))
-import GHC.Types.Name.Occurrence (occName)
 import GHC.Types.Var.Env (emptyTidyEnv)
+import GHC.Types.Var.Set (pprVarSet, pluralVarSet)
 import GHC.Driver.Flags
 import GHC.Hs
 import GHC.Utils.Outputable
@@ -79,11 +83,13 @@ instance Diagnostic TcRnMessage where
       -> mkSimpleDecorated $
            vcat [text "Multiple warning declarations for" <+> quotes (ppr rdr_name),
                  text "also at " <+> ppr (getLocA d)]
-    TcRnSimplifierTooManyIterations limit wc
+    TcRnSimplifierTooManyIterations simples limit wc
       -> mkSimpleDecorated $
            hang (text "solveWanteds: too many iterations"
                    <+> parens (text "limit =" <+> ppr limit))
-                2 (text "Unsolved:" <+> ppr wc)
+                2 (vcat [ text "Unsolved:" <+> ppr wc
+                        , text "Simples:"  <+> ppr simples
+                        ])
     TcRnIllegalPatSynDecl rdrname
       -> mkSimpleDecorated $
            hang (text "Illegal pattern synonym declaration for" <+> quotes (ppr rdrname))
@@ -245,6 +251,58 @@ instance Diagnostic TcRnMessage where
                MonoTypeConstraint -> text "A constraint must be a monotype"
                _                  -> empty
          in mkSimpleDecorated $ vcat [hang herald 2 (pprType ty), extra]
+    TcRnMonomorphicBindings bindings
+      -> let pp_bndrs = pprBindings bindings
+         in mkSimpleDecorated $
+              sep [ text "The Monomorphism Restriction applies to the binding"
+                  <> plural bindings
+                  , text "for" <+> pp_bndrs ]
+    TcRnOrphanInstance inst
+      -> mkSimpleDecorated $
+           hsep [ text "Orphan instance:"
+                , pprInstanceHdr inst
+                ]
+    TcRnFunDepConflict unit_state sorted
+      -> let herald = text "Functional dependencies conflict between instance declarations:"
+         in mkSimpleDecorated $
+              pprWithUnitState unit_state $ (hang herald 2 (pprInstances $ NE.toList sorted))
+    TcRnDupInstanceDecls unit_state sorted
+      -> let herald = text "Duplicate instance declarations:"
+         in mkSimpleDecorated $
+              pprWithUnitState unit_state $ (hang herald 2 (pprInstances $ NE.toList sorted))
+    TcRnConflictingFamInstDecls sortedNE
+      -> let sorted = NE.toList sortedNE
+         in mkSimpleDecorated $
+              hang (text "Conflicting family instance declarations:")
+                 2 (vcat [ pprCoAxBranchUser (coAxiomTyCon ax) (coAxiomSingleBranch ax)
+                         | fi <- sorted
+                         , let ax = famInstAxiom fi ])
+    TcRnFamInstNotInjective rea fam_tc (eqn1 NE.:| rest_eqns)
+      -> let (herald, show_kinds) = case rea of
+               InjErrRhsBareTyVar tys ->
+                 (injectivityErrorHerald $$
+                  text "RHS of injective type family equation is a bare" <+>
+                  text "type variable" $$
+                  text "but these LHS type and kind patterns are not bare" <+>
+                  text "variables:" <+> pprQuotedList tys, False)
+               InjErrRhsCannotBeATypeFam ->
+                 (injectivityErrorHerald $$
+                   text "RHS of injective type family equation cannot" <+>
+                   text "be a type family:", False)
+               InjErrRhsOverlap ->
+                  (text "Type family equation right-hand sides overlap; this violates" $$
+                   text "the family's injectivity annotation:", False)
+               InjErrCannotInferFromRhs tvs has_kinds _ ->
+                 let show_kinds = has_kinds == YesHasKinds
+                     what = if show_kinds then text "Type/kind" else text "Type"
+                     body = sep [ what <+> text "variable" <>
+                                  pluralVarSet tvs <+> pprVarSet tvs (pprQuotedList . scopedSort)
+                                , text "cannot be inferred from the right-hand side." ]
+                     in (injectivityErrorHerald $$ body $$ text "In the type family equation:", show_kinds)
+
+         in mkSimpleDecorated $ pprWithExplicitKindsWhen show_kinds $
+              hang herald
+                2 (vcat (map (pprCoAxBranchUser fam_tc) (eqn1 : rest_eqns)))
 
   diagnosticReason = \case
     TcRnUnknownMessage m
@@ -362,6 +420,18 @@ instance Diagnostic TcRnMessage where
       -> ErrorWithoutFlag
     TcRnForAllRankErr{}
       -> ErrorWithoutFlag
+    TcRnMonomorphicBindings{}
+      -> WarningWithFlag Opt_WarnMonomorphism
+    TcRnOrphanInstance{}
+      -> WarningWithFlag Opt_WarnOrphans
+    TcRnFunDepConflict{}
+      -> ErrorWithoutFlag
+    TcRnDupInstanceDecls{}
+      -> ErrorWithoutFlag
+    TcRnConflictingFamInstDecls{}
+      -> ErrorWithoutFlag
+    TcRnFamInstNotInjective{}
+      -> ErrorWithoutFlag
 
   diagnosticHints = \case
     TcRnUnknownMessage m
@@ -485,6 +555,28 @@ instance Diagnostic TcRnMessage where
            MonoTypeSynArg     -> [suggestExtension LangExt.LiberalTypeSynonyms]
            MonoTypeConstraint -> [suggestExtension LangExt.QuantifiedConstraints]
            _                  -> noHints
+    TcRnMonomorphicBindings bindings
+      -> case bindings of
+          []     -> noHints
+          (x:xs) -> [SuggestAddTypeSignatures $ NamedBindings (x NE.:| xs)]
+    TcRnOrphanInstance{}
+      -> [SuggestFixOrphanInstance]
+    TcRnFunDepConflict{}
+      -> noHints
+    TcRnDupInstanceDecls{}
+      -> noHints
+    TcRnConflictingFamInstDecls{}
+      -> noHints
+    TcRnFamInstNotInjective rea _ _
+      -> case rea of
+           InjErrRhsBareTyVar{}      -> noHints
+           InjErrRhsCannotBeATypeFam -> noHints
+           InjErrRhsOverlap          -> noHints
+           InjErrCannotInferFromRhs _ _ suggestUndInst
+             | YesSuggestUndecidableInstaces <- suggestUndInst
+             -> [suggestExtension LangExt.UndecidableInstances]
+             | otherwise
+             -> noHints
 
 messageWithInfoDiagnosticMessage :: UnitState
                                  -> ErrInfo
@@ -556,3 +648,10 @@ pprRecordFieldPart = \case
   RecordFieldConstructor{} -> text "construction"
   RecordFieldPattern{}     -> text "pattern"
   RecordFieldUpdate        -> text "update"
+
+pprBindings :: [Name] -> SDoc
+pprBindings = pprWithCommas (quotes . ppr)
+
+injectivityErrorHerald :: SDoc
+injectivityErrorHerald =
+  text "Type family equation violates the family's injectivity annotation."
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index 827dc4a4da..d1b2ee694f 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -7,6 +7,11 @@ module GHC.Tc.Errors.Types (
   , LevityCheckProvenance(..)
   , ShadowedNameProvenance(..)
   , RecordFieldPart(..)
+  , InjectivityErrReason(..)
+  , HasKinds(..)
+  , hasKinds
+  , SuggestUndecidableInstances(..)
+  , suggestUndecidableInstances
   ) where
 
 import GHC.Prelude
@@ -22,13 +27,17 @@ import GHC.Types.SrcLoc
 import GHC.Unit.Types (Module)
 import GHC.Utils.Outputable
 import GHC.Core.Class (Class)
+import GHC.Core.Coercion.Axiom (CoAxBranch)
+import GHC.Core.FamInstEnv (FamInst)
+import GHC.Core.InstEnv (ClsInst)
+import GHC.Core.TyCon (TyCon, TyConFlavour)
 import GHC.Core.Type (Kind, Type, Var)
-import GHC.Core.TyCon (TyConFlavour)
 import GHC.Unit.State (UnitState)
 import GHC.Types.Basic
+import GHC.Types.Var.Set (TyVarSet)
 
 import qualified Data.List.NonEmpty as NE
-import           Data.Typeable
+import           Data.Typeable hiding (TyCon)
 
 {-
 Note [Migrating TcM Messages]
@@ -237,7 +246,8 @@ data TcRnMessage where
      Test cases:
         None.
   -}
-  TcRnSimplifierTooManyIterations :: !IntWithInf
+  TcRnSimplifierTooManyIterations :: Cts
+                                  -> !IntWithInf
                                   -- ^ The limit.
                                   -> WantedConstraints
                                   -> TcRnMessage
@@ -802,6 +812,110 @@ data TcRnMessage where
   -}
   TcRnForAllRankErr :: !Rank -> !Type -> TcRnMessage
 
+  {-| TcRnMonomorphicBindings is a warning (controlled by -Wmonomorphism-restriction)
+      that arise when the monomorphism restriction applies to the given bindings.
+
+      Examples(s):
+        {-# OPTIONS_GHC -Wmonomorphism-restriction #-}
+
+        bar = 10
+
+        foo :: Int
+        foo = bar
+
+        main :: IO ()
+        main = print foo
+
+      The example above emits the warning (for 'bar'), because without monomorphism
+      restriction the inferred type for 'bar' is 'bar :: Num p => p'. This warning tells us
+      that /if/ we were to enable '-XMonomorphismRestriction' we would make 'bar'
+      less polymorphic, as its type would become 'bar :: Int', so GHC warns us about that.
+
+      Test cases: typecheck/should_compile/T13785
+  -}
+  TcRnMonomorphicBindings :: [Name] -> TcRnMessage
+
+  {-| TcRnOrphanInstance is a warning (controlled by -Wwarn-orphans)
+      that arises when a typeclass instance is an \"orphan\", i.e. if it appears
+      in a module in which neither the class nor the type being instanced are
+      declared in the same module.
+
+      Examples(s): None
+
+      Test cases: warnings/should_compile/T9178
+                  typecheck/should_compile/T4912
+  -}
+  TcRnOrphanInstance :: ClsInst -> TcRnMessage
+
+  {-| TcRnFunDepConflict is an error that occurs when there are functional dependencies
+      conflicts between instance declarations.
+
+      Examples(s): None
+
+      Test cases: typecheck/should_fail/T2307
+                  typecheck/should_fail/tcfail096
+                  typecheck/should_fail/tcfail202
+  -}
+  TcRnFunDepConflict :: !UnitState -> NE.NonEmpty ClsInst -> TcRnMessage
+
+  {-| TcRnDupInstanceDecls is an error that occurs when there are duplicate instance
+      declarations.
+
+      Examples(s):
+        class Foo a where
+          foo :: a -> Int
+
+        instance Foo Int where
+          foo = id
+
+        instance Foo Int where
+          foo = const 42
+
+      Test cases: cabal/T12733/T12733
+                  typecheck/should_fail/tcfail035
+                  typecheck/should_fail/tcfail023
+                  backpack/should_fail/bkpfail18
+                  typecheck/should_fail/TcNullaryTCFail
+                  typecheck/should_fail/tcfail036
+                  typecheck/should_fail/tcfail073
+                  module/mod51
+                  module/mod52
+                  module/mod44
+  -}
+  TcRnDupInstanceDecls :: !UnitState -> NE.NonEmpty ClsInst -> TcRnMessage
+
+  {-| TcRnConflictingFamInstDecls is an error that occurs when there are conflicting
+      family instance declarations.
+
+      Examples(s): None.
+
+      Test cases: indexed-types/should_fail/ExplicitForAllFams4b
+                  indexed-types/should_fail/NoGood
+                  indexed-types/should_fail/Over
+                  indexed-types/should_fail/OverDirectThisMod
+                  indexed-types/should_fail/OverIndirectThisMod
+                  indexed-types/should_fail/SimpleFail11a
+                  indexed-types/should_fail/SimpleFail11b
+                  indexed-types/should_fail/SimpleFail11c
+                  indexed-types/should_fail/SimpleFail11d
+                  indexed-types/should_fail/SimpleFail2a
+                  indexed-types/should_fail/SimpleFail2b
+                  indexed-types/should_fail/T13092/T13092
+                  indexed-types/should_fail/T13092c/T13092c
+                  indexed-types/should_fail/T14179
+                  indexed-types/should_fail/T2334A
+                  indexed-types/should_fail/T2677
+                  indexed-types/should_fail/T3330b
+                  indexed-types/should_fail/T4246
+                  indexed-types/should_fail/T7102a
+                  indexed-types/should_fail/T9371
+                  polykinds/T7524
+                  typecheck/should_fail/UnliftedNewtypesOverlap
+  -}
+  TcRnConflictingFamInstDecls :: NE.NonEmpty FamInst -> TcRnMessage
+
+  TcRnFamInstNotInjective :: InjectivityErrReason -> TyCon -> NE.NonEmpty CoAxBranch -> TcRnMessage
+
 -- | Which parts of a record field are affected by a particular error or warning.
 data RecordFieldPart
   = RecordFieldConstructor !Name
@@ -830,3 +944,29 @@ data LevityCheckProvenance
   | LevityCheckInFunUse !(LHsExpr GhcTc)
   | LevityCheckInValidDataCon
   | LevityCheckInValidClass
+
+-- | Why the particular injectivity error arose together with more information,
+-- if any.
+data InjectivityErrReason
+  = InjErrRhsBareTyVar [Type]
+  | InjErrRhsCannotBeATypeFam
+  | InjErrRhsOverlap
+  | InjErrCannotInferFromRhs !TyVarSet !HasKinds !SuggestUndecidableInstances
+
+data HasKinds
+  = YesHasKinds
+  | NoHasKinds
+  deriving (Show, Eq)
+
+hasKinds :: Bool -> HasKinds
+hasKinds True  = YesHasKinds
+hasKinds False = NoHasKinds
+
+data SuggestUndecidableInstances
+  = YesSuggestUndecidableInstaces
+  | NoSuggestUndecidableInstaces
+  deriving (Show, Eq)
+
+suggestUndecidableInstances :: Bool -> SuggestUndecidableInstances
+suggestUndecidableInstances True  = YesSuggestUndecidableInstaces
+suggestUndecidableInstances False = NoSuggestUndecidableInstaces
diff --git a/compiler/GHC/Tc/Instance/Family.hs b/compiler/GHC/Tc/Instance/Family.hs
index a7cdb3d507..01b5433cdc 100644
--- a/compiler/GHC/Tc/Instance/Family.hs
+++ b/compiler/GHC/Tc/Instance/Family.hs
@@ -25,7 +25,6 @@ import GHC.Core.Coercion.Axiom
 import GHC.Core.DataCon ( dataConName )
 import GHC.Core.TyCo.Rep
 import GHC.Core.TyCo.FVs
-import GHC.Core.TyCo.Ppr ( pprWithExplicitKindsWhen )
 
 import GHC.Iface.Load
 
@@ -42,7 +41,6 @@ import GHC.Unit.Module.ModDetails
 import GHC.Unit.Module.Deps
 import GHC.Unit.Home.ModInfo
 
-import GHC.Types.Error
 import GHC.Types.SrcLoc as SrcLoc
 import GHC.Types.Name.Reader
 import GHC.Types.Name
@@ -58,9 +56,8 @@ import GHC.Data.Bag( Bag, unionBags, unitBag )
 import GHC.Data.Maybe
 
 import Control.Monad
-import Data.Bifunctor ( second )
-import Data.List ( sortBy )
 import Data.List.NonEmpty ( NonEmpty(..) )
+import qualified Data.List.NonEmpty as NE
 import Data.Function ( on )
 
 import qualified GHC.LanguageExtensions  as LangExt
@@ -908,8 +905,8 @@ unusedInjTvsInRHS :: DynFlags
                   -> [Type] -- LHS arguments
                   -> Type   -- the RHS
                   -> ( TyVarSet
-                     , Bool   -- True <=> one or more variable is used invisibly
-                     , Bool ) -- True <=> suggest -XUndecidableInstances
+                     , HasKinds                     -- YesHasKinds <=> one or more variable is used invisibly
+                     , SuggestUndecidableInstances) -- YesSuggestUndecidableInstaces <=> suggest -XUndecidableInstances
 -- See Note [Verifying injectivity annotation] in GHC.Core.FamInstEnv.
 -- This function implements check (4) described there, further
 -- described in Note [Coverage condition for injective type families].
@@ -920,7 +917,7 @@ unusedInjTvsInRHS :: DynFlags
 -- precise names of variables that are not mentioned in the RHS.
 unusedInjTvsInRHS dflags tycon@(tyConInjectivityInfo -> Injective inj_list) lhs rhs =
   -- Note [Coverage condition for injective type families], step 5
-  (bad_vars, any_invisible, suggest_undec)
+  (bad_vars, hasKinds any_invisible, suggestUndecidableInstances suggest_undec)
     where
       undec_inst = xopt LangExt.UndecidableInstances dflags
 
@@ -941,7 +938,7 @@ unusedInjTvsInRHS dflags tycon@(tyConInjectivityInfo -> Injective inj_list) lhs
                       (lhs_vars `subVarSet` fvVarSet (injectiveVarsOfType True rhs))
 
 -- When the type family is not injective in any arguments
-unusedInjTvsInRHS _ _ _ _ = (emptyVarSet, False, False)
+unusedInjTvsInRHS _ _ _ _ = (emptyVarSet, NoHasKinds, NoSuggestUndecidableInstaces)
 
 ---------------------------------------
 -- Producing injectivity error messages
@@ -952,88 +949,55 @@ unusedInjTvsInRHS _ _ _ _ = (emptyVarSet, False, False)
 reportConflictingInjectivityErrs :: TyCon -> [CoAxBranch] -> CoAxBranch -> TcM ()
 reportConflictingInjectivityErrs _ [] _ = return ()
 reportConflictingInjectivityErrs fam_tc (confEqn1:_) tyfamEqn
-  = addErrs [second mk_err $ buildInjectivityError fam_tc herald (confEqn1 :| [tyfamEqn])]
-  where
-    herald = text "Type family equation right-hand sides overlap; this violates" $$
-             text "the family's injectivity annotation:"
-
--- | Injectivity error herald common to all injectivity errors.
-injectivityErrorHerald :: SDoc
-injectivityErrorHerald =
-  text "Type family equation violates the family's injectivity annotation."
-
+  = addErrs [buildInjectivityError (TcRnFamInstNotInjective InjErrRhsOverlap)
+                                   fam_tc
+                                   (confEqn1 :| [tyfamEqn])]
 
 -- | Report error message for equation with injective type variables unused in
 -- the RHS. Note [Coverage condition for injective type families], step 6
 reportUnusedInjectiveVarsErr :: TyCon
                              -> TyVarSet
-                             -> Bool   -- True <=> print invisible arguments
-                             -> Bool   -- True <=> suggest -XUndecidableInstances
+                             -> HasKinds                    -- YesHasKinds <=> print invisible arguments
+                             -> SuggestUndecidableInstances -- YesSuggestUndecidableInstaces <=> suggest -XUndecidableInstances
                              -> CoAxBranch
                              -> TcM ()
 reportUnusedInjectiveVarsErr fam_tc tvs has_kinds undec_inst tyfamEqn
-  = let (loc, doc) = buildInjectivityError fam_tc
-                                  (injectivityErrorHerald $$
-                                   herald $$
-                                   text "In the type family equation:")
-                                  (tyfamEqn :| [])
-    in addErrAt loc (mk_err $ pprWithExplicitKindsWhen has_kinds doc)
-    where
-      herald = sep [ what <+> text "variable" <>
-                  pluralVarSet tvs <+> pprVarSet tvs (pprQuotedList . scopedSort)
-                , text "cannot be inferred from the right-hand side." ]
-               $$ extra
-
-      what | has_kinds = text "Type/kind"
-           | otherwise = text "Type"
-
-      extra | undec_inst = text "Using UndecidableInstances might help"
-            | otherwise  = empty
+  = let reason     = InjErrCannotInferFromRhs tvs has_kinds undec_inst
+        (loc, dia) = buildInjectivityError (TcRnFamInstNotInjective reason) fam_tc (tyfamEqn :| [])
+    in addErrAt loc dia
 
 -- | Report error message for equation that has a type family call at the top
 -- level of RHS
 reportTfHeadedErr :: TyCon -> CoAxBranch -> TcM ()
 reportTfHeadedErr fam_tc branch
-  = addErrs [second mk_err $ buildInjectivityError fam_tc
-               (injectivityErrorHerald $$
-                 text "RHS of injective type family equation cannot" <+>
-                 text "be a type family:")
-               (branch :| [])]
+  = addErrs [buildInjectivityError (TcRnFamInstNotInjective InjErrRhsCannotBeATypeFam)
+                                   fam_tc
+                                   (branch :| [])]
 
 -- | Report error message for equation that has a bare type variable in the RHS
 -- but LHS pattern is not a bare type variable.
 reportBareVariableInRHSErr :: TyCon -> [Type] -> CoAxBranch -> TcM ()
 reportBareVariableInRHSErr fam_tc tys branch
-  = addErrs [second mk_err $ buildInjectivityError fam_tc
-                 (injectivityErrorHerald $$
-                  text "RHS of injective type family equation is a bare" <+>
-                  text "type variable" $$
-                  text "but these LHS type and kind patterns are not bare" <+>
-                  text "variables:" <+> pprQuotedList tys)
-                 (branch :| [])]
-
-mk_err :: SDoc -> TcRnMessage
-mk_err = TcRnUnknownMessage . mkPlainError noHints
-
-buildInjectivityError :: TyCon -> SDoc -> NonEmpty CoAxBranch -> (SrcSpan, SDoc)
-buildInjectivityError fam_tc herald (eqn1 :| rest_eqns)
-  = ( coAxBranchSpan eqn1
-    , hang herald
-         2 (vcat (map (pprCoAxBranchUser fam_tc) (eqn1 : rest_eqns))) )
+  = addErrs [buildInjectivityError (TcRnFamInstNotInjective (InjErrRhsBareTyVar tys))
+                                   fam_tc
+                                   (branch :| [])]
+
+buildInjectivityError :: (TyCon -> NonEmpty CoAxBranch -> TcRnMessage)
+                      -> TyCon
+                      -> NonEmpty CoAxBranch
+                      -> (SrcSpan, TcRnMessage)
+buildInjectivityError mkErr fam_tc branches
+  = ( coAxBranchSpan (NE.head branches), mkErr fam_tc branches )
 
 reportConflictInstErr :: FamInst -> [FamInstMatch] -> TcRn ()
 reportConflictInstErr _ []
   = return ()  -- No conflicts
 reportConflictInstErr fam_inst (match1 : _)
   | FamInstMatch { fim_instance = conf_inst } <- match1
-  , let sorted  = sortBy (SrcLoc.leftmost_smallest `on` getSpan) [fam_inst, conf_inst]
-        fi1     = head sorted
+  , let sorted  = NE.sortBy (SrcLoc.leftmost_smallest `on` getSpan) (fam_inst NE.:| [conf_inst])
+        fi1     = NE.head sorted
         span    = coAxBranchSpan (coAxiomSingleBranch (famInstAxiom fi1))
-  = setSrcSpan span $ addErr $ TcRnUnknownMessage $ mkPlainError noHints $
-    hang (text "Conflicting family instance declarations:")
-       2 (vcat [ pprCoAxBranchUser (coAxiomTyCon ax) (coAxiomSingleBranch ax)
-               | fi <- sorted
-               , let ax = famInstAxiom fi ])
+  = setSrcSpan span $ addErr $ TcRnConflictingFamInstDecls sorted
  where
    getSpan = getSrcSpan . famInstAxiom
    -- The sortBy just arranges that instances are displayed in order
diff --git a/compiler/GHC/Tc/Solver.hs b/compiler/GHC/Tc/Solver.hs
index e2ea2f59de..7836c4a1b4 100644
--- a/compiler/GHC/Tc/Solver.hs
+++ b/compiler/GHC/Tc/Solver.hs
@@ -1410,8 +1410,7 @@ decideMonoTyVars infer_mode name_taus psigs candidates
 
            -- Warn about the monomorphism restriction
        ; when (case infer_mode of { ApplyMR -> True; _ -> False}) $ do
-           let dia = TcRnUnknownMessage $
-                 mkPlainDiagnostic (WarningWithFlag Opt_WarnMonomorphism) noHints mr_msg
+           let dia = TcRnMonomorphicBindings (map fst name_taus)
            diagnosticTc (constrained_tvs `intersectsVarSet` tyCoVarsOfTypes taus) dia
 
        ; traceTc "decideMonoTyVars" $ vcat
@@ -1441,15 +1440,6 @@ decideMonoTyVars infer_mode name_taus psigs candidates
       | otherwise
       = False
 
-    pp_bndrs = pprWithCommas (quotes . ppr . fst) name_taus
-    mr_msg =
-         hang (sep [ text "The Monomorphism Restriction applies to the binding"
-                     <> plural name_taus
-                   , text "for" <+> pp_bndrs ])
-            2 (hsep [ text "Consider giving"
-                    , text (if isSingleton name_taus then "it" else "them")
-                    , text "a type signature"])
-
 -------------------
 defaultTyVarsAndSimplify :: TcLevel
                          -> TyCoVarSet
@@ -1860,7 +1850,7 @@ maybe_simplify_again n limit unif_happened wc@(WC { wc_simple = simples })
          -- Typically if we blow the limit we are going to report some other error
          -- (an unsolved constraint), and we don't want that error to suppress
          -- the iteration limit warning!
-         addErrTcS $ TcRnSimplifierTooManyIterations limit wc
+         addErrTcS $ TcRnSimplifierTooManyIterations simples limit wc
        ; return wc }
 
   | unif_happened
diff --git a/compiler/GHC/Tc/Solver/Interact.hs b/compiler/GHC/Tc/Solver/Interact.hs
index 72f4a509c4..e49ead9824 100644
--- a/compiler/GHC/Tc/Solver/Interact.hs
+++ b/compiler/GHC/Tc/Solver/Interact.hs
@@ -11,7 +11,6 @@ module GHC.Tc.Solver.Interact (
 import GHC.Prelude
 import GHC.Types.Basic ( SwapFlag(..),
                          infinity, IntWithInf, intGtLimit )
-import GHC.Types.Error
 import GHC.Tc.Solver.Canonical
 import GHC.Types.Var.Set
 import GHC.Core.Type as Type
@@ -122,13 +121,7 @@ solveSimpleWanteds simples
     go :: Int -> IntWithInf -> WantedConstraints -> TcS (Int, WantedConstraints)
     go n limit wc
       | n `intGtLimit` limit
-      = failTcS $ TcRnUnknownMessage $ mkPlainError noHints $
-          (hang (text "solveSimpleWanteds: too many iterations"
-                       <+> parens (text "limit =" <+> ppr limit))
-                    2 (vcat [ text "Set limit with -fconstraint-solver-iterations=n; n=0 for no limit"
-                            , text "Simples =" <+> ppr simples
-                            , text "WC ="      <+> ppr wc ]))
-
+      = failTcS $ TcRnSimplifierTooManyIterations simples limit wc
      | isEmptyBag (wc_simple wc)
      = return (n,wc)
 
diff --git a/compiler/GHC/Tc/Utils/Instantiate.hs b/compiler/GHC/Tc/Utils/Instantiate.hs
index 73c62839e3..6977dcf105 100644
--- a/compiler/GHC/Tc/Utils/Instantiate.hs
+++ b/compiler/GHC/Tc/Utils/Instantiate.hs
@@ -93,7 +93,8 @@ import GHC.Utils.Outputable
 import GHC.Unit.State
 import GHC.Unit.External
 
-import Data.List ( sortBy, mapAccumL )
+import Data.List ( mapAccumL )
+import qualified Data.List.NonEmpty as NE
 import Control.Monad( unless )
 import Data.Function ( on )
 
@@ -826,21 +827,9 @@ newClsInst overlap_mode dfun_name tvs theta clas tys
 
        ; oflag <- getOverlapFlag overlap_mode
        ; let inst = mkLocalInstance dfun oflag tvs' clas tys'
-       ; warnIf (isOrphan (is_orphan inst)) (instOrphWarn inst)
+       ; warnIf (isOrphan (is_orphan inst)) (TcRnOrphanInstance inst)
        ; return inst }
 
-instOrphWarn :: ClsInst -> TcRnMessage
-instOrphWarn inst
-  = TcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag Opt_WarnOrphans) noHints $
-    hang (text "Orphan instance:") 2 (pprInstanceHdr inst)
-    $$ text "To avoid this"
-    $$ nest 4 (vcat possibilities)
-  where
-    possibilities =
-      text "move the instance declaration to the module of the class or of the type, or" :
-      text "wrap the type with a newtype and declare the instance on the new type." :
-      []
-
 tcExtendLocalInstEnv :: [ClsInst] -> TcM a -> TcM a
   -- Add new locally-defined instances
 tcExtendLocalInstEnv dfuns thing_inside
@@ -965,22 +954,21 @@ traceDFuns ispecs
 
 funDepErr :: ClsInst -> [ClsInst] -> TcRn ()
 funDepErr ispec ispecs
-  = addClsInstsErr (text "Functional dependencies conflict between instance declarations:")
-                    (ispec : ispecs)
+  = addClsInstsErr TcRnFunDepConflict (ispec NE.:| ispecs)
 
 dupInstErr :: ClsInst -> ClsInst -> TcRn ()
 dupInstErr ispec dup_ispec
-  = addClsInstsErr (text "Duplicate instance declarations:")
-                    [ispec, dup_ispec]
+  = addClsInstsErr TcRnDupInstanceDecls (ispec NE.:| [dup_ispec])
 
-addClsInstsErr :: SDoc -> [ClsInst] -> TcRn ()
-addClsInstsErr herald ispecs = do
+addClsInstsErr :: (UnitState -> NE.NonEmpty ClsInst -> TcRnMessage)
+               -> NE.NonEmpty ClsInst
+               -> TcRn ()
+addClsInstsErr mkErr ispecs = do
    unit_state <- hsc_units <$> getTopEnv
-   setSrcSpan (getSrcSpan (head sorted)) $
-      addErr $ TcRnUnknownMessage $ mkPlainError noHints $
-      pprWithUnitState unit_state $ (hang herald 2 (pprInstances sorted))
+   setSrcSpan (getSrcSpan (NE.head sorted)) $
+      addErr $ mkErr unit_state sorted
  where
-   sorted = sortBy (SrcLoc.leftmost_smallest `on` getSrcSpan) ispecs
+   sorted = NE.sortBy (SrcLoc.leftmost_smallest `on` getSrcSpan) ispecs
    -- The sortBy just arranges that instances are displayed in order
    -- of source location, which reduced wobbling in error messages,
    -- and is better for users
diff --git a/compiler/GHC/Types/Error.hs b/compiler/GHC/Types/Error.hs
index b1814e8fb1..aa5b2a5770 100644
--- a/compiler/GHC/Types/Error.hs
+++ b/compiler/GHC/Types/Error.hs
@@ -33,6 +33,7 @@ module GHC.Types.Error
 
    -- * Hints and refactoring actions
    , GhcHint (..)
+   , AvailableBindings(..)
    , LanguageExtensionHint(..)
    , suggestExtension
    , suggestExtensionWithInfo
diff --git a/compiler/GHC/Types/Hint.hs b/compiler/GHC/Types/Hint.hs
index be8417f19c..f6e9445976 100644
--- a/compiler/GHC/Types/Hint.hs
+++ b/compiler/GHC/Types/Hint.hs
@@ -2,6 +2,7 @@
 
 module GHC.Types.Hint (
     GhcHint(..)
+  , AvailableBindings(..)
   , InstantiationSuggestion(..)
   , LanguageExtensionHint(..)
   , suggestExtension
@@ -14,6 +15,8 @@ module GHC.Types.Hint (
 
 import GHC.Prelude
 
+import qualified Data.List.NonEmpty as NE
+
 import GHC.Utils.Outputable
 import qualified GHC.LanguageExtensions as LangExt
 import Data.Typeable
@@ -27,6 +30,12 @@ import {-# SOURCE #-} Language.Haskell.Syntax.Expr
   -- This {-# SOURCE #-} import should be removable once
   -- 'Language.Haskell.Syntax.Bind' no longer depends on 'GHC.Tc.Types.Evidence'.
 
+-- | The bindings we have available in scope when
+-- suggesting an explicit type signature.
+data AvailableBindings
+  = NamedBindings  (NE.NonEmpty Name)
+  | UnnamedBinding
+  -- ^ An unknown binding (i.e. too complicated to turn into a 'Name')
 
 data LanguageExtensionHint
   = -- | Suggest to enable the input extension. If the input 'SDoc'
@@ -177,7 +186,7 @@ data GhcHint
     {-| Suggests adding a type signature, typically to resolve ambiguity or help GHC inferring types.
 
     -}
-  | SuggestAddTypeSignature
+  | SuggestAddTypeSignatures AvailableBindings
     {-| Suggests to explicitly discard the result of a monadic action by binding the result to
         the '_' wilcard.
 
@@ -252,6 +261,14 @@ data GhcHint
     -}
   | SuggestTypeSignatureForm
 
+    {-| Suggests to move an orphan instance or to newtype-wrap it.
+
+        Triggered by: 'GHC.Tc.Errors.Types.TcRnOrphanInstance'
+        Test cases(s): warnings/should_compile/T9178
+                       typecheck/should_compile/T4912
+    -}
+  | SuggestFixOrphanInstance
+
 -- | An 'InstantiationSuggestion' for a '.hsig' file. This is generated
 -- by GHC in case of a 'DriverUnexpectedSignature' and suggests a way
 -- to instantiate a particular signature, where the first argument is
diff --git a/compiler/GHC/Types/Hint/Ppr.hs b/compiler/GHC/Types/Hint/Ppr.hs
index eb68ff0c33..6651fbd2e3 100644
--- a/compiler/GHC/Types/Hint/Ppr.hs
+++ b/compiler/GHC/Types/Hint/Ppr.hs
@@ -18,6 +18,7 @@ import GHC.Unit.Types
 import GHC.Utils.Outputable
 
 import Data.List (intersperse)
+import qualified Data.List.NonEmpty as NE
 
 instance Outputable GhcHint where
   ppr = \case
@@ -63,8 +64,19 @@ instance Outputable GhcHint where
       -> text "Use parentheses."
     SuggestIncreaseMaxPmCheckModels
       -> text "Increase the limit or resolve the warnings to suppress this message."
-    SuggestAddTypeSignature
-      -> text "Add a type signature."
+    SuggestAddTypeSignatures bindings
+      -> case bindings of
+          -- This might happen when we have bindings which are /too complicated/,
+          -- see for example 'DsCannotMixPolyAndUnliftedBindings' in 'GHC.HsToCore.Errors.Types'.
+          -- In this case, we emit a generic message.
+          UnnamedBinding   -> text "Add a type signature."
+          NamedBindings (x NE.:| xs) ->
+            let nameList = case xs of
+                  [] -> quotes . ppr $ x
+                  _  -> pprWithCommas (quotes . ppr) xs <+> text "and" <+> quotes (ppr x)
+            in hsep [ text "Consider giving"
+                    , nameList
+                    , text "a type signature"]
     SuggestBindToWildcard rhs
       -> hang (text "Suppress this warning by saying") 2 (quotes $ text "_ <-" <+> ppr rhs)
     SuggestAddInlineOrNoInlinePragma lhs_id rule_act
@@ -104,6 +116,10 @@ instance Outputable GhcHint where
          in case mb_mod of
               Nothing -> header <+> text "the hsig file."
               Just mod -> header <+> ppr (moduleName mod) <> text "'s hsig file."
+    SuggestFixOrphanInstance
+      -> vcat [ text "Move the instance declaration to the module of the class or of the type, or"
+              , text "wrap the type with a newtype and declare the instance on the new type."
+              ]
 
 perhapsAsPat :: SDoc
 perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace"
diff --git a/testsuite/tests/typecheck/should_compile/T10935.stderr b/testsuite/tests/typecheck/should_compile/T10935.stderr
index 31f1243ef5..8da5015910 100644
--- a/testsuite/tests/typecheck/should_compile/T10935.stderr
+++ b/testsuite/tests/typecheck/should_compile/T10935.stderr
@@ -1,6 +1,6 @@
 
 T10935.hs:5:11: warning: [-Wmonomorphism-restriction]
     • The Monomorphism Restriction applies to the binding for ‘y’
-        Consider giving it a type signature
     • In the expression: let y = 1 + 1 in (y, y)
       In an equation for ‘f’: f x = let y = 1 + 1 in (y, y)
+    Suggested fix: Consider giving ‘y’ a type signature
diff --git a/testsuite/tests/typecheck/should_compile/T13785.stderr b/testsuite/tests/typecheck/should_compile/T13785.stderr
index b86e7da132..d831d895ce 100644
--- a/testsuite/tests/typecheck/should_compile/T13785.stderr
+++ b/testsuite/tests/typecheck/should_compile/T13785.stderr
@@ -2,7 +2,6 @@
 T13785.hs:16:5: warning: [-Wmonomorphism-restriction]
     • The Monomorphism Restriction applies to the bindings
       for ‘bar2’, ‘baz2’
-        Consider giving them a type signature
     • In an equation for ‘foo’:
           foo
             = bar >> baz >> bar2
@@ -10,3 +9,4 @@ T13785.hs:16:5: warning: [-Wmonomorphism-restriction]
                 bar, baz :: m Char
                 (bar, baz) = c
                 (bar2, baz2) = c
+    Suggested fix: Consider giving ‘baz2’ and ‘bar2’ a type signature
diff --git a/testsuite/tests/typecheck/should_compile/T4912.stderr b/testsuite/tests/typecheck/should_compile/T4912.stderr
index 104275cdda..891ca527d8 100644
--- a/testsuite/tests/typecheck/should_compile/T4912.stderr
+++ b/testsuite/tests/typecheck/should_compile/T4912.stderr
@@ -1,12 +1,12 @@
 
 T4912.hs:10:1: warning: [-Worphans (in -Wall)]
     Orphan instance: instance Foo TheirData
-    To avoid this
-        move the instance declaration to the module of the class or of the type, or
+    Suggested fix:
+        Move the instance declaration to the module of the class or of the type, or
         wrap the type with a newtype and declare the instance on the new type.
 
 T4912.hs:13:1: warning: [-Worphans (in -Wall)]
     Orphan instance: instance Bar OurData
-    To avoid this
-        move the instance declaration to the module of the class or of the type, or
+    Suggested fix:
+        Move the instance declaration to the module of the class or of the type, or
         wrap the type with a newtype and declare the instance on the new type.
diff --git a/testsuite/tests/typecheck/should_fail/T16512b.stderr b/testsuite/tests/typecheck/should_fail/T16512b.stderr
index 649957c43d..f519938636 100644
--- a/testsuite/tests/typecheck/should_fail/T16512b.stderr
+++ b/testsuite/tests/typecheck/should_fail/T16512b.stderr
@@ -2,8 +2,8 @@
 T16512b.hs:6:3: error:
     • Type family equation violates the family's injectivity annotation.
       Type variable ‘a’ cannot be inferred from the right-hand side.
-      Using UndecidableInstances might help
       In the type family equation:
         G [a] = [G a] -- Defined at T16512b.hs:6:3
     • In the equations for closed type family ‘G’
       In the type family declaration for ‘G’
+    Suggested fix: Perhaps you intended to use UndecidableInstances
diff --git a/testsuite/tests/warnings/should_compile/T9178.stderr b/testsuite/tests/warnings/should_compile/T9178.stderr
index 6edcbff5ec..769452c2b0 100644
--- a/testsuite/tests/warnings/should_compile/T9178.stderr
+++ b/testsuite/tests/warnings/should_compile/T9178.stderr
@@ -3,6 +3,6 @@
 
 T9178.hs:8:1: warning: [-Worphans (in -Wall)]
     Orphan instance: instance Show T9178_Type
-    To avoid this
-        move the instance declaration to the module of the class or of the type, or
+    Suggested fix:
+        Move the instance declaration to the module of the class or of the type, or
         wrap the type with a newtype and declare the instance on the new type.