From 56abe494fac648a97b06f30b6855901291bed8bc Mon Sep 17 00:00:00 2001
From: sheaf <sam.derbyshire@gmail.com>
Date: Wed, 24 May 2023 14:44:52 +0200
Subject: [PATCH] Common up Template Haskell errors in TcRnMessage
This commit commons up the various Template Haskell errors into a
single constructor, TcRnTHError, of TcRnMessage.
---
compiler/GHC/Rename/Expr.hs | 4 +-
compiler/GHC/Rename/Module.hs | 15 +-
compiler/GHC/Rename/Splice.hs | 36 +-
compiler/GHC/Tc/Errors/Ppr.hs | 557 ++++++++------
compiler/GHC/Tc/Errors/Types.hs | 721 +++++++++---------
compiler/GHC/Tc/Gen/Head.hs | 3 +-
compiler/GHC/Tc/Gen/Splice.hs | 43 +-
compiler/GHC/Tc/Module.hs | 3 +-
compiler/GHC/Types/Error/Codes.hs | 63 +-
.../tests/parser/should_fail/T18251e.stderr | 5 +-
.../tests/quotes/TH_double_splice.stderr | 5 +-
testsuite/tests/quotes/TH_top_splice.stderr | 5 +-
testsuite/tests/quotes/TTH_top_splice.stderr | 5 +-
.../safeLanguage/SafeLang12.stderr | 5 +-
.../should_fail/THPutDocExternal.stderr | 2 +-
testsuite/tests/th/T16976z.stderr | 4 +-
.../tests/th/TH_invalid_add_top_decl.stderr | 2 +-
17 files changed, 805 insertions(+), 673 deletions(-)
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs
index 2afc0f0fa604..b60c46726a2b 100644
--- a/compiler/GHC/Rename/Expr.hs
+++ b/compiler/GHC/Rename/Expr.hs
@@ -587,8 +587,8 @@ rnExpr e@(HsStatic _ expr) = do
(expr',fvExpr) <- rnLExpr expr
stage <- getStage
case stage of
- Splice _ -> addErr $ TcRnIllegalStaticFormInSplice e
- _ -> return ()
+ Splice _ -> addErr $ TcRnTHError $ IllegalStaticFormInSplice e
+ _ -> return ()
mod <- getModule
let fvExpr' = filterNameSet (nameIsLocalOrFrom mod) fvExpr
return (HsStatic fvExpr' expr', fvExpr)
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index 319dececdd74..fc1ec39086e9 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -2616,21 +2616,18 @@ add gp _ (SpliceD _ (SpliceDecl _ (L _ qq@HsQuasiQuote{}) _)) ds
add gp loc (SpliceD _ splice@(SpliceDecl _ _ flag)) ds
= do { -- We've found a top-level splice. If it is an *implicit* one
- -- (i.e. a naked top level expression)
+ -- (i.e. a naked top level expression), throw an error if
+ -- TemplateHaskell is not enabled.
case flag of
DollarSplice -> return ()
- BareSplice -> do { th_on <- xoptM LangExt.TemplateHaskell
- ; unless th_on $ setSrcSpan (locA loc) $
- failWith badImplicitSplice }
+ BareSplice -> do { unlessXOptM LangExt.TemplateHaskell
+ $ setSrcSpan (locA loc)
+ $ failWith badImplicitSplice }
; return (gp, Just (splice, ds)) }
where
badImplicitSplice :: TcRnMessage
- badImplicitSplice = TcRnBadImplicitSplice
- -- The compiler should suggest the above, and not using
- -- TemplateHaskell since the former suggestion is more
- -- relevant to the larger base of users.
- -- See #12146 for discussion.
+ badImplicitSplice = TcRnTHError (THSyntaxError BadImplicitSplice)
-- Class declarations: added to the TyClGroup
add gp@(HsGroup {hs_tyclds = ts}) l (TyClD _ d) ds
diff --git a/compiler/GHC/Rename/Splice.hs b/compiler/GHC/Rename/Splice.hs
index 792f885bc67d..841cc1ceef4b 100644
--- a/compiler/GHC/Rename/Splice.hs
+++ b/compiler/GHC/Rename/Splice.hs
@@ -78,10 +78,10 @@ import qualified GHC.LanguageExtensions as LangExt
-}
-- Check that -XTemplateHaskellQuotes is enabled and available
-checkForTemplateHaskellQuotes :: HsExpr GhcPs -> RnM ()
+checkForTemplateHaskellQuotes :: HsExpr GhcPs -> RnM ()
checkForTemplateHaskellQuotes e =
unlessXOptM LangExt.TemplateHaskellQuotes $
- failWith $ TcRnIllegalTHQuotes e
+ failWith $ thSyntaxError $ IllegalTHQuotes e
rnTypedBracket :: HsExpr GhcPs -> LHsExpr GhcPs -> RnM (HsExpr GhcRn, FreeVars)
rnTypedBracket e br_body
@@ -92,13 +92,15 @@ rnTypedBracket e br_body
; cur_stage <- getStage
; case cur_stage of
{ Splice Typed -> return ()
- ; Splice Untyped -> failWithTc $ TcRnMismatchedSpliceType Untyped IsBracket
+ ; Splice Untyped -> failWithTc $ thSyntaxError
+ $ MismatchedSpliceType Untyped IsBracket
; RunSplice _ ->
-- See Note [RunSplice ThLevel] in GHC.Tc.Types.
pprPanic "rnTypedBracket: Renaming typed bracket when running a splice"
(ppr e)
; Comp -> return ()
- ; Brack {} -> failWithTc TcRnNestedTHBrackets
+ ; Brack {} -> failWithTc $ thSyntaxError
+ $ NestedTHBrackets
}
-- Brackets are desugared to code that mentions the TH package
@@ -119,14 +121,16 @@ rnUntypedBracket e br_body
-- Check for nested brackets
; cur_stage <- getStage
; case cur_stage of
- { Splice Typed -> failWithTc $ TcRnMismatchedSpliceType Typed IsBracket
+ { Splice Typed -> failWithTc $ thSyntaxError
+ $ MismatchedSpliceType Typed IsBracket
; Splice Untyped -> return ()
; RunSplice _ ->
-- See Note [RunSplice ThLevel] in GHC.Tc.Types.
pprPanic "rnUntypedBracket: Renaming untyped bracket when running a splice"
(ppr e)
; Comp -> return ()
- ; Brack {} -> failWithTc TcRnNestedTHBrackets
+ ; Brack {} -> failWithTc $ thSyntaxError
+ $ NestedTHBrackets
}
-- Brackets are desugared to code that mentions the TH package
@@ -164,8 +168,8 @@ rn_utbracket outer_stage br@(VarBr x flg rdr_name)
-> do { traceRn "rn_utbracket VarBr"
(ppr name <+> ppr bind_lvl
<+> ppr outer_stage)
- ; checkTc (thLevel outer_stage + 1 == bind_lvl)
- (TcRnQuotedNameWrongStage br) }
+ ; checkTc (thLevel outer_stage + 1 == bind_lvl) $
+ TcRnTHError $ THNameError $ QuotedNameWrongStage br }
}
}
; return (VarBr x flg (noLocA name), unitFV name) }
@@ -274,7 +278,8 @@ rnUntypedSpliceGen run_splice pend_splice splice
{ stage <- getStage
; case stage of
Brack _ RnPendingTyped
- -> failWithTc $ TcRnMismatchedSpliceType Untyped IsSplice
+ -> failWithTc $ thSyntaxError
+ $ MismatchedSpliceType Untyped IsSplice
Brack pop_stage (RnPendingUntyped ps_var)
-> do { (splice', fvs) <- setStage pop_stage $
@@ -305,8 +310,10 @@ checkTopSpliceAllowed splice = do
unlessXOptM ext $ failWith err
where
spliceExtension :: HsUntypedSplice GhcPs -> (LangExt.Extension, TcRnMessage)
- spliceExtension (HsQuasiQuote {}) = (LangExt.QuasiQuotes, TcRnIllegalQuasiQuotes)
- spliceExtension (HsUntypedSpliceExpr {}) = (LangExt.TemplateHaskell, TcRnIllegalTHSplice)
+ spliceExtension (HsQuasiQuote {}) =
+ (LangExt.QuasiQuotes, TcRnIllegalQuasiQuotes)
+ spliceExtension (HsUntypedSpliceExpr {}) =
+ (LangExt.TemplateHaskell, thSyntaxError $ IllegalTHSplice)
------------------
@@ -428,10 +435,10 @@ rnTypedSplice expr
-> setStage pop_stage rn_splice
Brack _ (RnPendingUntyped _)
- -> failWithTc $ TcRnMismatchedSpliceType Typed IsSplice
+ -> failWithTc $ thSyntaxError $ MismatchedSpliceType Typed IsSplice
_ -> do { unlessXOptM LangExt.TemplateHaskell
- (failWith TcRnIllegalTHSplice)
+ (failWith $ thSyntaxError IllegalTHSplice)
; (result, fvs1) <- checkNoErrs $ setStage (Splice Typed) rn_splice
-- checkNoErrs: don't attempt to run the splice if
@@ -482,6 +489,9 @@ rnUntypedSpliceExpr splice
; return (gHsPar e, fvs)
}
+thSyntaxError :: THSyntaxError -> TcRnMessage
+thSyntaxError err = TcRnTHError $ THSyntaxError err
+
{- Note [Running splices in the Renamer]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 1cd17518c68e..f6256b89c87e 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -974,9 +974,6 @@ instance Diagnostic TcRnMessage where
-> mkSimpleDecorated $
text "non-bidirectional pattern synonym"
<+> quotes (ppr name) <+> text "used in an expression"
- TcRnSplicePolymorphicLocalVar ident
- -> mkSimpleDecorated $
- text "Can't splice the polymorphic local variable" <+> quotes (ppr ident)
TcRnIllegalDerivingItem hs_ty
-> mkSimpleDecorated $
text "Illegal deriving item" <+> quotes (ppr hs_ty)
@@ -992,9 +989,6 @@ instance Diagnostic TcRnMessage where
TcRnIllegalRecordSyntax either_ty_ty
-> mkSimpleDecorated $
text "Record syntax is illegal here:" <+> either ppr ppr either_ty_ty
- TcRnUnexpectedTypeSplice ty
- -> mkSimpleDecorated $
- text "Unexpected type splice:" <+> ppr ty
TcRnInvalidVisibleKindArgument arg ty
-> mkSimpleDecorated $
text "Cannot apply function of kind" <+> quotes (ppr ty)
@@ -1200,108 +1194,6 @@ instance Diagnostic TcRnMessage where
-- Is the data con a "covert" GADT? See Note [isCovertGadtDataCon]
-- in GHC.Core.DataCon
sneaky_eq_spec = isCovertGadtDataCon con
-
- TcRnTypedTHWithPolyType ty
- -> mkSimpleDecorated $
- vcat [ text "Illegal polytype:" <+> ppr ty
- , text "The type of a Typed Template Haskell expression must" <+>
- text "not have any quantification." ]
- TcRnSpliceThrewException phase _exn exn_msg expr show_code
- -> mkSimpleDecorated $
- vcat [ text "Exception when trying to" <+> text phaseStr <+> text "compile-time code:"
- , nest 2 (text exn_msg)
- , if show_code then text "Code:" <+> ppr expr else empty]
- where phaseStr =
- case phase of
- SplicePhase_Run -> "run"
- SplicePhase_CompileAndLink -> "compile and link"
- TcRnInvalidTopDecl _decl
- -> mkSimpleDecorated $
- text "Only function, value, annotation, and foreign import declarations may be added with addTopDecls"
- TcRnNonExactName name
- -> mkSimpleDecorated $
- hang (text "The binder" <+> quotes (ppr name) <+> text "is not a NameU.")
- 2 (text "Probable cause: you used mkName instead of newName to generate a binding.")
- TcRnAddInvalidCorePlugin plugin
- -> mkSimpleDecorated $
- hang
- (text "addCorePlugin: invalid plugin module "
- <+> text (show plugin)
- )
- 2
- (text "Plugins in the current package can't be specified.")
- TcRnAddDocToNonLocalDefn doc_loc
- -> mkSimpleDecorated $
- text "Can't add documentation to" <+> ppr_loc doc_loc <+>
- text "as it isn't inside the current module"
- where
- ppr_loc (TH.DeclDoc n) = text $ TH.pprint n
- ppr_loc (TH.ArgDoc n _) = text $ TH.pprint n
- ppr_loc (TH.InstDoc t) = text $ TH.pprint t
- ppr_loc TH.ModuleDoc = text "the module header"
-
- TcRnFailedToLookupThInstName th_type reason
- -> mkSimpleDecorated $
- case reason of
- NoMatchesFound ->
- text "Couldn't find any instances of"
- <+> text (TH.pprint th_type)
- <+> text "to add documentation to"
- CouldNotDetermineInstance ->
- text "Couldn't work out what instance"
- <+> text (TH.pprint th_type)
- <+> text "is supposed to be"
- TcRnCannotReifyInstance ty
- -> mkSimpleDecorated $
- hang (text "reifyInstances:" <+> quotes (ppr ty))
- 2 (text "is not a class constraint or type family application")
- TcRnCannotReifyOutOfScopeThing th_name
- -> mkSimpleDecorated $
- quotes (text (TH.pprint th_name)) <+>
- text "is not in scope at a reify"
- -- Ugh! Rather an indirect way to display the name
- TcRnCannotReifyThingNotInTypeEnv name
- -> mkSimpleDecorated $
- quotes (ppr name) <+> text "is not in the type environment at a reify"
- TcRnNoRolesAssociatedWithThing thing
- -> mkSimpleDecorated $
- text "No roles associated with" <+> (ppr thing)
- TcRnCannotRepresentType sort ty
- -> mkSimpleDecorated $
- hsep [text "Can't represent" <+> sort_doc <+>
- text "in Template Haskell:",
- nest 2 (ppr ty)]
- where
- sort_doc = text $
- case sort of
- LinearInvisibleArgument -> "linear invisible argument"
- CoercionsInTypes -> "coercions in types"
- TcRnRunSpliceFailure mCallingFnName (ConversionFail what reason)
- -> mkSimpleDecorated
- . addCallingFn
- . addSpliceInfo
- $ pprConversionFailReason reason
- where
- addCallingFn rest =
- case mCallingFnName of
- Nothing -> rest
- Just callingFn ->
- hang (text ("Error in a declaration passed to " ++ callingFn ++ ":"))
- 2 rest
- addSpliceInfo = case what of
- ConvDec d -> addSliceInfo' "declaration" d
- ConvExp e -> addSliceInfo' "expression" e
- ConvPat p -> addSliceInfo' "pattern" p
- ConvType t -> addSliceInfo' "type" t
- addSliceInfo' what item reasonErr = reasonErr $$ descr
- where
- -- Show the item in pretty syntax normally,
- -- but with all its constructors if you say -dppr-debug
- descr = hang (text "When splicing a TH" <+> text what <> colon)
- 2 (getPprDebug $ \case
- True -> text (show item)
- False -> text (TH.pprint item))
- TcRnReportCustomQuasiError _ msg -> mkSimpleDecorated $ text msg
TcRnUnsatisfiedMinimalDef mindef
-> mkSimpleDecorated $
vcat [text "No explicit implementation for"
@@ -1330,10 +1222,6 @@ instance Diagnostic TcRnMessage where
text "For this to work enable NamedFieldPuns"
TcRnIllegalStaticExpression e -> mkSimpleDecorated $
text "Illegal static expression:" <+> ppr e
- TcRnIllegalStaticFormInSplice e -> mkSimpleDecorated $
- sep [ text "static forms cannot be used in splices:"
- , nest 2 $ ppr e
- ]
TcRnListComprehensionDuplicateBinding n -> mkSimpleDecorated $
(text "Duplicate binding in parallel list comprehension for:"
<+> quotes (ppr n))
@@ -1522,9 +1410,6 @@ instance Diagnostic TcRnMessage where
TcRnStupidThetaInGadt{} -> mkSimpleDecorated $
vcat [text "No context is allowed on a GADT-style data declaration",
text "(You can put a context on each constructor, though.)"]
- TcRnBadImplicitSplice -> mkSimpleDecorated $
- text "Parse error: module header, import declaration"
- $$ text "or top-level declaration expected."
TcRnShadowedTyVarNameInFamResult resName -> mkSimpleDecorated $
hsep [ text "Type variable", quotes (ppr resName) <> comma
, text "naming a type family result,"
@@ -1919,11 +1804,6 @@ instance Diagnostic TcRnMessage where
TcRnNonCanonicalDefinition reason inst_ty
-> mkSimpleDecorated $
pprNonCanonicalDefinition inst_ty reason
- TcRnUnexpectedDeclarationSplice {}
- -> mkSimpleDecorated $
- text "Declaration splices are not permitted" <+>
- text "inside top-level declarations added with" <+>
- quotes (text "addTopDecls") <> dot
TcRnImplicitImportOfPrelude
-> mkSimpleDecorated $
text "Module" <+> quotes (text "Prelude") <+> text "implicitly imported."
@@ -1952,28 +1832,7 @@ instance Diagnostic TcRnMessage where
_ -> empty
TcRnIllegalQuasiQuotes -> mkSimpleDecorated $
text "Quasi-quotes are not permitted without QuasiQuotes"
- TcRnIllegalTHQuotes expr -> mkSimpleDecorated $
- text "Syntax error on" <+> ppr expr
- TcRnIllegalTHSplice -> mkSimpleDecorated $
- text "Top-level splices are not permitted without TemplateHaskell"
- TcRnMismatchedSpliceType splice_type inner_splice_or_bracket ->
- mkSimpleDecorated $
- inner <+> text "may not appear in" <+> outer <> dot
- where
- (inner, outer) = case inner_splice_or_bracket of
- IsSplice -> case splice_type of
- Typed -> (text "Typed splices" , text "untyped brackets")
- Untyped -> (text "Untyped splices", text "typed brackets")
- IsBracket ->
- case splice_type of
- Typed -> (text "Untyped brackets", text "typed splices")
- Untyped -> (text "Typed brackets" , text "untyped splices")
- TcRnNestedTHBrackets -> mkSimpleDecorated $
- text "Template Haskell brackets cannot be nested" <+>
- text "(without intervening splices)"
- TcRnQuotedNameWrongStage quote -> mkSimpleDecorated $
- sep [ text "Stage error: the non-top-level quoted name" <+> ppr quote
- , text "must be used at the same stage at which it is bound" ]
+ TcRnTHError err -> pprTHError err
diagnosticReason = \case
TcRnUnknownMessage m
@@ -2165,6 +2024,8 @@ instance Diagnostic TcRnMessage where
-> ErrorWithoutFlag
TcRnBadRecordUpdate{}
-> ErrorWithoutFlag
+ TcRnIllegalStaticExpression {}
+ -> ErrorWithoutFlag
TcRnStaticFormNotClosed{}
-> ErrorWithoutFlag
TcRnUselessTypeable
@@ -2260,16 +2121,12 @@ instance Diagnostic TcRnMessage where
-> ErrorWithoutFlag
TcRnPatSynNotBidirectional{}
-> ErrorWithoutFlag
- TcRnSplicePolymorphicLocalVar{}
- -> ErrorWithoutFlag
TcRnIllegalDerivingItem{}
-> ErrorWithoutFlag
TcRnUnexpectedAnnotation{}
-> ErrorWithoutFlag
TcRnIllegalRecordSyntax{}
-> ErrorWithoutFlag
- TcRnUnexpectedTypeSplice{}
- -> ErrorWithoutFlag
TcRnInvalidVisibleKindArgument{}
-> ErrorWithoutFlag
TcRnTooManyBinders{}
@@ -2322,50 +2179,14 @@ instance Diagnostic TcRnMessage where
-> WarningWithFlag (Opt_WarnMissingMethods)
TcRnIllegalTypeData
-> ErrorWithoutFlag
- TcRnQuotedNameWrongStage {}
- -> ErrorWithoutFlag
TcRnIllegalQuasiQuotes{}
-> ErrorWithoutFlag
- TcRnIllegalTHQuotes{}
- -> ErrorWithoutFlag
- TcRnIllegalTHSplice{}
- -> ErrorWithoutFlag
- TcRnNestedTHBrackets{}
- -> ErrorWithoutFlag
- TcRnMismatchedSpliceType{}
- -> ErrorWithoutFlag
+ TcRnTHError err
+ -> thErrorReason err
TcRnTypeDataForbids{}
-> ErrorWithoutFlag
TcRnIllegalNewtype{}
-> ErrorWithoutFlag
- TcRnTypedTHWithPolyType{}
- -> ErrorWithoutFlag
- TcRnSpliceThrewException{}
- -> ErrorWithoutFlag
- TcRnInvalidTopDecl{}
- -> ErrorWithoutFlag
- TcRnNonExactName{}
- -> ErrorWithoutFlag
- TcRnAddInvalidCorePlugin{}
- -> ErrorWithoutFlag
- TcRnAddDocToNonLocalDefn{}
- -> ErrorWithoutFlag
- TcRnFailedToLookupThInstName{}
- -> ErrorWithoutFlag
- TcRnCannotReifyInstance{}
- -> ErrorWithoutFlag
- TcRnCannotReifyOutOfScopeThing{}
- -> ErrorWithoutFlag
- TcRnCannotReifyThingNotInTypeEnv{}
- -> ErrorWithoutFlag
- TcRnNoRolesAssociatedWithThing{}
- -> ErrorWithoutFlag
- TcRnCannotRepresentType{}
- -> ErrorWithoutFlag
- TcRnRunSpliceFailure{}
- -> ErrorWithoutFlag
- TcRnReportCustomQuasiError isError _
- -> if isError then ErrorWithoutFlag else WarningWithoutFlag
TcRnUnsatisfiedMinimalDef{}
-> WarningWithFlag (Opt_WarnMissingMethods)
TcRnMisplacedInstSig{}
@@ -2380,10 +2201,6 @@ instance Diagnostic TcRnMessage where
-> ErrorWithoutFlag
TcRnNoFieldPunsRecordDot{}
-> ErrorWithoutFlag
- TcRnIllegalStaticExpression{}
- -> ErrorWithoutFlag
- TcRnIllegalStaticFormInSplice{}
- -> ErrorWithoutFlag
TcRnListComprehensionDuplicateBinding{}
-> ErrorWithoutFlag
TcRnEmptyStmtsGroup{}
@@ -2448,8 +2265,6 @@ instance Diagnostic TcRnMessage where
-> WarningWithFlag Opt_WarnMissingDerivingStrategies
TcRnStupidThetaInGadt{}
-> ErrorWithoutFlag
- TcRnBadImplicitSplice{}
- -> ErrorWithoutFlag
TcRnShadowedTyVarNameInFamResult{}
-> ErrorWithoutFlag
TcRnIncorrectTyVarOnLhsOfInjCond{}
@@ -2619,8 +2434,6 @@ instance Diagnostic TcRnMessage where
-> WarningWithFlag Opt_WarnNonCanonicalMonoidInstances
TcRnNonCanonicalDefinition (NonCanonicalMonad _) _
-> WarningWithFlag Opt_WarnNonCanonicalMonadInstances
- TcRnUnexpectedDeclarationSplice {}
- -> ErrorWithoutFlag
TcRnImplicitImportOfPrelude {}
-> WarningWithFlag Opt_WarnImplicitPrelude
TcRnMissingMain {}
@@ -2850,6 +2663,8 @@ instance Diagnostic TcRnMessage where
-> noHints
TcRnBadRecordUpdate{}
-> noHints
+ TcRnIllegalStaticExpression {}
+ -> [suggestExtension LangExt.StaticPointers]
TcRnStaticFormNotClosed{}
-> noHints
TcRnUselessTypeable
@@ -2933,16 +2748,12 @@ instance Diagnostic TcRnMessage where
-> [SuggestPatternMatchingSyntax]
TcRnPatSynNotBidirectional{}
-> noHints
- TcRnSplicePolymorphicLocalVar{}
- -> noHints
TcRnIllegalDerivingItem{}
-> noHints
TcRnUnexpectedAnnotation{}
-> noHints
TcRnIllegalRecordSyntax{}
-> noHints
- TcRnUnexpectedTypeSplice{}
- -> noHints
TcRnInvalidVisibleKindArgument{}
-> noHints
TcRnTooManyBinders{}
@@ -2978,18 +2789,10 @@ instance Diagnostic TcRnMessage where
-> noHints
TcRnIllegalHsigDefaultMethods{}
-> noHints
- TcRnQuotedNameWrongStage {}
- -> noHints
TcRnIllegalQuasiQuotes{}
-> [suggestExtension LangExt.QuasiQuotes]
- TcRnIllegalTHQuotes{}
- -> [suggestAnyExtension [LangExt.TemplateHaskell, LangExt.TemplateHaskellQuotes]]
- TcRnIllegalTHSplice{}
- -> [suggestExtension LangExt.TemplateHaskell]
- TcRnNestedTHBrackets{}
- -> noHints
- TcRnMismatchedSpliceType{}
- -> noHints
+ TcRnTHError err
+ -> thErrorHints err
TcRnHsigFixityMismatch{}
-> noHints
TcRnHsigShapeMismatch{}
@@ -3014,34 +2817,6 @@ instance Diagnostic TcRnMessage where
-> noHints
TcRnIllegalNewtype{}
-> noHints
- TcRnTypedTHWithPolyType{}
- -> noHints
- TcRnSpliceThrewException{}
- -> noHints
- TcRnInvalidTopDecl{}
- -> noHints
- TcRnNonExactName{}
- -> noHints
- TcRnAddInvalidCorePlugin{}
- -> noHints
- TcRnAddDocToNonLocalDefn{}
- -> noHints
- TcRnFailedToLookupThInstName{}
- -> noHints
- TcRnCannotReifyInstance{}
- -> noHints
- TcRnCannotReifyOutOfScopeThing{}
- -> noHints
- TcRnCannotReifyThingNotInTypeEnv{}
- -> noHints
- TcRnNoRolesAssociatedWithThing{}
- -> noHints
- TcRnCannotRepresentType{}
- -> noHints
- TcRnRunSpliceFailure{}
- -> noHints
- TcRnReportCustomQuasiError{}
- -> noHints
TcRnUnsatisfiedMinimalDef{}
-> noHints
TcRnMisplacedInstSig{}
@@ -3056,10 +2831,6 @@ instance Diagnostic TcRnMessage where
-> noHints
TcRnNoFieldPunsRecordDot{}
-> noHints
- TcRnIllegalStaticExpression{}
- -> [suggestExtension LangExt.StaticPointers]
- TcRnIllegalStaticFormInSplice{}
- -> noHints
TcRnListComprehensionDuplicateBinding{}
-> noHints
TcRnEmptyStmtsGroup EmptyStmtsGroupInDoNotation{}
@@ -3136,8 +2907,6 @@ instance Diagnostic TcRnMessage where
else [suggestExtension LangExt.DerivingStrategies]
TcRnStupidThetaInGadt{}
-> noHints
- TcRnBadImplicitSplice{}
- -> noHints
TcRnShadowedTyVarNameInFamResult{}
-> noHints
TcRnIncorrectTyVarOnLhsOfInjCond{}
@@ -3322,8 +3091,6 @@ instance Diagnostic TcRnMessage where
-> noHints
TcRnNonCanonicalDefinition reason _
-> suggestNonCanonicalDefinition reason
- TcRnUnexpectedDeclarationSplice {}
- -> noHints
TcRnImplicitImportOfPrelude {}
-> noHints
TcRnMissingMain {}
@@ -6088,3 +5855,309 @@ failedCoverageConditionHints (CoverageProblem { not_covered_liberal = failed_cc
else [suggestExtension LangExt.UndecidableInstances]
--------------------------------------------------------------------------------
+-- Template Haskell quotes and splices
+
+pprTHError :: THError -> DecoratedSDoc
+pprTHError = \case
+ THSyntaxError err -> pprTHSyntaxError err
+ THNameError err -> pprTHNameError err
+ THReifyError err -> pprTHReifyError err
+ TypedTHError err -> pprTypedTHError err
+ THSpliceFailed rea -> pprSpliceFailReason rea
+ AddTopDeclsError err -> pprAddTopDeclsError err
+
+ IllegalStaticFormInSplice e ->
+ mkSimpleDecorated $
+ sep [ text "static forms cannot be used in splices:"
+ , nest 2 $ ppr e
+ ]
+
+ FailedToLookupThInstName th_type reason ->
+ mkSimpleDecorated $
+ case reason of
+ NoMatchesFound ->
+ text "Couldn't find any instances of"
+ <+> text (TH.pprint th_type)
+ <+> text "to add documentation to"
+ CouldNotDetermineInstance ->
+ text "Couldn't work out what instance"
+ <+> text (TH.pprint th_type)
+ <+> text "is supposed to be"
+
+ AddInvalidCorePlugin plugin ->
+ mkSimpleDecorated $
+ hang (text "addCorePlugin: invalid plugin module" <+> quotes (text plugin) )
+ 2 (text "Plugins in the current package can't be specified.")
+
+ AddDocToNonLocalDefn doc_loc ->
+ mkSimpleDecorated $
+ text "Can't add documentation to" <+> ppr_loc doc_loc <> comma <+>
+ text "as it isn't inside the current module."
+ where
+ ppr_loc (TH.DeclDoc n) = text $ TH.pprint n
+ ppr_loc (TH.ArgDoc n _) = text $ TH.pprint n
+ ppr_loc (TH.InstDoc t) = text $ TH.pprint t
+ ppr_loc TH.ModuleDoc = text "the module header"
+
+ ReportCustomQuasiError _ msg -> mkSimpleDecorated $ text msg
+
+pprTHSyntaxError :: THSyntaxError -> DecoratedSDoc
+pprTHSyntaxError = mkSimpleDecorated . \case
+ IllegalTHQuotes expr ->
+ text "Syntax error on" <+> ppr expr
+ -- The error message context will say
+ -- "In the Template Haskell quotation", so no need to repeat that here.
+ BadImplicitSplice ->
+ sep [ text "Parse error: module header, import declaration"
+ , text "or top-level declaration expected." ]
+ -- The compiler should not mention TemplateHaskell, as the common case
+ -- is that this is a simple beginner error, for example:
+ --
+ -- module M where
+ -- f :: Int -> Int; f x = x
+ -- xyzzy
+ -- g y = f y + 1
+ --
+ -- It's unlikely that 'xyzzy' above was intended to be a Template Haskell
+ -- splice; instead it's probably something mistakenly left in the code.
+ -- See #12146 for discussion.
+
+ IllegalTHSplice ->
+ text "Unexpected top-level splice."
+ MismatchedSpliceType splice_type inner_splice_or_bracket ->
+ inner <+> text "may not appear in" <+> outer <> dot
+ where
+ (inner, outer) = case inner_splice_or_bracket of
+ IsSplice -> case splice_type of
+ Typed -> (text "Typed splices" , text "untyped brackets")
+ Untyped -> (text "Untyped splices", text "typed brackets")
+ IsBracket ->
+ case splice_type of
+ Typed -> (text "Untyped brackets", text "typed splices")
+ Untyped -> (text "Typed brackets" , text "untyped splices")
+ NestedTHBrackets ->
+ text "Template Haskell brackets cannot be nested" <+>
+ text "(without intervening splices)"
+
+pprTHNameError :: THNameError -> DecoratedSDoc
+pprTHNameError = \case
+ NonExactName name ->
+ mkSimpleDecorated $
+ hang (text "The binder" <+> quotes (ppr name) <+> text "is not a NameU.")
+ 2 (text "Probable cause: you used mkName instead of newName to generate a binding.")
+ QuotedNameWrongStage quote ->
+ mkSimpleDecorated $
+ sep [ text "Stage error: the non-top-level quoted name" <+> ppr quote
+ , text "must be used at the same stage at which it is bound." ]
+
+pprTHReifyError :: THReifyError -> DecoratedSDoc
+pprTHReifyError = \case
+ CannotReifyInstance ty
+ -> mkSimpleDecorated $
+ hang (text "reifyInstances:" <+> quotes (ppr ty))
+ 2 (text "is not a class constraint or type family application")
+ CannotReifyOutOfScopeThing th_name
+ -> mkSimpleDecorated $
+ quotes (text (TH.pprint th_name)) <+>
+ text "is not in scope at a reify"
+ -- Ugh! Rather an indirect way to display the name
+ CannotReifyThingNotInTypeEnv name
+ -> mkSimpleDecorated $
+ quotes (ppr name) <+> text "is not in the type environment at a reify"
+ NoRolesAssociatedWithThing thing
+ -> mkSimpleDecorated $
+ text "No roles associated with" <+> (ppr thing)
+ CannotRepresentType sort ty
+ -> mkSimpleDecorated $
+ hsep [text "Can't represent" <+> sort_doc <+>
+ text "in Template Haskell:",
+ nest 2 (ppr ty)]
+ where
+ sort_doc = text $
+ case sort of
+ LinearInvisibleArgument -> "linear invisible argument"
+ CoercionsInTypes -> "coercions in types"
+
+pprTypedTHError :: TypedTHError -> DecoratedSDoc
+pprTypedTHError = \case
+ SplicePolymorphicLocalVar ident
+ -> mkSimpleDecorated $
+ text "Can't splice the polymorphic local variable" <+> quotes (ppr ident)
+ TypedTHWithPolyType ty
+ -> mkSimpleDecorated $
+ vcat [ text "Illegal polytype:" <+> ppr ty
+ , text "The type of a Typed Template Haskell expression must" <+>
+ text "not have any quantification." ]
+
+pprSpliceFailReason :: SpliceFailReason -> DecoratedSDoc
+pprSpliceFailReason = \case
+ SpliceThrewException phase _exn exn_msg expr show_code ->
+ mkSimpleDecorated $
+ vcat [ text "Exception when trying to" <+> text phaseStr <+> text "compile-time code:"
+ , nest 2 (text exn_msg)
+ , if show_code then text "Code:" <+> ppr expr else empty]
+ where phaseStr =
+ case phase of
+ SplicePhase_Run -> "run"
+ SplicePhase_CompileAndLink -> "compile and link"
+ RunSpliceFailure err -> pprRunSpliceFailure Nothing err
+
+pprAddTopDeclsError :: AddTopDeclsError -> DecoratedSDoc
+pprAddTopDeclsError = \case
+ InvalidTopDecl _decl ->
+ mkSimpleDecorated $
+ sep [ text "Only function, value, annotation, and foreign import declarations"
+ , text "may be added with" <+> quotes (text "addTopDecls") <> dot ]
+ AddTopDeclsUnexpectedDeclarationSplice {} ->
+ mkSimpleDecorated $
+ text "Declaration splices are not permitted" <+>
+ text "inside top-level declarations added with" <+>
+ quotes (text "addTopDecls") <> dot
+ AddTopDeclsRunSpliceFailure err ->
+ pprRunSpliceFailure (Just "addTopDecls") err
+
+pprRunSpliceFailure :: Maybe String -> RunSpliceFailReason -> DecoratedSDoc
+pprRunSpliceFailure mb_calling_fn (ConversionFail what reason) =
+ mkSimpleDecorated . add_calling_fn . addSpliceInfo $
+ pprConversionFailReason reason
+ where
+ add_calling_fn rest =
+ case mb_calling_fn of
+ Just calling_fn ->
+ hang (text "Error in a declaration passed to" <+> quotes (text calling_fn) <> colon)
+ 2 rest
+ Nothing -> rest
+ addSpliceInfo = case what of
+ ConvDec d -> addSliceInfo' "declaration" d
+ ConvExp e -> addSliceInfo' "expression" e
+ ConvPat p -> addSliceInfo' "pattern" p
+ ConvType t -> addSliceInfo' "type" t
+ addSliceInfo' what item reasonErr = reasonErr $$ descr
+ where
+ -- Show the item in pretty syntax normally,
+ -- but with all its constructors if you say -dppr-debug
+ descr = hang (text "When splicing a TH" <+> text what <> colon)
+ 2 (getPprDebug $ \case
+ True -> text (show item)
+ False -> text (TH.pprint item))
+
+thErrorReason :: THError -> DiagnosticReason
+thErrorReason = \case
+ THSyntaxError err -> thSyntaxErrorReason err
+ THNameError err -> thNameErrorReason err
+ THReifyError err -> thReifyErrorReason err
+ TypedTHError err -> typedTHErrorReason err
+ THSpliceFailed rea -> spliceFailedReason rea
+ AddTopDeclsError err -> addTopDeclsErrorReason err
+
+ IllegalStaticFormInSplice {} -> ErrorWithoutFlag
+ FailedToLookupThInstName {} -> ErrorWithoutFlag
+ AddInvalidCorePlugin {} -> ErrorWithoutFlag
+ AddDocToNonLocalDefn {} -> ErrorWithoutFlag
+ ReportCustomQuasiError is_error _ ->
+ if is_error
+ then ErrorWithoutFlag
+ else WarningWithoutFlag
+
+thSyntaxErrorReason :: THSyntaxError -> DiagnosticReason
+thSyntaxErrorReason = \case
+ IllegalTHQuotes{} -> ErrorWithoutFlag
+ BadImplicitSplice -> ErrorWithoutFlag
+ IllegalTHSplice{} -> ErrorWithoutFlag
+ NestedTHBrackets{} -> ErrorWithoutFlag
+ MismatchedSpliceType{} -> ErrorWithoutFlag
+
+thNameErrorReason :: THNameError -> DiagnosticReason
+thNameErrorReason = \case
+ NonExactName {} -> ErrorWithoutFlag
+ QuotedNameWrongStage {} -> ErrorWithoutFlag
+
+thReifyErrorReason :: THReifyError -> DiagnosticReason
+thReifyErrorReason = \case
+ CannotReifyInstance {} -> ErrorWithoutFlag
+ CannotReifyOutOfScopeThing {} -> ErrorWithoutFlag
+ CannotReifyThingNotInTypeEnv {} -> ErrorWithoutFlag
+ NoRolesAssociatedWithThing {} -> ErrorWithoutFlag
+ CannotRepresentType {} -> ErrorWithoutFlag
+
+typedTHErrorReason :: TypedTHError -> DiagnosticReason
+typedTHErrorReason = \case
+ SplicePolymorphicLocalVar {} -> ErrorWithoutFlag
+ TypedTHWithPolyType {} -> ErrorWithoutFlag
+
+spliceFailedReason :: SpliceFailReason -> DiagnosticReason
+spliceFailedReason = \case
+ SpliceThrewException {} -> ErrorWithoutFlag
+ RunSpliceFailure {} -> ErrorWithoutFlag
+
+addTopDeclsErrorReason :: AddTopDeclsError -> DiagnosticReason
+addTopDeclsErrorReason = \case
+ InvalidTopDecl {}
+ -> ErrorWithoutFlag
+ AddTopDeclsUnexpectedDeclarationSplice {}
+ -> ErrorWithoutFlag
+ AddTopDeclsRunSpliceFailure {}
+ -> ErrorWithoutFlag
+
+thErrorHints :: THError -> [GhcHint]
+thErrorHints = \case
+ THSyntaxError err -> thSyntaxErrorHints err
+ THNameError err -> thNameErrorHints err
+ THReifyError err -> thReifyErrorHints err
+ TypedTHError err -> typedTHErrorHints err
+ THSpliceFailed rea -> spliceFailedHints rea
+ AddTopDeclsError err -> addTopDeclsErrorHints err
+
+ IllegalStaticFormInSplice {} -> noHints
+ FailedToLookupThInstName {} -> noHints
+ AddInvalidCorePlugin {} -> noHints
+ AddDocToNonLocalDefn {} -> noHints
+ ReportCustomQuasiError {} -> noHints
+
+thSyntaxErrorHints :: THSyntaxError -> [GhcHint]
+thSyntaxErrorHints = \case
+ IllegalTHQuotes{}
+ -> [suggestAnyExtension [LangExt.TemplateHaskell, LangExt.TemplateHaskellQuotes]]
+ BadImplicitSplice {}
+ -> noHints -- NB: don't suggest TemplateHaskell
+ -- see comments on BadImplicitSplice in pprTHSyntaxError
+ IllegalTHSplice{}
+ -> [suggestExtension LangExt.TemplateHaskell]
+ NestedTHBrackets{}
+ -> noHints
+ MismatchedSpliceType{}
+ -> noHints
+
+thNameErrorHints :: THNameError -> [GhcHint]
+thNameErrorHints = \case
+ NonExactName {} -> noHints
+ QuotedNameWrongStage {} -> noHints
+
+thReifyErrorHints :: THReifyError -> [GhcHint]
+thReifyErrorHints = \case
+ CannotReifyInstance {} -> noHints
+ CannotReifyOutOfScopeThing {} -> noHints
+ CannotReifyThingNotInTypeEnv {} -> noHints
+ NoRolesAssociatedWithThing {} -> noHints
+ CannotRepresentType {} -> noHints
+
+typedTHErrorHints :: TypedTHError -> [GhcHint]
+typedTHErrorHints = \case
+ SplicePolymorphicLocalVar {} -> noHints
+ TypedTHWithPolyType {} -> noHints
+
+spliceFailedHints :: SpliceFailReason -> [GhcHint]
+spliceFailedHints = \case
+ SpliceThrewException {} -> noHints
+ RunSpliceFailure {} -> noHints
+
+addTopDeclsErrorHints :: AddTopDeclsError -> [GhcHint]
+addTopDeclsErrorHints = \case
+ InvalidTopDecl {}
+ -> noHints
+ AddTopDeclsUnexpectedDeclarationSplice {}
+ -> noHints
+ AddTopDeclsRunSpliceFailure {}
+ -> noHints
+
+--------------------------------------------------------------------------------
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index ab0eebf87c5b..0b328a142573 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -82,14 +82,6 @@ module GHC.Tc.Errors.Types (
, ExpectedBackends
, ArgOrResult(..)
, MatchArgsContext(..), MatchArgBadMatches(..)
- , ConversionFailReason(..)
- , UnrepresentableTypeDescr(..)
- , LookupTHInstNameErrReason(..)
- , SplicePhase(..)
- , THDeclDescriptor(..)
- , RunSpliceFailReason(..)
- , ThingBeingConverted(..)
- , IllegalDecls(..)
, EmptyStatementGroupErrReason(..)
, UnexpectedStatement(..)
, DeclSort(..)
@@ -135,9 +127,24 @@ module GHC.Tc.Errors.Types (
, BootDataConMismatch(..)
, SynAbstractDataError(..)
, BootListMismatch(..), BootListMismatches
+
+ -- * Instance errors
, IllegalInstanceReason(..)
, IllegalHasFieldInstance(..)
, CoverageProblem(..), FailedCoverageCondition(..)
+
+ -- * Template Haskell errors
+ , THError(..), THSyntaxError(..), THNameError(..)
+ , THReifyError(..), TypedTHError(..)
+ , SpliceFailReason(..), RunSpliceFailReason(..)
+ , AddTopDeclsError(..)
+ , ConversionFailReason(..)
+ , UnrepresentableTypeDescr(..)
+ , LookupTHInstNameErrReason(..)
+ , SplicePhase(..)
+ , THDeclDescriptor(..)
+ , ThingBeingConverted(..)
+ , IllegalDecls(..)
) where
import GHC.Prelude
@@ -2175,16 +2182,6 @@ data TcRnMessage where
-}
TcRnPatSynNotBidirectional :: !Name -> TcRnMessage
- {-| TcRnSplicePolymorphicLocalVar is the error that occurs when the expression
- inside typed template haskell brackets is a polymorphic local variable.
-
- Example(s):
- x = \(y :: forall a. a -> a) -> [|| y ||]
-
- Test cases: quotes/T10384
- -}
- TcRnSplicePolymorphicLocalVar :: !Id -> TcRnMessage
-
{-| TcRnIllegalDerivingItem is an error for when something other than a type class
appears in a deriving statement.
@@ -2217,24 +2214,6 @@ data TcRnMessage where
-}
TcRnIllegalRecordSyntax :: Either (HsType GhcPs) (HsType GhcRn) -> TcRnMessage
- {-| TcRnUnexpectedTypeSplice is an error for a typed Template Haskell splice
- appearing unexpectedly.
-
- Example(s): none
-
- Test cases: none
- -}
- TcRnUnexpectedTypeSplice :: !(HsType GhcRn) -> TcRnMessage
-
- {-| TcRnUnexpectedDeclarationSplice is an error that occurs when a Template Haskell
- splice appears inside top-level declarations added with 'addTopDecls'.
-
- Example(s): none
-
- Test cases: none
- -}
- TcRnUnexpectedDeclarationSplice :: TcRnMessage
-
{-| TcRnInvalidVisibleKindArgument is an error for a kind application on a
target type that cannot accept it.
@@ -2612,55 +2591,10 @@ data TcRnMessage where
-}
TcRnIllegalQuasiQuotes :: TcRnMessage
- {-| TcRnIllegalTHQuotes is an error that occurs when a Template Haskell
- quote is used without the TemplateHaskell extension enabled.
-
- Test case: T18251e
- -}
- TcRnIllegalTHQuotes :: !(HsExpr GhcPs) -> TcRnMessage
-
- {-| TcRnIllegalTHSplice is an error that occurs when a Template Haskell
- splice occurs without having enabled the TemplateHaskell extension.
-
- Test cases:
- bkpfail01, bkpfail05, bkpfail09, bkpfail16, bkpfail35, bkpcabal06
- -}
- TcRnIllegalTHSplice :: TcRnMessage
-
- {-| TcRnNestedTHBrackets is an error that occurs when Template Haskell
- brackets are nested without any intervening splices.
-
- Example:
-
- foo = [| [| 'x' |] |]
-
- Test cases: TH_NestedSplicesFail{5,6,7,8}
- -}
- TcRnNestedTHBrackets :: TcRnMessage
-
- {-| TcRnMismatchedSpliceType is an error that happens when a typed bracket
- or splice is used inside a typed splice/bracket, or the other way around.
-
- Examples:
-
- f1 = [| $$x |]
- f2 = [|| $y ||]
- f3 = $$( [| 'x' |] )
- f4 = $( [|| 'y' ||] )
-
- Test cases: TH_NestedSplicesFail{1,2,3,4}
+ {-| TcRnTHError is a family of errors involving Template Haskell.
+ See 'THError'.
-}
- TcRnMismatchedSpliceType :: SpliceType -- ^ type of the splice
- -> SpliceOrBracket -- ^ what's nested inside
- -> TcRnMessage
-
- {-| TcRnQuotedNameWrongStage is an error that can happen when a
- (non-top-level) Name is used at a different Template Haskell stage
- than the stage at which it is bound.
-
- Test cases: T16976z
- -}
- TcRnQuotedNameWrongStage :: !(HsQuote GhcPs) -> TcRnMessage
+ TcRnTHError :: THError -> TcRnMessage
{-| TcRnDefaultMethodForPragmaLacksBinding is an error that occurs when
a default method pragma is missing an accompanying binding.
@@ -2757,180 +2691,6 @@ data TcRnMessage where
-}
TcRnTypeDataForbids :: !TypeDataForbids -> TcRnMessage
- {-| TcRnTypedTHWithPolyType is an error that signifies the illegal use
- of a polytype in a typed template haskell expression.
-
- Example(s):
- bad :: (forall a. a -> a) -> ()
- bad = $$( [|| \_ -> () ||] )
-
- Test cases: th/T11452
- -}
- TcRnTypedTHWithPolyType :: !TcType -> TcRnMessage
-
- {-| TcRnSpliceThrewException is an error that occurrs when running a template
- haskell splice throws an exception.
-
- Example(s):
-
- Test cases: annotations/should_fail/annfail12
- perf/compiler/MultiLayerModulesTH_Make
- perf/compiler/MultiLayerModulesTH_OneShot
- th/T10796b
- th/T19470
- th/T19709d
- th/T5358
- th/T5976
- th/T7276a
- th/T8987
- th/TH_exn1
- th/TH_exn2
- th/TH_runIO
- -}
- TcRnSpliceThrewException
- :: !SplicePhase
- -> !SomeException
- -> !String -- ^ Result of showing the exception (cannot be done safely outside IO)
- -> !(LHsExpr GhcTc)
- -> !Bool -- True <=> Print the expression
- -> TcRnMessage
-
- {-| TcRnInvalidTopDecl is a template haskell error occurring when one of the 'Dec's passed to
- 'addTopDecls' is not a function, value, annotation, or foreign import declaration.
-
- Example(s):
-
- Test cases:
- -}
- TcRnInvalidTopDecl :: !(HsDecl GhcPs) -> TcRnMessage
-
- {-| TcRnNonExactName is a template haskell error for when a declaration being
- added is bound to a name that is not fully known.
-
- Example(s):
-
- Test cases:
- -}
- TcRnNonExactName :: !RdrName -> TcRnMessage
-
- {-| TcRnAddInvalidCorePlugin is a template haskell error indicating that a
- core plugin being added has an invalid module due to being in the current package.
-
- Example(s):
-
- Test cases:
- -}
- TcRnAddInvalidCorePlugin
- :: !String -- ^ Module name
- -> TcRnMessage
-
- {-| TcRnAddDocToNonLocalDefn is a template haskell error for documentation being added to a
- definition which is not in the current module.
-
- Example(s):
-
- Test cases: showIface/should_fail/THPutDocExternal
- -}
- TcRnAddDocToNonLocalDefn :: !TH.DocLoc -> TcRnMessage
-
- {-| TcRnFailedToLookupThInstName is a template haskell error that occurrs when looking up an
- instance fails.
-
- Example(s):
-
- Test cases: showIface/should_fail/THPutDocNonExistent
- -}
- TcRnFailedToLookupThInstName :: !TH.Type -> !LookupTHInstNameErrReason -> TcRnMessage
-
- {-| TcRnCannotReifyInstance is a template haskell error for when an instance being reified
- via `reifyInstances` is not a class constraint or type family application.
-
- Example(s):
-
- Test cases:
- -}
- TcRnCannotReifyInstance :: !Type -> TcRnMessage
-
- {-| TcRnCannotReifyOutOfScopeThing is a template haskell error indicating
- that the given name is not in scope and therefore cannot be reified.
-
- Example(s):
-
- Test cases: th/T16976f
- -}
- TcRnCannotReifyOutOfScopeThing :: !TH.Name -> TcRnMessage
-
- {-| TcRnCannotReifyThingNotInTypeEnv is a template haskell error occurring
- when the given name is not in the type environment and therefore cannot be reified.
-
- Example(s):
-
- Test cases:
- -}
- TcRnCannotReifyThingNotInTypeEnv :: !Name -> TcRnMessage
-
- {-| TcRnNoRolesAssociatedWithName is a template haskell error for when the user
- tries to reify the roles of a given name but it is not something that has
- roles associated with it.
-
- Example(s):
-
- Test cases:
- -}
- TcRnNoRolesAssociatedWithThing :: !TcTyThing -> TcRnMessage
-
- {-| TcRnCannotRepresentThing is a template haskell error indicating that a
- type cannot be reified because it does not have a representation in template haskell.
-
- Example(s):
-
- Test cases:
- -}
- TcRnCannotRepresentType :: !UnrepresentableTypeDescr -> !Type -> TcRnMessage
-
- {-| TcRnRunSpliceFailure is an error indicating that a Template Haskell splice
- failed to be converted into a valid expression.
-
- Example(s):
-
- Test cases: th/T10828a
- th/T10828b
- th/T12478_4
- th/T15270A
- th/T15270B
- th/T16895a
- th/T16895b
- th/T16895c
- th/T16895d
- th/T16895e
- th/T18740d
- th/T2597b
- th/T2674
- th/T3395
- th/T7484
- th/T7667a
- th/TH_implicitParamsErr1
- th/TH_implicitParamsErr2
- th/TH_implicitParamsErr3
- th/TH_invalid_add_top_decl
- -}
- TcRnRunSpliceFailure
- :: !(Maybe String) -- ^ Name of the function used to run the splice
- -> !RunSpliceFailReason
- -> TcRnMessage
-
- {-| TcRnUserErrReported is an error or warning thrown using 'qReport' from
- the 'Quasi' instance of 'TcM'.
-
- Example(s):
-
- Test cases:
- -}
- TcRnReportCustomQuasiError
- :: !Bool -- True => Error, False => Warning
- -> !String -- Error body
- -> TcRnMessage
-
{-| TcRnUnsatisfiedMinimalDef is a warning that occurs when a class instance
is missing methods that are required by the minimal definition.
@@ -3031,15 +2791,6 @@ data TcRnMessage where
-}
TcRnIllegalStaticExpression :: HsExpr GhcPs -> TcRnMessage
- {-| TcRnIllegalStaticFormInSplice is an error when a user attempts to define
- a static pointer in a Template Haskell splice.
-
- Example(s):
-
- Test cases: th/TH_StaticPointers02
- -}
- TcRnIllegalStaticFormInSplice :: HsExpr GhcPs -> TcRnMessage
-
{-| TcRnListComprehensionDuplicateBinding is an error triggered by duplicate
let-bindings in a list comprehension.
@@ -3474,21 +3225,6 @@ data TcRnMessage where
-}
TcRnStupidThetaInGadt :: HsDocContext -> TcRnMessage
- {-| TcRnBadImplicitSplice is an error thrown when a user uses top-level implicit
- TH-splice without enabling the TemplateHaskell extension.
-
- Example:
-
- pure [] -- on top-level
-
- Test cases: ghci/prog019/prog019
- ghci/scripts/T1914
- ghci/scripts/T6106
- rename/should_fail/T4042
- rename/should_fail/T12146
- -}
- TcRnBadImplicitSplice :: TcRnMessage
-
{-| TcRnShadowedTyVarNameInFamResult is an error triggered by type variable in
type family result that shadows type variable from left hand side
@@ -4316,55 +4052,6 @@ instance Outputable TypeDataForbids where
ppr TypeDataForbidsStrictnessAnnotations = text "Strictness flags"
ppr TypeDataForbidsDerivingClauses = text "Deriving clauses"
-data RunSpliceFailReason
- = ConversionFail !ThingBeingConverted !ConversionFailReason
- deriving Generic
-
--- | Identifies the TH splice attempting to be converted
-data ThingBeingConverted
- = ConvDec !TH.Dec
- | ConvExp !TH.Exp
- | ConvPat !TH.Pat
- | ConvType !TH.Type
-
--- | The reason a TH splice could not be converted to a Haskell expression
-data ConversionFailReason
- = IllegalOccName !OccName.NameSpace !String
- | SumAltArityExceeded !TH.SumAlt !TH.SumArity
- | IllegalSumAlt !TH.SumAlt
- | IllegalSumArity !TH.SumArity
- | MalformedType !TypeOrKind !TH.Type
- | IllegalLastStatement !HsDoFlavour !(LStmt GhcPs (LHsExpr GhcPs))
- | KindSigsOnlyAllowedOnGADTs
- | IllegalDeclaration !THDeclDescriptor !IllegalDecls
- | CannotMixGADTConsWith98Cons
- | EmptyStmtListInDoBlock
- | NonVarInInfixExpr
- | MultiWayIfWithoutAlts
- | CasesExprWithoutAlts
- | ImplicitParamsWithOtherBinds
- | InvalidCCallImpent !String -- ^ Source
- | RecGadtNoCons
- | GadtNoCons
- | InvalidTypeInstanceHeader !TH.Type
- | InvalidTyFamInstLHS !TH.Type
- | InvalidImplicitParamBinding
- | DefaultDataInstDecl ![LDataFamInstDecl GhcPs]
- | FunBindLacksEquations !TH.Name
- deriving Generic
-
-data IllegalDecls
- = IllegalDecls !(NE.NonEmpty (LHsDecl GhcPs))
- | IllegalFamDecls !(NE.NonEmpty (LFamilyDecl GhcPs))
-
--- | Label for a TH declaration
-data THDeclDescriptor
- = InstanceDecl
- | WhereClause
- | LetBinding
- | LetExpression
- | ClssDecl
-
-- | Specifies which back ends can handle a requested foreign import or export
type ExpectedBackends = [Backend]
@@ -5714,19 +5401,6 @@ data MatchArgBadMatches where
, matchArgBadMatches :: NE.NonEmpty (LocatedA (Match GhcRn body)) }
-> MatchArgBadMatches
--- | The phase in which an exception was encountered when dealing with a TH splice
-data SplicePhase
- = SplicePhase_Run
- | SplicePhase_CompileAndLink
-
-data LookupTHInstNameErrReason
- = NoMatchesFound
- | CouldNotDetermineInstance
-
-data UnrepresentableTypeDescr
- = LinearInvisibleArgument
- | CoercionsInTypes
-
-- | The context for an "empty statement group" error.
data EmptyStatementGroupErrReason
= EmptyStmtsGroupInParallelComp
@@ -6149,3 +5823,362 @@ data FailedCoverageCondition
}
-- | Failed the liberal instance coverage condition (LICC)
| FailedLICC
+
+--------------------------------------------------------------------------------
+-- Template Haskell errors
+
+data THError
+ -- | A syntax error with Template Haskel quotes & splices.
+ -- See t'THSyntaxError'.
+ = THSyntaxError !THSyntaxError
+ -- | An error in Template Haskell involving 'Name's.
+ -- See t'THNameError'.
+ | THNameError !THNameError
+ -- | An error in Template Haskell reification. See t'THReifyError'.
+ | THReifyError !THReifyError
+ -- | An error due to typing restrictions in Typed Template Haskell.
+ -- See t'TypedTHError'.
+ | TypedTHError !TypedTHError
+ -- | An error occurred when trying to run a splice in Template Haskell.
+ -- See 'SpliceFailReason'.
+ | THSpliceFailed !SpliceFailReason
+ -- | An error involving the 'addTopDecls' functionality. See t'AddTopDeclsError'.
+ | AddTopDeclsError !AddTopDeclsError
+
+ {-| IllegalStaticFormInSplice is an error when a user attempts to define
+ a static pointer in a Template Haskell splice.
+
+ Example(s):
+
+ Test cases: th/TH_StaticPointers02
+ -}
+ | IllegalStaticFormInSplice !(HsExpr GhcPs)
+
+ {-| FailedToLookupThInstName is a Template Haskell error that occurrs when looking up an
+ instance fails.
+
+ Example(s):
+
+ Test cases: showIface/should_fail/THPutDocNonExistent
+ -}
+ | FailedToLookupThInstName !TH.Type !LookupTHInstNameErrReason
+
+ {-| AddInvalidCorePlugin is a Template Haskell error indicating that a
+ Core plugin being added has an invalid module due to being
+ in the current package.
+
+ Example(s):
+
+ Test cases:
+ -}
+ | AddInvalidCorePlugin !String -- ^ Module name
+
+ {-| AddDocToNonLocalDefn is a Template Haskell error for documentation being added to a
+ definition which is not in the current module.
+
+ Example(s):
+
+ Test cases: showIface/should_fail/THPutDocExternal
+ -}
+ | AddDocToNonLocalDefn !TH.DocLoc
+
+ {-| ReportCustomQuasiError is an error or warning thrown using 'qReport' from
+ the 'Quasi' instance of 'TcM'.
+
+ Example(s):
+
+ Test cases:
+ -}
+ | ReportCustomQuasiError
+ !Bool -- ^ True => Error, False => Warning
+ !String -- ^ Error body
+ deriving Generic
+
+-- | An error involving Template Haskell quotes or splices, e.g. nested
+-- quotation brackets or the use of an untyped bracket inside a typed splice.
+data THSyntaxError
+ = {-| IllegalTHQuotes is an error that occurs when a Template Haskell
+ quote is used without the TemplateHaskell extension enabled.
+
+ Test case: T18251e
+ -}
+ IllegalTHQuotes !(HsExpr GhcPs)
+
+ {-| IllegalTHSplice is an error that occurs when a Template Haskell
+ splice occurs without having enabled the TemplateHaskell extension.
+
+ Test cases:
+ bkpfail01, bkpfail05, bkpfail09, bkpfail16, bkpfail35, bkpcabal06
+ -}
+ | IllegalTHSplice
+
+ {-| NestedTHBrackets is an error that occurs when Template Haskell
+ brackets are nested without any intervening splices.
+
+ Example:
+
+ foo = [| [| 'x' |] |]
+
+ Test cases: TH_NestedSplicesFail{5,6,7,8}
+ -}
+ | NestedTHBrackets
+
+ {-| MismatchedSpliceType is an error that happens when a typed bracket
+ or splice is used inside a typed splice/bracket, or the other way around.
+
+ Examples:
+
+ f1 = [| $$x |]
+ f2 = [|| $y ||]
+ f3 = $$( [| 'x' |] )
+ f4 = $( [|| 'y' ||] )
+
+ Test cases: TH_NestedSplicesFail{1,2,3,4}
+ -}
+ | MismatchedSpliceType
+ SpliceType -- ^ type of the splice
+ SpliceOrBracket -- ^ what's nested inside
+ {-| BadImplicitSplice is an error thrown when a user uses top-level implicit
+ TH-splice without enabling the TemplateHaskell extension.
+
+ Example:
+
+ pure [] -- on top-level
+
+ Test cases: ghci/prog019/prog019
+ ghci/scripts/T1914
+ ghci/scripts/T6106
+ rename/should_fail/T4042
+ rename/should_fail/T12146
+ -}
+ | BadImplicitSplice
+ deriving Generic
+
+data THNameError
+ {-| NonExactName is a Template Haskell error that occurs when the user
+ attempts to define a binder with a 'RdrName' that is not an exact 'Name'.
+
+ Example(s):
+
+ Test cases:
+ -}
+ = NonExactName !RdrName
+
+ {-| QuotedNameWrongStage is an error that can happen when a
+ (non-top-level) Name is used at a different Template Haskell stage
+ than the stage at which it is bound.
+
+ Test cases: T16976z
+ -}
+ | QuotedNameWrongStage !(HsQuote GhcPs)
+ deriving Generic
+
+data THReifyError
+ = {-| CannotReifyInstance is a Template Haskell error for when an instance being reified
+ via `reifyInstances` is not a class constraint or type family application.
+
+ Example(s):
+
+ Test cases:
+ -}
+ CannotReifyInstance !Type
+
+ {-| CannotReifyOutOfScopeThing is a Template Haskell error indicating
+ that the given name is not in scope and therefore cannot be reified.
+
+ Example(s):
+
+ Test cases: th/T16976f
+ -}
+ | CannotReifyOutOfScopeThing !TH.Name
+
+ {-| CannotReifyThingNotInTypeEnv is a Template Haskell error occurring
+ when the given name is not in the type environment and therefore cannot be reified.
+
+ Example(s):
+
+ Test cases:
+ -}
+ | CannotReifyThingNotInTypeEnv !Name
+
+ {-| NoRolesAssociatedWithName is a Template Haskell error for when the user
+ tries to reify the roles of a given name but it is not something that has
+ roles associated with it.
+
+ Example(s):
+
+ Test cases:
+ -}
+ | NoRolesAssociatedWithThing !TcTyThing
+
+ {-| CannotRepresentThing is a Template Haskell error indicating that a
+ type cannot be reified because it does not have a representation in Template Haskell.
+
+ Example(s):
+
+ Test cases:
+ -}
+ | CannotRepresentType !UnrepresentableTypeDescr !Type
+ deriving Generic
+
+data AddTopDeclsError
+ = {-| InvalidTopDecl is a Template Haskell error occurring when one of the 'Dec's passed to
+ 'addTopDecls' is not a function, value, annotation, or foreign import declaration.
+
+ Example(s):
+
+ Test cases:
+ -}
+ InvalidTopDecl !(HsDecl GhcPs)
+ {-| UnexpectedDeclarationSplice is an error that occurs when a Template Haskell
+ splice appears inside top-level declarations added with 'addTopDecls'.
+
+ Example(s): none
+
+ Test cases: none
+ -}
+ | AddTopDeclsUnexpectedDeclarationSplice
+
+ | AddTopDeclsRunSpliceFailure !RunSpliceFailReason
+ deriving Generic
+
+data TypedTHError
+ = {-| SplicePolymorphicLocalVar is the error that occurs when the expression
+ inside typed Template Haskell brackets is a polymorphic local variable.
+
+ Example(s):
+ x = \(y :: forall a. a -> a) -> [|| y ||]
+
+ Test cases: quotes/T10384
+ -}
+ SplicePolymorphicLocalVar !Id
+
+ {-| TypedTHWithPolyType is an error that signifies the illegal use
+ of a polytype in a typed Template Haskell expression.
+
+ Example(s):
+ bad :: (forall a. a -> a) -> ()
+ bad = $$( [|| \_ -> () ||] )
+
+ Test cases: th/T11452
+ -}
+ | TypedTHWithPolyType !TcType
+ deriving Generic
+
+data SpliceFailReason
+ = {-| SpliceThrewException is an error that occurs when running a Template
+ Haskell splice throws an exception.
+
+ Example(s):
+
+ Test cases: annotations/should_fail/annfail12
+ perf/compiler/MultiLayerModulesTH_Make
+ perf/compiler/MultiLayerModulesTH_OneShot
+ th/T10796b
+ th/T19470
+ th/T19709d
+ th/T5358
+ th/T5976
+ th/T7276a
+ th/T8987
+ th/TH_exn1
+ th/TH_exn2
+ th/TH_runIO
+ -}
+ SpliceThrewException
+ !SplicePhase
+ !SomeException
+ !String -- ^ Result of showing the exception (cannot be done safely outside IO)
+ !(LHsExpr GhcTc)
+ !Bool -- True <=> Print the expression
+
+ {-| RunSpliceFailure is an error indicating that a Template Haskell splice
+ failed to be converted into a valid expression.
+
+ Example(s):
+
+ Test cases: th/T10828a
+ th/T10828b
+ th/T12478_4
+ th/T15270A
+ th/T15270B
+ th/T16895a
+ th/T16895b
+ th/T16895c
+ th/T16895d
+ th/T16895e
+ th/T18740d
+ th/T2597b
+ th/T2674
+ th/T3395
+ th/T7484
+ th/T7667a
+ th/TH_implicitParamsErr1
+ th/TH_implicitParamsErr2
+ th/TH_implicitParamsErr3
+ th/TH_invalid_add_top_decl
+ -}
+ | RunSpliceFailure !RunSpliceFailReason
+ deriving Generic
+
+data RunSpliceFailReason
+ = ConversionFail !ThingBeingConverted !ConversionFailReason
+ deriving Generic
+
+-- | Identifies the TH splice attempting to be converted
+data ThingBeingConverted
+ = ConvDec !TH.Dec
+ | ConvExp !TH.Exp
+ | ConvPat !TH.Pat
+ | ConvType !TH.Type
+
+-- | The reason a TH splice could not be converted to a Haskell expression
+data ConversionFailReason
+ = IllegalOccName !OccName.NameSpace !String
+ | SumAltArityExceeded !TH.SumAlt !TH.SumArity
+ | IllegalSumAlt !TH.SumAlt
+ | IllegalSumArity !TH.SumArity
+ | MalformedType !TypeOrKind !TH.Type
+ | IllegalLastStatement !HsDoFlavour !(LStmt GhcPs (LHsExpr GhcPs))
+ | KindSigsOnlyAllowedOnGADTs
+ | IllegalDeclaration !THDeclDescriptor !IllegalDecls
+ | CannotMixGADTConsWith98Cons
+ | EmptyStmtListInDoBlock
+ | NonVarInInfixExpr
+ | MultiWayIfWithoutAlts
+ | CasesExprWithoutAlts
+ | ImplicitParamsWithOtherBinds
+ | InvalidCCallImpent !String -- ^ Source
+ | RecGadtNoCons
+ | GadtNoCons
+ | InvalidTypeInstanceHeader !TH.Type
+ | InvalidTyFamInstLHS !TH.Type
+ | InvalidImplicitParamBinding
+ | DefaultDataInstDecl ![LDataFamInstDecl GhcPs]
+ | FunBindLacksEquations !TH.Name
+ deriving Generic
+
+data IllegalDecls
+ = IllegalDecls !(NE.NonEmpty (LHsDecl GhcPs))
+ | IllegalFamDecls !(NE.NonEmpty (LFamilyDecl GhcPs))
+
+-- | Label for a TH declaration
+data THDeclDescriptor
+ = InstanceDecl
+ | WhereClause
+ | LetBinding
+ | LetExpression
+ | ClssDecl
+
+-- | The phase in which an exception was encountered when dealing with a TH splice
+data SplicePhase
+ = SplicePhase_Run
+ | SplicePhase_CompileAndLink
+
+data LookupTHInstNameErrReason
+ = NoMatchesFound
+ | CouldNotDetermineInstance
+
+data UnrepresentableTypeDescr
+ = LinearInvisibleArgument
+ | CoercionsInTypes
diff --git a/compiler/GHC/Tc/Gen/Head.hs b/compiler/GHC/Tc/Gen/Head.hs
index 8849296e7321..d683001787fe 100644
--- a/compiler/GHC/Tc/Gen/Head.hs
+++ b/compiler/GHC/Tc/Gen/Head.hs
@@ -1287,7 +1287,8 @@ checkCrossStageLifting top_lvl id (Brack _ (TcPending ps_var lie_var q))
-- bindings of the same splice proxy, but that doesn't
-- matter, although it's a mite untidy.
do { let id_ty = idType id
- ; checkTc (isTauTy id_ty) (TcRnSplicePolymorphicLocalVar id)
+ ; checkTc (isTauTy id_ty) $
+ TcRnTHError $ TypedTHError $ SplicePolymorphicLocalVar id
-- If x is polymorphic, its occurrence sites might
-- have different instantiations, so we can't use plain
-- 'x' as the splice proxy name. I don't know how to
diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs
index e28ba6f24f0f..f973d0d1dd13 100644
--- a/compiler/GHC/Tc/Gen/Splice.hs
+++ b/compiler/GHC/Tc/Gen/Splice.hs
@@ -790,7 +790,8 @@ tcPendingSplice m_var (PendingRnSplice flavour splice_name expr)
-- Takes a m and tau and returns the type m (TExp tau)
tcTExpTy :: TcType -> TcType -> TcM TcType
tcTExpTy m_ty exp_ty
- = do { unless (isTauTy exp_ty) $ addErr (TcRnTypedTHWithPolyType exp_ty)
+ = do { unless (isTauTy exp_ty) $ addErr $
+ TcRnTHError $ TypedTHError $ TypedTHWithPolyType exp_ty
; codeCon <- tcLookupTyCon codeTyConName
; let rep = getRuntimeRep exp_ty
; return (mkTyConApp codeCon [rep, m_ty, exp_ty]) }
@@ -1247,7 +1248,8 @@ runMeta' show_code ppr_hs run_and_convert expr
-- see where this splice is
do { mb_result <- run_and_convert expr_span hval
; case mb_result of
- Left err -> failWithTc (TcRnRunSpliceFailure Nothing err)
+ Left err -> failWithTc $
+ TcRnTHError $ THSpliceFailed $ RunSpliceFailure err
Right result -> do { traceTc "Got HsSyn result:" (ppr_hs result)
; return $! result } }
@@ -1262,8 +1264,8 @@ runMeta' show_code ppr_hs run_and_convert expr
fail_with_exn :: Exception e => SplicePhase -> e -> TcM a
fail_with_exn phase exn = do
exn_msg <- liftIO $ Panic.safeShowException exn
- failWithTc
- $ TcRnSpliceThrewException phase (SomeException exn) exn_msg expr show_code
+ failWithTc $ TcRnTHError $ THSpliceFailed $
+ SpliceThrewException phase (SomeException exn) exn_msg expr show_code
{-
Note [Running typed splices in the zonker]
@@ -1379,8 +1381,8 @@ instance TH.Quasi TcM where
-- 'msg' is forced to ensure exceptions don't escape,
-- see Note [Exceptions in TH]
- qReport True msg = seqList msg $ addErr $ TcRnReportCustomQuasiError True msg
- qReport False msg = seqList msg $ addDiagnostic $ TcRnReportCustomQuasiError False msg
+ qReport True msg = seqList msg $ addErr $ TcRnTHError $ ReportCustomQuasiError True msg
+ qReport False msg = seqList msg $ addDiagnostic $ TcRnTHError $ ReportCustomQuasiError False msg
qLocation :: TcM TH.Loc
qLocation = do { m <- getModule
@@ -1433,8 +1435,8 @@ instance TH.Quasi TcM where
th_origin <- getThSpliceOrigin
let either_hval = convertToHsDecls th_origin l thds
ds <- case either_hval of
- Left exn -> failWithTc
- $ TcRnRunSpliceFailure (Just "addTopDecls") exn
+ Left exn -> failWithTc $ TcRnTHError $ AddTopDeclsError $
+ AddTopDeclsRunSpliceFailure exn
Right ds -> return ds
mapM_ (checkTopDecl . unLoc) ds
th_topdecls_var <- fmap tcg_th_topdecls getGblEnv
@@ -1450,7 +1452,7 @@ instance TH.Quasi TcM where
checkTopDecl (ForD _ (ForeignImport { fd_name = L _ name }))
= bindName name
checkTopDecl d
- = addErr $ TcRnInvalidTopDecl d
+ = addErr $ TcRnTHError $ AddTopDeclsError $ InvalidTopDecl d
bindName :: RdrName -> TcM ()
bindName (Exact n)
@@ -1458,7 +1460,7 @@ instance TH.Quasi TcM where
; updTcRef th_topnames_var (\ns -> extendNameSet ns n)
}
- bindName name = addErr $ TcRnNonExactName name
+ bindName name = addErr $ TcRnTHError $ THNameError $ NonExactName name
qAddForeignFilePath lang fp = do
var <- fmap tcg_th_foreign_files getGblEnv
@@ -1476,7 +1478,7 @@ instance TH.Quasi TcM where
let dflags = hsc_dflags hsc_env
let fopts = initFinderOpts dflags
r <- liftIO $ findHomeModule fc fopts home_unit (mkModuleName plugin)
- let err = TcRnAddInvalidCorePlugin plugin
+ let err = TcRnTHError $ AddInvalidCorePlugin plugin
case r of
Found {} -> addErr err
FoundMultiple {} -> addErr err
@@ -1504,7 +1506,7 @@ instance TH.Quasi TcM where
th_doc_var <- tcg_th_docs <$> getGblEnv
resolved_doc_loc <- resolve_loc doc_loc
is_local <- checkLocalName resolved_doc_loc
- unless is_local $ failWithTc $ TcRnAddDocToNonLocalDefn doc_loc
+ unless is_local $ failWithTc $ TcRnTHError $ AddDocToNonLocalDefn doc_loc
let ds = mkGeneratedHsDocString s
hd = lexHsDoc parseIdentifier ds
hd' <- rnHsDoc hd
@@ -1588,7 +1590,7 @@ lookupThInstName th_type = do
Right (_, []) -> noMatches
where
noMatches = failWithTc $
- TcRnFailedToLookupThInstName th_type NoMatchesFound
+ TcRnTHError $ FailedToLookupThInstName th_type NoMatchesFound
-- Get the name of the class for the instance we are documenting
-- > inst_cls_name (Monad Maybe) == Monad
@@ -1625,7 +1627,7 @@ lookupThInstName th_type = do
inst_cls_name (TH.ImplicitParamT _ _) = inst_cls_name_err
inst_cls_name_err = failWithTc $
- TcRnFailedToLookupThInstName th_type CouldNotDetermineInstance
+ TcRnTHError $ FailedToLookupThInstName th_type CouldNotDetermineInstance
-- Basically does the opposite of 'mkThAppTs'
-- > inst_arg_types (Monad Maybe) == [Maybe]
@@ -1913,14 +1915,14 @@ reifyInstances' th_nm th_tys
; let matches = lookupFamInstEnv inst_envs tc tys
; traceTc "reifyInstances'2" (ppr matches)
; return $ Right (tc, map fim_instance matches) }
- _ -> bale_out $ TcRnCannotReifyInstance ty }
+ _ -> bale_out $ TcRnTHError $ THReifyError $ CannotReifyInstance ty }
where
doc = ClassInstanceCtx
bale_out msg = failWithTc msg
cvt :: Origin -> SrcSpan -> TH.Type -> TcM (LHsType GhcPs)
cvt origin loc th_ty = case convertToHsType origin loc th_ty of
- Left msg -> failWithTc (TcRnRunSpliceFailure Nothing msg)
+ Left msg -> failWithTc (TcRnTHError $ THSpliceFailed $ RunSpliceFailure msg)
Right ty -> return ty
{-
@@ -2034,10 +2036,10 @@ tcLookupTh name
notInScope :: TH.Name -> TcRnMessage
notInScope th_name =
- TcRnCannotReifyOutOfScopeThing th_name
+ TcRnTHError $ THReifyError $ CannotReifyOutOfScopeThing th_name
notInEnv :: Name -> TcRnMessage
-notInEnv name = TcRnCannotReifyThingNotInTypeEnv name
+notInEnv name = TcRnTHError $ THReifyError $ CannotReifyThingNotInTypeEnv name
------------------------------
reifyRoles :: TH.Name -> TcM [TH.Role]
@@ -2045,7 +2047,8 @@ reifyRoles th_name
= do { thing <- getThing th_name
; case thing of
AGlobal (ATyCon tc) -> return (map reify_role (tyConRoles tc))
- _ -> failWithTc (TcRnNoRolesAssociatedWithThing thing)
+ _ -> failWithTc $ TcRnTHError $ THReifyError $
+ NoRolesAssociatedWithThing thing
}
where
reify_role Nominal = TH.NominalR
@@ -2842,7 +2845,7 @@ mkThAppTs :: TH.Type -> [TH.Type] -> TH.Type
mkThAppTs fun_ty arg_tys = foldl' TH.AppT fun_ty arg_tys
noTH :: UnrepresentableTypeDescr -> Type -> TcM a
-noTH s d = failWithTc $ TcRnCannotRepresentType s d
+noTH s d = failWithTc $ TcRnTHError $ THReifyError $ CannotRepresentType s d
ppr_th :: TH.Ppr a => a -> SDoc
ppr_th x = text (TH.pprint x)
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index 0783608bd5fa..893a4fc93217 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -627,7 +627,8 @@ tc_rn_src_decls ds
{ Nothing -> return ()
; Just (SpliceDecl _ (L loc _) _, _) ->
setSrcSpanA loc $ addErr $
- TcRnUnexpectedDeclarationSplice
+ TcRnTHError $ AddTopDeclsError
+ AddTopDeclsUnexpectedDeclarationSplice
}
-- Rename TH-generated top-level declarations
; (tcg_env, th_rn_decls) <- setGblEnv tcg_env
diff --git a/compiler/GHC/Types/Error/Codes.hs b/compiler/GHC/Types/Error/Codes.hs
index 1acf21c6a935..c47c76c449b6 100644
--- a/compiler/GHC/Types/Error/Codes.hs
+++ b/compiler/GHC/Types/Error/Codes.hs
@@ -417,6 +417,7 @@ type family GhcDiagnosticCode c = n | n -> c where
GhcDiagnosticCode "TcRnFieldUpdateInvalidType" = 63055
GhcDiagnosticCode "TcRnMissingStrictFields" = 95909
GhcDiagnosticCode "TcRnStaticFormNotClosed" = 88431
+ GhcDiagnosticCode "TcRnIllegalStaticExpression" = 23800
GhcDiagnosticCode "TcRnUselessTypeable" = 90584
GhcDiagnosticCode "TcRnDerivingDefaults" = 20042
GhcDiagnosticCode "TcRnNonUnaryTypeclassConstraint" = 73993
@@ -432,8 +433,6 @@ type family GhcDiagnosticCode c = n | n -> c where
GhcDiagnosticCode "TcRnIncorrectNameSpace" = 31891
GhcDiagnosticCode "TcRnNoRebindableSyntaxRecordDot" = 65945
GhcDiagnosticCode "TcRnNoFieldPunsRecordDot" = 57365
- GhcDiagnosticCode "TcRnIllegalStaticExpression" = 23800
- GhcDiagnosticCode "TcRnIllegalStaticFormInSplice" = 12219
GhcDiagnosticCode "TcRnListComprehensionDuplicateBinding" = 81232
GhcDiagnosticCode "TcRnLastStmtNotExpr" = 55814
GhcDiagnosticCode "TcRnUnexpectedStatementInContext" = 42026
@@ -459,11 +458,9 @@ type family GhcDiagnosticCode c = n | n -> c where
GhcDiagnosticCode "TcRnExpectedValueId" = 01570
GhcDiagnosticCode "TcRnRecSelectorEscapedTyVar" = 55876
GhcDiagnosticCode "TcRnPatSynNotBidirectional" = 16444
- GhcDiagnosticCode "TcRnSplicePolymorphicLocalVar" = 06568
GhcDiagnosticCode "TcRnIllegalDerivingItem" = 11913
GhcDiagnosticCode "TcRnUnexpectedAnnotation" = 18932
GhcDiagnosticCode "TcRnIllegalRecordSyntax" = 89246
- GhcDiagnosticCode "TcRnUnexpectedTypeSplice" = 39180
GhcDiagnosticCode "TcRnInvalidVisibleKindArgument" = 20967
GhcDiagnosticCode "TcRnTooManyBinders" = 05989
GhcDiagnosticCode "TcRnDifferentNamesForTyVar" = 17370
@@ -498,19 +495,6 @@ type family GhcDiagnosticCode c = n | n -> c where
GhcDiagnosticCode "TcRnNoExplicitAssocTypeOrDefaultDeclaration" = 08585
GhcDiagnosticCode "TcRnIllegalTypeData" = 15013
GhcDiagnosticCode "TcRnTypeDataForbids" = 67297
- GhcDiagnosticCode "TcRnTypedTHWithPolyType" = 94642
- GhcDiagnosticCode "TcRnSpliceThrewException" = 87897
- GhcDiagnosticCode "TcRnInvalidTopDecl" = 52886
- GhcDiagnosticCode "TcRnNonExactName" = 77923
- GhcDiagnosticCode "TcRnAddInvalidCorePlugin" = 86463
- GhcDiagnosticCode "TcRnAddDocToNonLocalDefn" = 67760
- GhcDiagnosticCode "TcRnFailedToLookupThInstName" = 49530
- GhcDiagnosticCode "TcRnCannotReifyInstance" = 30384
- GhcDiagnosticCode "TcRnCannotReifyOutOfScopeThing" = 24922
- GhcDiagnosticCode "TcRnCannotReifyThingNotInTypeEnv" = 79890
- GhcDiagnosticCode "TcRnNoRolesAssociatedWithThing" = 65923
- GhcDiagnosticCode "TcRnCannotRepresentType" = 75721
- GhcDiagnosticCode "TcRnReportCustomQuasiError" = 39584
GhcDiagnosticCode "TcRnInterfaceLookupError" = 52243
GhcDiagnosticCode "TcRnUnsatisfiedMinimalDef" = 06201
GhcDiagnosticCode "TcRnMisplacedInstSig" = 06202
@@ -542,7 +526,6 @@ type family GhcDiagnosticCode c = n | n -> c where
GhcDiagnosticCode "TcRnIllegalMultipleDerivClauses" = 30281
GhcDiagnosticCode "TcRnNoDerivStratSpecified" = 55631
GhcDiagnosticCode "TcRnStupidThetaInGadt" = 18403
- GhcDiagnosticCode "TcRnBadImplicitSplice" = 25277
GhcDiagnosticCode "TcRnShadowedTyVarNameInFamResult" = 99412
GhcDiagnosticCode "TcRnIncorrectTyVarOnLhsOfInjCond" = 88333
GhcDiagnosticCode "TcRnUnknownTyVarsOnRhsOfInjCond" = 48254
@@ -604,7 +587,6 @@ type family GhcDiagnosticCode c = n | n -> c where
GhcDiagnosticCode "TcRnBindingNameConflict" = 10498
GhcDiagnosticCode "NonCanonicalMonoid" = 50928
GhcDiagnosticCode "NonCanonicalMonad" = 22705
- GhcDiagnosticCode "TcRnUnexpectedDeclarationSplice" = 17599
GhcDiagnosticCode "TcRnImplicitImportOfPrelude" = 20540
GhcDiagnosticCode "TcRnMissingMain" = 67120
GhcDiagnosticCode "TcRnGhciUnliftedBind" = 17999
@@ -612,11 +594,6 @@ type family GhcDiagnosticCode c = n | n -> c where
GhcDiagnosticCode "TcRnArityMismatch" = 27346
GhcDiagnosticCode "TcRnSimplifiableConstraint" = 62412
GhcDiagnosticCode "TcRnIllegalQuasiQuotes" = 77343
- GhcDiagnosticCode "TcRnMismatchedSpliceType" = 45108
- GhcDiagnosticCode "TcRnIllegalTHQuotes" = 62558
- GhcDiagnosticCode "TcRnIllegalTHSplice" = 26759
- GhcDiagnosticCode "TcRnNestedTHBrackets" = 59185
- GhcDiagnosticCode "TcRnQuotedNameWrongStage" = 57695
-- TcRnTypeApplicationsDisabled
GhcDiagnosticCode "TypeApplication" = 23482
@@ -814,6 +791,30 @@ type family GhcDiagnosticCode c = n | n -> c where
GhcDiagnosticCode "BootMismatchedIdTypes" = 11890
GhcDiagnosticCode "BootMismatchedTyCons" = 15843
+ -- TH errors
+ GhcDiagnosticCode "TypedTHWithPolyType" = 94642
+ GhcDiagnosticCode "SplicePolymorphicLocalVar" = 06568
+ GhcDiagnosticCode "SpliceThrewException" = 87897
+ GhcDiagnosticCode "InvalidTopDecl" = 52886
+ GhcDiagnosticCode "NonExactName" = 77923
+ GhcDiagnosticCode "AddInvalidCorePlugin" = 86463
+ GhcDiagnosticCode "AddDocToNonLocalDefn" = 67760
+ GhcDiagnosticCode "FailedToLookupThInstName" = 49530
+ GhcDiagnosticCode "CannotReifyInstance" = 30384
+ GhcDiagnosticCode "CannotReifyOutOfScopeThing" = 24922
+ GhcDiagnosticCode "CannotReifyThingNotInTypeEnv" = 79890
+ GhcDiagnosticCode "NoRolesAssociatedWithThing" = 65923
+ GhcDiagnosticCode "CannotRepresentType" = 75721
+ GhcDiagnosticCode "ReportCustomQuasiError" = 39584
+ GhcDiagnosticCode "MismatchedSpliceType" = 45108
+ GhcDiagnosticCode "IllegalTHQuotes" = 62558
+ GhcDiagnosticCode "IllegalTHSplice" = 26759
+ GhcDiagnosticCode "NestedTHBrackets" = 59185
+ GhcDiagnosticCode "AddTopDeclsUnexpectedDeclarationSplice" = 17599
+ GhcDiagnosticCode "BadImplicitSplice" = 25277
+ GhcDiagnosticCode "QuotedNameWrongStage" = 57695
+ GhcDiagnosticCode "IllegalStaticFormInSplice" = 12219
+
-- To generate new random numbers:
-- https://www.random.org/integers/?num=10&min=1&max=99999&col=1&base=10&format=plain
--
@@ -827,6 +828,7 @@ type family GhcDiagnosticCode c = n | n -> c where
GhcDiagnosticCode "TcRnMixedSelectors" = 40887
GhcDiagnosticCode "TcRnBadBootFamInstDecl" = 06203
GhcDiagnosticCode "TcRnBindInBootFile" = 11247
+ GhcDiagnosticCode "TcRnUnexpectedTypeSplice" = 39180
{- *********************************************************************
* *
@@ -912,9 +914,16 @@ type family ConRecursInto con where
--
-- TH errors
-
- ConRecursInto "TcRnRunSpliceFailure" = 'Just RunSpliceFailReason
- ConRecursInto "ConversionFail" = 'Just ConversionFailReason
+ ConRecursInto "TcRnTHError" = 'Just THError
+ ConRecursInto "THSyntaxError" = 'Just THSyntaxError
+ ConRecursInto "THNameError" = 'Just THNameError
+ ConRecursInto "THReifyError" = 'Just THReifyError
+ ConRecursInto "TypedTHError" = 'Just TypedTHError
+ ConRecursInto "THSpliceFailed" = 'Just SpliceFailReason
+ ConRecursInto "RunSpliceFailure" = 'Just RunSpliceFailReason
+ ConRecursInto "ConversionFail" = 'Just ConversionFailReason
+ ConRecursInto "AddTopDeclsError" = 'Just AddTopDeclsError
+ ConRecursInto "AddTopDeclsRunSpliceFailure" = 'Just RunSpliceFailReason
-- Interface file errors
diff --git a/testsuite/tests/parser/should_fail/T18251e.stderr b/testsuite/tests/parser/should_fail/T18251e.stderr
index 7b869c09c8bc..a22c71f6cc0f 100644
--- a/testsuite/tests/parser/should_fail/T18251e.stderr
+++ b/testsuite/tests/parser/should_fail/T18251e.stderr
@@ -1,5 +1,6 @@
-T18251e.hs:3:5: error:
+T18251e.hs:3:5: error: [GHC-62558]
• Syntax error on [| id |]
- Perhaps you intended to use TemplateHaskell or TemplateHaskellQuotes
• In the Template Haskell quotation [| id |]
+ Suggested fix:
+ Enable any of the following extensions: TemplateHaskell, TemplateHaskellQuotes
diff --git a/testsuite/tests/quotes/TH_double_splice.stderr b/testsuite/tests/quotes/TH_double_splice.stderr
index 34cb933a1d17..4a6f6da4d5c4 100644
--- a/testsuite/tests/quotes/TH_double_splice.stderr
+++ b/testsuite/tests/quotes/TH_double_splice.stderr
@@ -1,7 +1,8 @@
-TH_double_splice.hs:6:12: error:
- • Top-level splices are not permitted without TemplateHaskell
+TH_double_splice.hs:6:12: error: [GHC-26759]
+ • Unexpected top-level splice.
• In the untyped splice: $(error "should not happen")
In the untyped splice: $($(error "should not happen"))
In the Template Haskell quotation
[| $($(error "should not happen")) |]
+ Suggested fix: Perhaps you intended to use TemplateHaskell
diff --git a/testsuite/tests/quotes/TH_top_splice.stderr b/testsuite/tests/quotes/TH_top_splice.stderr
index 8ca30c24264d..cfb46e109c2a 100644
--- a/testsuite/tests/quotes/TH_top_splice.stderr
+++ b/testsuite/tests/quotes/TH_top_splice.stderr
@@ -1,4 +1,5 @@
-TH_top_splice.hs:6:7: error:
- • Top-level splices are not permitted without TemplateHaskell
+TH_top_splice.hs:6:7: error: [GHC-26759]
+ • Unexpected top-level splice.
• In the untyped splice: $([| 1 |])
+ Suggested fix: Perhaps you intended to use TemplateHaskell
diff --git a/testsuite/tests/quotes/TTH_top_splice.stderr b/testsuite/tests/quotes/TTH_top_splice.stderr
index ef659c21d870..4914223a5ce6 100644
--- a/testsuite/tests/quotes/TTH_top_splice.stderr
+++ b/testsuite/tests/quotes/TTH_top_splice.stderr
@@ -1,4 +1,5 @@
-TTH_top_splice.hs:6:7: error:
- • Top-level splices are not permitted without TemplateHaskell
+TTH_top_splice.hs:6:7: error: [GHC-26759]
+ • Unexpected top-level splice.
• In the typed splice: $$([|| 1 ||])
+ Suggested fix: Perhaps you intended to use TemplateHaskell
diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang12.stderr b/testsuite/tests/safeHaskell/safeLanguage/SafeLang12.stderr
index ce72d25d862e..109653a80c7e 100644
--- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang12.stderr
+++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang12.stderr
@@ -8,5 +8,6 @@ SafeLang12_B.hs:3:14: warning: [GHC-98887]
[2 of 4] Compiling SafeLang12_B ( SafeLang12_B.hs, SafeLang12_B.o )
[3 of 4] Compiling Main ( SafeLang12.hs, SafeLang12.o )
-SafeLang12.hs:1:1: error:
- Top-level splices are not permitted without TemplateHaskell
+SafeLang12.hs:1:1: error: [GHC-26759]
+ Unexpected top-level splice.
+ Suggested fix: Perhaps you intended to use TemplateHaskell
diff --git a/testsuite/tests/showIface/should_fail/THPutDocExternal.stderr b/testsuite/tests/showIface/should_fail/THPutDocExternal.stderr
index 135a9faa8210..563e42d6f831 100644
--- a/testsuite/tests/showIface/should_fail/THPutDocExternal.stderr
+++ b/testsuite/tests/showIface/should_fail/THPutDocExternal.stderr
@@ -1,3 +1,3 @@
THPutDocExternal.hs:8:1: error: [GHC-67760]
- Can't add documentation to THPutDocExternalA.f as it isn't inside the current module
+ Can't add documentation to THPutDocExternalA.f, as it isn't inside the current module.
diff --git a/testsuite/tests/th/T16976z.stderr b/testsuite/tests/th/T16976z.stderr
index 2bcb6421141c..d0f23f4ca954 100644
--- a/testsuite/tests/th/T16976z.stderr
+++ b/testsuite/tests/th/T16976z.stderr
@@ -1,5 +1,5 @@
-T16976z.hs:7:20: error:
+T16976z.hs:7:20: error: [GHC-57695]
• Stage error: the non-top-level quoted name 'str
- must be used at the same stage at which it is bound
+ must be used at the same stage at which it is bound.
• In the Template Haskell quotation 'str
diff --git a/testsuite/tests/th/TH_invalid_add_top_decl.stderr b/testsuite/tests/th/TH_invalid_add_top_decl.stderr
index 84e56a275b14..47acdac18ab3 100644
--- a/testsuite/tests/th/TH_invalid_add_top_decl.stderr
+++ b/testsuite/tests/th/TH_invalid_add_top_decl.stderr
@@ -1,5 +1,5 @@
TH_invalid_add_top_decl.hs:5:2: error: [GHC-34949]
- Error in a declaration passed to addTopDecls:
+ Error in a declaration passed to ‘addTopDecls’:
Empty stmt list in do-block
When splicing a TH declaration: emptyDo = do
--
GitLab