Use diagnostic infrastructure in GHC.Tc.Errors

3 files changed, 10 insertions, 8 deletions

diff --git a/compiler/GHC/Parser/Errors/Ppr.hs b/compiler/GHC/Parser/Errors/Ppr.hs
index 138a24ccd5..fe9f74eb73 100644
--- a/compiler/GHC/Parser/Errors/Ppr.hs
+++ b/compiler/GHC/Parser/Errors/Ppr.hs
@@ -14,10 +14,11 @@ import GHC.Parser.Errors.Basic
 import GHC.Parser.Errors.Types
 import GHC.Parser.Types
 import GHC.Types.Basic
+import GHC.Types.Hint
 import GHC.Types.Error
 import GHC.Types.Hint.Ppr (perhapsAsPat)
 import GHC.Types.SrcLoc
-import GHC.Types.Name.Reader (opIsAt, starInfo, rdrNameOcc, mkUnqual)
+import GHC.Types.Name.Reader ( opIsAt, rdrNameOcc, mkUnqual )
 import GHC.Types.Name.Occurrence (isSymOcc, occNameFS, varName)
 import GHC.Utils.Outputable
 import GHC.Utils.Misc
@@ -272,10 +273,9 @@ instance Diagnostic PsMessage where
                 (ppr v)
     PsErrTupleSectionInPat
       -> mkSimpleDecorated $ text "Tuple section in pattern context"
-    PsErrOpFewArgs (StarIsType star_is_type) op
+    PsErrOpFewArgs _ op
       -> mkSimpleDecorated $
            text "Operator applied to too few arguments:" <+> ppr op
-           $$ starInfo star_is_type op
     PsErrVarForTyCon name
       -> mkSimpleDecorated $
            text "Expecting a type constructor but found a variable,"
@@ -610,7 +610,7 @@ instance Diagnostic PsMessage where
     PsWarnHaddockInvalidPos                       -> noHints
     PsWarnHaddockIgnoreMulti                      -> noHints
     PsWarnStarBinder                              -> [SuggestQualifyStarOperator]
-    PsWarnStarIsType                              -> [SuggestUseTypeFromDataKind]
+    PsWarnStarIsType                              -> [SuggestUseTypeFromDataKind Nothing]
     PsWarnUnrecognisedPragma                      -> noHints
     PsWarnImportPreQualified                      -> [ SuggestQualifiedAfterModuleName
                                                      , suggestExtension LangExt.ImportQualifiedPost]
@@ -668,7 +668,8 @@ instance Diagnostic PsMessage where
     PsErrUnsupportedBoxedSumPat{}                 -> noHints
     PsErrUnexpectedQualifiedConstructor{}         -> noHints
     PsErrTupleSectionInPat{}                      -> noHints
-    PsErrOpFewArgs{}                              -> noHints
+    PsErrOpFewArgs star_is_type op
+      -> noStarIsTypeHints star_is_type op
     PsErrVarForTyCon{}                            -> noHints
     PsErrMalformedEntityString                    -> noHints
     PsErrDotsInRecordUpdate                       -> noHints
diff --git a/compiler/GHC/Parser/Errors/Types.hs b/compiler/GHC/Parser/Errors/Types.hs
index d39048c441..d50b21d7ad 100644
--- a/compiler/GHC/Parser/Errors/Types.hs
+++ b/compiler/GHC/Parser/Errors/Types.hs
@@ -12,6 +12,7 @@ import GHC.Hs
 import GHC.Parser.Types
 import GHC.Parser.Errors.Basic
 import GHC.Types.Error
+import GHC.Types.Hint
 import GHC.Types.Name.Occurrence (OccName)
 import GHC.Types.Name.Reader
 import GHC.Unit.Module.Name
@@ -452,8 +453,6 @@ data PsMessage
 
    | PsErrInvalidCApiImport
 
-newtype StarIsType = StarIsType Bool
-
 -- | Extra details about a parse error, which helps
 -- us in determining which should be the hints to
 -- suggest.
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index aab72310ac..83b55f5632 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -126,6 +126,7 @@ import GHC.Unit.Module (ModuleName)
 import GHC.Types.Basic
 import GHC.Types.Error
 import GHC.Types.Fixity
+import GHC.Types.Hint
 import GHC.Types.SourceText
 import GHC.Parser.Types
 import GHC.Parser.Lexer
@@ -2788,8 +2789,9 @@ warnStarIsType span = addPsMessage span PsWarnStarIsType
 failOpFewArgs :: MonadP m => LocatedN RdrName -> m a
 failOpFewArgs (L loc op) =
   do { star_is_type <- getBit StarIsTypeBit
+     ; let is_star_type = if star_is_type then StarIsType else StarIsNotType
      ; addFatalError $ mkPlainErrorMsgEnvelope (locA loc) $
-         (PsErrOpFewArgs (StarIsType star_is_type) op) }
+         (PsErrOpFewArgs is_star_type op) }
 
 -----------------------------------------------------------------------------
 -- Misc utils