summaryrefslogtreecommitdiff
path: root/compiler/GHC/Tc/Errors
diff options
context:
space:
mode:
authorAlfredo Di Napoli <alfredo@well-typed.com>2021-09-20 15:51:21 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-10-05 14:34:04 -0400
commitac275f4237f1e4030c8b7b9e81e2d563e6903a81 (patch)
tree25786972e31bb6490b0558ee07d257d3135f3cb7 /compiler/GHC/Tc/Errors
parentf52df067d288a023c52c4387841fe12a37bd1263 (diff)
downloadhaskell-ac275f4237f1e4030c8b7b9e81e2d563e6903a81.tar.gz
Eradicate TcRnUnknownMessage from GHC.Tc.Deriv
This (big) commit finishes porting the GHC.Tc.Deriv module to support the new diagnostic infrastructure (#18516) by getting rid of the legacy calls to `TcRnUnknownMessage`. This work ended up being quite pervasive and touched not only the Tc.Deriv module but also the Tc.Deriv.Utils and Tc.Deriv.Generics module, which needed to be adapted to use the new infrastructure. This also required generalising `Validity`. More specifically, this is a breakdown of the work done: * Add and use the TcRnUselessTypeable data constructor * Add and use TcRnDerivingDefaults data constructor * Add and use the TcRnNonUnaryTypeclassConstraint data constructor * Add and use TcRnPartialTypeSignatures * Add T13324_compile2 test to test another part of the TcRnPartialTypeSignatures diagnostic * Add and use TcRnCannotDeriveInstance data constructor, which introduces a new data constructor to TcRnMessage called TcRnCannotDeriveInstance, which is further sub-divided to carry a `DeriveInstanceErrReason` which explains the reason why we couldn't derive a typeclass instance. * Add DerivErrSafeHaskellGenericInst data constructor to DeriveInstanceErrReason * Add DerivErrDerivingViaWrongKind and DerivErrNoEtaReduce * Introduce the SuggestExtensionInOrderTo Hint, which adds (and use) a new constructor to the hint type `LanguageExtensionHint` called `SuggestExtensionInOrderTo`, which can be used to give a bit more "firm" recommendations when it's obvious what the required extension is, like in the case for the `DerivingStrategies`, which automatically follows from having enabled both `DeriveAnyClass` and `GeneralizedNewtypeDeriving`. * Wildcard-free pattern matching in mk_eqn_stock, which removes `_` in favour of pattern matching explicitly on `CanDeriveAnyClass` and `NonDerivableClass`, because that determine whether or not we can suggest to the user `DeriveAnyClass` or not.
Diffstat (limited to 'compiler/GHC/Tc/Errors')
-rw-r--r--compiler/GHC/Tc/Errors/Ppr.hs377
-rw-r--r--compiler/GHC/Tc/Errors/Types.hs324
2 files changed, 697 insertions, 4 deletions
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 6975eeb9d3..bde384887a 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -9,17 +9,24 @@ module GHC.Tc.Errors.Ppr (
import GHC.Prelude
+import Data.Maybe (isJust)
+
+import GHC.Builtin.Names
import GHC.Core.Class (Class(..))
import GHC.Core.Coercion (pprCoAxBranchUser)
import GHC.Core.Coercion.Axiom (coAxiomTyCon, coAxiomSingleBranch)
+import GHC.Core.DataCon (DataCon)
import GHC.Core.FamInstEnv (famInstAxiom)
import GHC.Core.InstEnv
-import GHC.Core.TyCo.Ppr (pprKind, pprParendType, pprType, pprWithTYPE, pprWithExplicitKindsWhen)
+import GHC.Core.TyCon (isNewTyCon)
+import GHC.Core.TyCo.Ppr (pprKind, pprParendType, pprType, pprWithTYPE,
+ pprWithExplicitKindsWhen, pprTheta, pprClassPred, pprTypeApp,
+ pprSourceTyCon)
import GHC.Core.Type
import GHC.Data.Bag
import GHC.Tc.Errors.Types
import GHC.Tc.Types.Rank (Rank(..))
-import GHC.Tc.Utils.TcType (TcType, tcSplitForAllTyVars)
+import GHC.Tc.Utils.TcType (TcType, tcSplitForAllTyVars, mkClassPred)
import GHC.Types.Error
import GHC.Types.FieldLabel (FieldLabelString, flIsOverloaded, flSelector)
import GHC.Types.Id (isRecordSelector)
@@ -31,8 +38,8 @@ import GHC.Types.Var.Env (emptyTidyEnv)
import GHC.Types.Var.Set (pprVarSet, pluralVarSet)
import GHC.Driver.Flags
import GHC.Hs
-import GHC.Utils.Outputable
import GHC.Utils.Misc (capitalise)
+import GHC.Utils.Outputable
import GHC.Unit.State (pprWithUnitState, UnitState)
import qualified GHC.LanguageExtensions as LangExt
import qualified Data.List.NonEmpty as NE
@@ -471,6 +478,29 @@ instance Diagnostic TcRnMessage where
NotClosed _ _ -> msg : causes reason
_ -> let (xs0, xs1) = splitAt 1 $ causes reason
in fmap (msg <+>) xs0 ++ xs1
+ TcRnUselessTypeable
+ -> mkSimpleDecorated $
+ text "Deriving" <+> quotes (ppr typeableClassName) <+>
+ text "has no effect: all types now auto-derive Typeable"
+ TcRnDerivingDefaults cls
+ -> mkSimpleDecorated $ sep
+ [ text "Both DeriveAnyClass and"
+ <+> text "GeneralizedNewtypeDeriving are enabled"
+ , text "Defaulting to the DeriveAnyClass strategy"
+ <+> text "for instantiating" <+> ppr cls
+ ]
+ TcRnNonUnaryTypeclassConstraint ct
+ -> mkSimpleDecorated $
+ quotes (ppr ct)
+ <+> text "is not a unary constraint, as expected by a deriving clause"
+ TcRnPartialTypeSignatures _ theta
+ -> mkSimpleDecorated $
+ text "Found type wildcard" <+> quotes (char '_')
+ <+> text "standing for" <+> quotes (pprTheta theta)
+ TcRnCannotDeriveInstance cls cls_tys mb_strat newtype_deriving reason
+ -> mkSimpleDecorated $
+ derivErrDiagnosticMessage cls cls_tys mb_strat newtype_deriving True reason
+
diagnosticReason = \case
TcRnUnknownMessage m
@@ -644,6 +674,43 @@ instance Diagnostic TcRnMessage where
-> ErrorWithoutFlag
TcRnStaticFormNotClosed{}
-> ErrorWithoutFlag
+ TcRnUselessTypeable
+ -> WarningWithFlag Opt_WarnDerivingTypeable
+ TcRnDerivingDefaults{}
+ -> WarningWithFlag Opt_WarnDerivingDefaults
+ TcRnNonUnaryTypeclassConstraint{}
+ -> ErrorWithoutFlag
+ TcRnPartialTypeSignatures{}
+ -> WarningWithFlag Opt_WarnPartialTypeSignatures
+ TcRnCannotDeriveInstance _ _ _ _ rea
+ -> case rea of
+ DerivErrNotWellKinded{} -> ErrorWithoutFlag
+ DerivErrSafeHaskellGenericInst -> ErrorWithoutFlag
+ DerivErrDerivingViaWrongKind{} -> ErrorWithoutFlag
+ DerivErrNoEtaReduce{} -> ErrorWithoutFlag
+ DerivErrBootFileFound -> ErrorWithoutFlag
+ DerivErrDataConsNotAllInScope{} -> ErrorWithoutFlag
+ DerivErrGNDUsedOnData -> ErrorWithoutFlag
+ DerivErrNullaryClasses -> ErrorWithoutFlag
+ DerivErrLastArgMustBeApp -> ErrorWithoutFlag
+ DerivErrNoFamilyInstance{} -> ErrorWithoutFlag
+ DerivErrNotStockDeriveable{} -> ErrorWithoutFlag
+ DerivErrHasAssociatedDatatypes{} -> ErrorWithoutFlag
+ DerivErrNewtypeNonDeriveableClass -> ErrorWithoutFlag
+ DerivErrCannotEtaReduceEnough{} -> ErrorWithoutFlag
+ DerivErrOnlyAnyClassDeriveable{} -> ErrorWithoutFlag
+ DerivErrNotDeriveable{} -> ErrorWithoutFlag
+ DerivErrNotAClass{} -> ErrorWithoutFlag
+ DerivErrNoConstructors{} -> ErrorWithoutFlag
+ DerivErrLangExtRequired{} -> ErrorWithoutFlag
+ DerivErrDunnoHowToDeriveForType{} -> ErrorWithoutFlag
+ DerivErrMustBeEnumType{} -> ErrorWithoutFlag
+ DerivErrMustHaveExactlyOneConstructor{} -> ErrorWithoutFlag
+ DerivErrMustHaveSomeParameters{} -> ErrorWithoutFlag
+ DerivErrMustNotHaveClassContext{} -> ErrorWithoutFlag
+ DerivErrBadConstructor{} -> ErrorWithoutFlag
+ DerivErrGenerics{} -> ErrorWithoutFlag
+ DerivErrEnumOrProduct{} -> ErrorWithoutFlag
diagnosticHints = \case
TcRnUnknownMessage m
@@ -833,6 +900,103 @@ instance Diagnostic TcRnMessage where
-> noHints
TcRnStaticFormNotClosed{}
-> noHints
+ TcRnUselessTypeable
+ -> noHints
+ TcRnDerivingDefaults{}
+ -> [useDerivingStrategies]
+ TcRnNonUnaryTypeclassConstraint{}
+ -> noHints
+ TcRnPartialTypeSignatures suggestParSig _
+ -> case suggestParSig of
+ YesSuggestPartialTypeSignatures
+ -> let info = text "to use the inferred type"
+ in [suggestExtensionWithInfo info LangExt.PartialTypeSignatures]
+ NoSuggestPartialTypeSignatures
+ -> noHints
+ TcRnCannotDeriveInstance cls _ _ newtype_deriving rea
+ -> deriveInstanceErrReasonHints cls newtype_deriving rea
+
+
+deriveInstanceErrReasonHints :: Class
+ -> UsingGeneralizedNewtypeDeriving
+ -> DeriveInstanceErrReason
+ -> [GhcHint]
+deriveInstanceErrReasonHints cls newtype_deriving = \case
+ DerivErrNotWellKinded _ _ n_args_to_keep
+ | cls `hasKey` gen1ClassKey && n_args_to_keep >= 0
+ -> [suggestExtension LangExt.PolyKinds]
+ | otherwise
+ -> noHints
+ DerivErrSafeHaskellGenericInst -> noHints
+ DerivErrDerivingViaWrongKind{} -> noHints
+ DerivErrNoEtaReduce{} -> noHints
+ DerivErrBootFileFound -> noHints
+ DerivErrDataConsNotAllInScope{} -> noHints
+ DerivErrGNDUsedOnData -> noHints
+ DerivErrNullaryClasses -> noHints
+ DerivErrLastArgMustBeApp -> noHints
+ DerivErrNoFamilyInstance{} -> noHints
+ DerivErrNotStockDeriveable deriveAnyClassEnabled
+ | deriveAnyClassEnabled == NoDeriveAnyClassEnabled
+ -> [suggestExtension LangExt.DeriveAnyClass]
+ | otherwise
+ -> noHints
+ DerivErrHasAssociatedDatatypes{}
+ -> noHints
+ DerivErrNewtypeNonDeriveableClass
+ | newtype_deriving == NoGeneralizedNewtypeDeriving
+ -> [useGND]
+ | otherwise
+ -> noHints
+ DerivErrCannotEtaReduceEnough{}
+ | newtype_deriving == NoGeneralizedNewtypeDeriving
+ -> [useGND]
+ | otherwise
+ -> noHints
+ DerivErrOnlyAnyClassDeriveable _ deriveAnyClassEnabled
+ | deriveAnyClassEnabled == NoDeriveAnyClassEnabled
+ -> [suggestExtension LangExt.DeriveAnyClass]
+ | otherwise
+ -> noHints
+ DerivErrNotDeriveable deriveAnyClassEnabled
+ | deriveAnyClassEnabled == NoDeriveAnyClassEnabled
+ -> [suggestExtension LangExt.DeriveAnyClass]
+ | otherwise
+ -> noHints
+ DerivErrNotAClass{}
+ -> noHints
+ DerivErrNoConstructors{}
+ -> let info = text "to enable deriving for empty data types"
+ in [useExtensionInOrderTo info LangExt.EmptyDataDeriving]
+ DerivErrLangExtRequired{}
+ -- This is a slightly weird corner case of GHC: we are failing
+ -- to derive a typeclass instance because a particular 'Extension'
+ -- is not enabled (and so we report in the main error), but here
+ -- we don't want to /repeat/ to enable the extension in the hint.
+ -> noHints
+ DerivErrDunnoHowToDeriveForType{}
+ -> noHints
+ DerivErrMustBeEnumType rep_tc
+ -- We want to suggest GND only if this /is/ a newtype.
+ | newtype_deriving == NoGeneralizedNewtypeDeriving && isNewTyCon rep_tc
+ -> [useGND]
+ | otherwise
+ -> noHints
+ DerivErrMustHaveExactlyOneConstructor{}
+ -> noHints
+ DerivErrMustHaveSomeParameters{}
+ -> noHints
+ DerivErrMustNotHaveClassContext{}
+ -> noHints
+ DerivErrBadConstructor wcard _
+ -> case wcard of
+ Nothing -> noHints
+ Just YesHasWildcard -> [SuggestFillInWildcardConstraint]
+ Just NoHasWildcard -> [SuggestAddStandaloneDerivation]
+ DerivErrGenerics{}
+ -> noHints
+ DerivErrEnumOrProduct{}
+ -> noHints
messageWithInfoDiagnosticMessage :: UnitState
-> ErrInfo
@@ -919,3 +1083,210 @@ formatExportItemError exportedThing reason =
hsep [ text "The export item"
, quotes exportedThing
, text reason ]
+
+useDerivingStrategies :: GhcHint
+useDerivingStrategies =
+ useExtensionInOrderTo (text "to pick a different strategy") LangExt.DerivingStrategies
+
+useGND :: GhcHint
+useGND = let info = text "for GHC's" <+> text "newtype-deriving extension"
+ in suggestExtensionWithInfo info LangExt.GeneralizedNewtypeDeriving
+
+cannotMakeDerivedInstanceHerald :: Class
+ -> [Type]
+ -> Maybe (DerivStrategy GhcTc)
+ -> UsingGeneralizedNewtypeDeriving
+ -> Bool -- ^ If False, only prints the why.
+ -> SDoc
+ -> SDoc
+cannotMakeDerivedInstanceHerald cls cls_args mb_strat newtype_deriving pprHerald why =
+ if pprHerald
+ then sep [(hang (text "Can't make a derived instance of")
+ 2 (quotes (ppr pred) <+> via_mechanism)
+ $$ nest 2 extra) <> colon,
+ nest 2 why]
+ else why
+ where
+ strat_used = isJust mb_strat
+ extra | not strat_used, (newtype_deriving == YesGeneralizedNewtypeDeriving)
+ = text "(even with cunning GeneralizedNewtypeDeriving)"
+ | otherwise = empty
+ pred = mkClassPred cls cls_args
+ via_mechanism | strat_used
+ , Just strat <- mb_strat
+ = text "with the" <+> (derivStrategyName strat) <+> text "strategy"
+ | otherwise
+ = empty
+
+badCon :: DataCon -> SDoc -> SDoc
+badCon con msg = text "Constructor" <+> quotes (ppr con) <+> msg
+
+derivErrDiagnosticMessage :: Class
+ -> [Type]
+ -> Maybe (DerivStrategy GhcTc)
+ -> UsingGeneralizedNewtypeDeriving
+ -> Bool -- If True, includes the herald \"can't make a derived..\"
+ -> DeriveInstanceErrReason
+ -> SDoc
+derivErrDiagnosticMessage cls cls_tys mb_strat newtype_deriving pprHerald = \case
+ DerivErrNotWellKinded tc cls_kind _
+ -> sep [ hang (text "Cannot derive well-kinded instance of form"
+ <+> quotes (pprClassPred cls cls_tys
+ <+> parens (ppr tc <+> text "...")))
+ 2 empty
+ , nest 2 (text "Class" <+> quotes (ppr cls)
+ <+> text "expects an argument of kind"
+ <+> quotes (pprKind cls_kind))
+ ]
+ DerivErrSafeHaskellGenericInst
+ -> text "Generic instances can only be derived in"
+ <+> text "Safe Haskell using the stock strategy."
+ DerivErrDerivingViaWrongKind cls_kind via_ty via_kind
+ -> hang (text "Cannot derive instance via" <+> quotes (pprType via_ty))
+ 2 (text "Class" <+> quotes (ppr cls)
+ <+> text "expects an argument of kind"
+ <+> quotes (pprKind cls_kind) <> char ','
+ $+$ text "but" <+> quotes (pprType via_ty)
+ <+> text "has kind" <+> quotes (pprKind via_kind))
+ DerivErrNoEtaReduce inst_ty
+ -> sep [text "Cannot eta-reduce to an instance of form",
+ nest 2 (text "instance (...) =>"
+ <+> pprClassPred cls (cls_tys ++ [inst_ty]))]
+ DerivErrBootFileFound
+ -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald
+ (text "Cannot derive instances in hs-boot files"
+ $+$ text "Write an instance declaration instead")
+ DerivErrDataConsNotAllInScope tc
+ -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald
+ (hang (text "The data constructors of" <+> quotes (ppr tc) <+> text "are not all in scope")
+ 2 (text "so you cannot derive an instance for it"))
+ DerivErrGNDUsedOnData
+ -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald
+ (text "GeneralizedNewtypeDeriving cannot be used on non-newtypes")
+ DerivErrNullaryClasses
+ -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald
+ (text "Cannot derive instances for nullary classes")
+ DerivErrLastArgMustBeApp
+ -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald
+ ( text "The last argument of the instance must be a"
+ <+> text "data or newtype application")
+ DerivErrNoFamilyInstance tc tc_args
+ -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald
+ (text "No family instance for" <+> quotes (pprTypeApp tc tc_args))
+ DerivErrNotStockDeriveable _
+ -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald
+ (quotes (ppr cls) <+> text "is not a stock derivable class (Eq, Show, etc.)")
+ DerivErrHasAssociatedDatatypes hasAdfs at_last_cls_tv_in_kinds at_without_last_cls_tv
+ -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald
+ $ vcat [ ppWhen (hasAdfs == YesHasAdfs) adfs_msg
+ , case at_without_last_cls_tv of
+ YesAssociatedTyNotParamOverLastTyVar tc -> at_without_last_cls_tv_msg tc
+ NoAssociatedTyNotParamOverLastTyVar -> empty
+ , case at_last_cls_tv_in_kinds of
+ YesAssocTyLastVarInKind tc -> at_last_cls_tv_in_kinds_msg tc
+ NoAssocTyLastVarInKind -> empty
+ ]
+ where
+
+ adfs_msg = text "the class has associated data types"
+
+ at_without_last_cls_tv_msg at_tc = hang
+ (text "the associated type" <+> quotes (ppr at_tc)
+ <+> text "is not parameterized over the last type variable")
+ 2 (text "of the class" <+> quotes (ppr cls))
+
+ at_last_cls_tv_in_kinds_msg at_tc = hang
+ (text "the associated type" <+> quotes (ppr at_tc)
+ <+> text "contains the last type variable")
+ 2 (text "of the class" <+> quotes (ppr cls)
+ <+> text "in a kind, which is not (yet) allowed")
+ DerivErrNewtypeNonDeriveableClass
+ -> derivErrDiagnosticMessage cls cls_tys mb_strat newtype_deriving pprHerald (DerivErrNotStockDeriveable NoDeriveAnyClassEnabled)
+ DerivErrCannotEtaReduceEnough eta_ok
+ -> let cant_derive_err = ppUnless eta_ok eta_msg
+ eta_msg = text "cannot eta-reduce the representation type enough"
+ in cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald
+ cant_derive_err
+ DerivErrOnlyAnyClassDeriveable tc _
+ -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald
+ (quotes (ppr tc) <+> text "is a type class,"
+ <+> text "and can only have a derived instance"
+ $+$ text "if DeriveAnyClass is enabled")
+ DerivErrNotDeriveable _
+ -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald empty
+ DerivErrNotAClass predType
+ -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald
+ (quotes (ppr predType) <+> text "is not a class")
+ DerivErrNoConstructors rep_tc
+ -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald
+ (quotes (pprSourceTyCon rep_tc) <+> text "must have at least one data constructor")
+ DerivErrLangExtRequired ext
+ -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald
+ (text "You need " <> ppr ext
+ <+> text "to derive an instance for this class")
+ DerivErrDunnoHowToDeriveForType ty
+ -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald
+ (hang (text "Don't know how to derive" <+> quotes (ppr cls))
+ 2 (text "for type" <+> quotes (ppr ty)))
+ DerivErrMustBeEnumType rep_tc
+ -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald
+ (sep [ quotes (pprSourceTyCon rep_tc) <+>
+ text "must be an enumeration type"
+ , text "(an enumeration consists of one or more nullary, non-GADT constructors)" ])
+
+ DerivErrMustHaveExactlyOneConstructor rep_tc
+ -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald
+ (quotes (pprSourceTyCon rep_tc) <+> text "must have precisely one constructor")
+ DerivErrMustHaveSomeParameters rep_tc
+ -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald
+ (text "Data type" <+> quotes (ppr rep_tc) <+> text "must have some type parameters")
+ DerivErrMustNotHaveClassContext rep_tc bad_stupid_theta
+ -> cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald
+ (text "Data type" <+> quotes (ppr rep_tc)
+ <+> text "must not have a class context:" <+> pprTheta bad_stupid_theta)
+ DerivErrBadConstructor _ reasons
+ -> let why = vcat $ map renderReason reasons
+ in cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald why
+ where
+ renderReason = \case
+ DerivErrBadConExistential con
+ -> badCon con $ text "must be truly polymorphic in the last argument of the data type"
+ DerivErrBadConCovariant con
+ -> badCon con $ text "must not use the type variable in a function argument"
+ DerivErrBadConFunTypes con
+ -> badCon con $ text "must not contain function types"
+ DerivErrBadConWrongArg con
+ -> badCon con $ text "must use the type variable only as the last argument of a data type"
+ DerivErrBadConIsGADT con
+ -> badCon con $ text "is a GADT"
+ DerivErrBadConHasExistentials con
+ -> badCon con $ text "has existential type variables in its type"
+ DerivErrBadConHasConstraints con
+ -> badCon con $ text "has constraints in its type"
+ DerivErrBadConHasHigherRankType con
+ -> badCon con $ text "has a higher-rank type"
+ DerivErrGenerics reasons
+ -> let why = vcat $ map renderReason reasons
+ in cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald why
+ where
+ renderReason = \case
+ DerivErrGenericsMustNotHaveDatatypeContext tc_name
+ -> ppr tc_name <+> text "must not have a datatype context"
+ DerivErrGenericsMustNotHaveExoticArgs dc
+ -> ppr dc <+> text "must not have exotic unlifted or polymorphic arguments"
+ DerivErrGenericsMustBeVanillaDataCon dc
+ -> ppr dc <+> text "must be a vanilla data constructor"
+ DerivErrGenericsMustHaveSomeTypeParams rep_tc
+ -> text "Data type" <+> quotes (ppr rep_tc)
+ <+> text "must have some type parameters"
+ DerivErrGenericsMustNotHaveExistentials con
+ -> badCon con $ text "must not have existential arguments"
+ DerivErrGenericsWrongArgKind con
+ -> badCon con $
+ text "applies a type to an argument involving the last parameter"
+ $$ text "but the applied type is not of kind * -> *"
+ DerivErrEnumOrProduct this that
+ -> let ppr1 = derivErrDiagnosticMessage cls cls_tys mb_strat newtype_deriving False this
+ ppr2 = derivErrDiagnosticMessage cls cls_tys mb_strat newtype_deriving False that
+ in cannotMakeDerivedInstanceHerald cls cls_tys mb_strat newtype_deriving pprHerald
+ (ppr1 $$ text " or" $$ ppr2)
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index 7bcd83c98c..a7418e7e58 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -13,6 +13,23 @@ module GHC.Tc.Errors.Types (
, SuggestUndecidableInstances(..)
, suggestUndecidableInstances
, NotClosedReason(..)
+ , SuggestPartialTypeSignatures(..)
+ , suggestPartialTypeSignatures
+ , DeriveInstanceErrReason(..)
+ , UsingGeneralizedNewtypeDeriving(..)
+ , usingGeneralizedNewtypeDeriving
+ , DeriveAnyClassEnabled(..)
+ , deriveAnyClassEnabled
+ , DeriveInstanceBadConstructor(..)
+ , HasWildcard(..)
+ , hasWildcard
+ , DeriveGenericsErrReason(..)
+ , HasAssociatedDataFamInsts(..)
+ , hasAssociatedDataFamInsts
+ , AssociatedTyLastVarInKind(..)
+ , associatedTyLastVarInKind
+ , AssociatedTyNotParamOverLastTyVar(..)
+ , associatedTyNotParamOverLastTyVar
) where
import GHC.Prelude
@@ -35,13 +52,15 @@ import GHC.Utils.Outputable
import GHC.Core.Class (Class)
import GHC.Core.Coercion.Axiom (CoAxBranch)
import GHC.Core.ConLike (ConLike)
+import GHC.Core.DataCon (DataCon)
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.Type (Kind, Type, Var, ThetaType, PredType)
import GHC.Unit.State (UnitState)
import GHC.Unit.Module.Name (ModuleName)
import GHC.Types.Basic
+import qualified GHC.LanguageExtensions as LangExt
import qualified Data.List.NonEmpty as NE
import Data.Typeable hiding (TyCon)
@@ -1231,6 +1250,129 @@ data TcRnMessage where
-}
TcRnStaticFormNotClosed :: Name -> NotClosedReason -> TcRnMessage
+ {-| TcRnUselessTypeable is a warning (controlled by -Wderiving-typeable) that
+ occurs when trying to derive an instance of the 'Typeable' class. Deriving
+ 'Typeable' is no longer necessary (hence the \"useless\") as all types
+ automatically derive 'Typeable' in modern GHC versions.
+
+ Example(s): None.
+
+ Test cases: warnings/should_compile/DerivingTypeable
+ -}
+ TcRnUselessTypeable :: TcRnMessage
+
+ {-| TcRnDerivingDefaults is a warning (controlled by -Wderiving-defaults) that
+ occurs when both 'DeriveAnyClass' and 'GeneralizedNewtypeDeriving' are
+ enabled, and therefore GHC defaults to 'DeriveAnyClass', which might not
+ be what the user wants.
+
+ Example(s): None.
+
+ Test cases: typecheck/should_compile/T15839a
+ deriving/should_compile/T16179
+ -}
+ TcRnDerivingDefaults :: !Class -> TcRnMessage
+
+ {-| TcRnNonUnaryTypeclassConstraint is an error that occurs when GHC
+ encounters a non-unary constraint when trying to derive a typeclass.
+
+ Example(s):
+ class A
+ deriving instance A
+ data B deriving A -- We cannot derive A, is not unary (i.e. 'class A a').
+
+ Test cases: deriving/should_fail/T7959
+ deriving/should_fail/drvfail005
+ deriving/should_fail/drvfail009
+ deriving/should_fail/drvfail006
+ -}
+ TcRnNonUnaryTypeclassConstraint :: !(LHsSigType GhcRn) -> TcRnMessage
+
+ {-| TcRnPartialTypeSignatures is a warning (controlled by -Wpartial-type-signatures)
+ that occurs when a wildcard '_' is found in place of a type in a signature or a
+ type class derivation
+
+ Example(s):
+ foo :: _ -> Int
+ foo = ...
+
+ deriving instance _ => Eq (Foo a)
+
+ Test cases: dependent/should_compile/T11241
+ dependent/should_compile/T15076
+ dependent/should_compile/T14880-2
+ typecheck/should_compile/T17024
+ typecheck/should_compile/T10072
+ partial-sigs/should_fail/TidyClash2
+ partial-sigs/should_fail/Defaulting1MROff
+ partial-sigs/should_fail/WildcardsInPatternAndExprSig
+ partial-sigs/should_fail/T10615
+ partial-sigs/should_fail/T14584a
+ partial-sigs/should_fail/TidyClash
+ partial-sigs/should_fail/T11122
+ partial-sigs/should_fail/T14584
+ partial-sigs/should_fail/T10045
+ partial-sigs/should_fail/PartialTypeSignaturesDisabled
+ partial-sigs/should_fail/T10999
+ partial-sigs/should_fail/ExtraConstraintsWildcardInExpressionSignature
+ partial-sigs/should_fail/ExtraConstraintsWildcardInPatternSplice
+ partial-sigs/should_fail/WildcardInstantiations
+ partial-sigs/should_run/T15415
+ partial-sigs/should_compile/T10463
+ partial-sigs/should_compile/T15039a
+ partial-sigs/should_compile/T16728b
+ partial-sigs/should_compile/T15039c
+ partial-sigs/should_compile/T10438
+ partial-sigs/should_compile/SplicesUsed
+ partial-sigs/should_compile/T18008
+ partial-sigs/should_compile/ExprSigLocal
+ partial-sigs/should_compile/T11339a
+ partial-sigs/should_compile/T11670
+ partial-sigs/should_compile/WarningWildcardInstantiations
+ partial-sigs/should_compile/T16728
+ partial-sigs/should_compile/T12033
+ partial-sigs/should_compile/T15039b
+ partial-sigs/should_compile/T10403
+ partial-sigs/should_compile/T11192
+ partial-sigs/should_compile/T16728a
+ partial-sigs/should_compile/TypedSplice
+ partial-sigs/should_compile/T15039d
+ partial-sigs/should_compile/T11016
+ partial-sigs/should_compile/T13324_compile2
+ linear/should_fail/LinearPartialSig
+ polykinds/T14265
+ polykinds/T14172
+ -}
+ TcRnPartialTypeSignatures :: !SuggestPartialTypeSignatures -> !ThetaType -> TcRnMessage
+
+ {-| TcRnCannotDeriveInstance is an error that occurs every time a typeclass instance
+ can't be derived. The 'DeriveInstanceErrReason' will contain the specific reason
+ this error arose.
+
+ Example(s): None.
+
+ Test cases: generics/T10604/T10604_no_PolyKinds
+ deriving/should_fail/drvfail009
+ deriving/should_fail/drvfail-functor2
+ deriving/should_fail/T10598_fail3
+ deriving/should_fail/deriving-via-fail2
+ deriving/should_fail/deriving-via-fail
+ deriving/should_fail/T16181
+ -}
+ TcRnCannotDeriveInstance :: !Class
+ -- ^ The typeclass we are trying to derive
+ -- an instance for
+ -> [Type]
+ -- ^ The typeclass arguments, if any.
+ -> !(Maybe (DerivStrategy GhcTc))
+ -- ^ The derivation strategy, if any.
+ -> !UsingGeneralizedNewtypeDeriving
+ -- ^ Is '-XGeneralizedNewtypeDeriving' enabled?
+ -> !DeriveInstanceErrReason
+ -- ^ The specific reason why we couldn't derive
+ -- an instance for the class.
+ -> TcRnMessage
+
-- | Which parts of a record field are affected by a particular error or warning.
data RecordFieldPart
= RecordFieldConstructor !Name
@@ -1291,3 +1433,183 @@ suggestUndecidableInstances False = NoSuggestUndecidableInstaces
data NotClosedReason = NotLetBoundReason
| NotTypeClosed VarSet
| NotClosed Name NotClosedReason
+
+data SuggestPartialTypeSignatures
+ = YesSuggestPartialTypeSignatures
+ | NoSuggestPartialTypeSignatures
+ deriving (Show, Eq)
+
+suggestPartialTypeSignatures :: Bool -> SuggestPartialTypeSignatures
+suggestPartialTypeSignatures True = YesSuggestPartialTypeSignatures
+suggestPartialTypeSignatures False = NoSuggestPartialTypeSignatures
+
+data UsingGeneralizedNewtypeDeriving
+ = YesGeneralizedNewtypeDeriving
+ | NoGeneralizedNewtypeDeriving
+ deriving Eq
+
+usingGeneralizedNewtypeDeriving :: Bool -> UsingGeneralizedNewtypeDeriving
+usingGeneralizedNewtypeDeriving True = YesGeneralizedNewtypeDeriving
+usingGeneralizedNewtypeDeriving False = NoGeneralizedNewtypeDeriving
+
+data DeriveAnyClassEnabled
+ = YesDeriveAnyClassEnabled
+ | NoDeriveAnyClassEnabled
+ deriving Eq
+
+deriveAnyClassEnabled :: Bool -> DeriveAnyClassEnabled
+deriveAnyClassEnabled True = YesDeriveAnyClassEnabled
+deriveAnyClassEnabled False = NoDeriveAnyClassEnabled
+
+-- | Why a particular typeclass instance couldn't be derived.
+data DeriveInstanceErrReason
+ =
+ -- | The typeclass instance is not well-kinded.
+ DerivErrNotWellKinded !TyCon
+ -- ^ The type constructor that occurs in
+ -- the typeclass instance declaration.
+ !Kind
+ -- ^ The typeclass kind.
+ !Int
+ -- ^ The number of typeclass arguments that GHC
+ -- kept. See Note [tc_args and tycon arity] in
+ -- GHC.Tc.Deriv.
+ -- | Generic instances can only be derived using the stock strategy
+ -- in Safe Haskell.
+ | DerivErrSafeHaskellGenericInst
+ | DerivErrDerivingViaWrongKind !Kind !Type !Kind
+ | DerivErrNoEtaReduce !Type
+ -- ^ The instance type
+ -- | We cannot derive instances in boot files
+ | DerivErrBootFileFound
+ | DerivErrDataConsNotAllInScope !TyCon
+ -- | We cannot use GND on non-newtype types
+ | DerivErrGNDUsedOnData
+ -- | We cannot derive instances of nullary classes
+ | DerivErrNullaryClasses
+ -- | Last arg must be newtype or data application
+ | DerivErrLastArgMustBeApp
+ | DerivErrNoFamilyInstance !TyCon [Type]
+ | DerivErrNotStockDeriveable !DeriveAnyClassEnabled
+ | DerivErrHasAssociatedDatatypes !HasAssociatedDataFamInsts
+ !AssociatedTyLastVarInKind
+ !AssociatedTyNotParamOverLastTyVar
+ | DerivErrNewtypeNonDeriveableClass
+ | DerivErrCannotEtaReduceEnough !Bool -- Is eta-reduction OK?
+ | DerivErrOnlyAnyClassDeriveable !TyCon
+ -- ^ Type constructor for which the instance
+ -- is requested
+ !DeriveAnyClassEnabled
+ -- ^ Whether or not -XDeriveAnyClass is enabled
+ -- already.
+ -- | Stock deriving won't work, but perhas DeriveAnyClass will.
+ | DerivErrNotDeriveable !DeriveAnyClassEnabled
+ -- | The given 'PredType' is not a class.
+ | DerivErrNotAClass !PredType
+ -- | The given (representation of the) 'TyCon' has no
+ -- data constructors.
+ | DerivErrNoConstructors !TyCon
+ | DerivErrLangExtRequired !LangExt.Extension
+ -- | GHC simply doesn't how to how derive the input 'Class' for the given
+ -- 'Type'.
+ | DerivErrDunnoHowToDeriveForType !Type
+ -- | The given 'TyCon' must be an enumeration.
+ -- See Note [Enumeration types] in GHC.Core.TyCon
+ | DerivErrMustBeEnumType !TyCon
+ -- | The given 'TyCon' must have /precisely/ one constructor.
+ | DerivErrMustHaveExactlyOneConstructor !TyCon
+ -- | The given data type must have some parameters.
+ | DerivErrMustHaveSomeParameters !TyCon
+ -- | The given data type must not have a class context.
+ | DerivErrMustNotHaveClassContext !TyCon !ThetaType
+ -- | We couldn't derive an instance for a particular data constructor
+ -- for a variety of reasons.
+ | DerivErrBadConstructor !(Maybe HasWildcard) [DeriveInstanceBadConstructor]
+ -- | We couldn't derive a 'Generic' instance for the given type for a
+ -- variety of reasons
+ | DerivErrGenerics [DeriveGenericsErrReason]
+ -- | We couldn't derive an instance either because the type was not an
+ -- enum type or because it did have more than one constructor.
+ | DerivErrEnumOrProduct !DeriveInstanceErrReason !DeriveInstanceErrReason
+
+data DeriveInstanceBadConstructor
+ =
+ -- | The given 'DataCon' must be truly polymorphic in the
+ -- last argument of the data type.
+ DerivErrBadConExistential !DataCon
+ -- | The given 'DataCon' must not use the type variable in a function argument"
+ | DerivErrBadConCovariant !DataCon
+ -- | The given 'DataCon' must not contain function types
+ | DerivErrBadConFunTypes !DataCon
+ -- | The given 'DataCon' must use the type variable only
+ -- as the last argument of a data type
+ | DerivErrBadConWrongArg !DataCon
+ -- | The given 'DataCon' is a GADT so we cannot directly
+ -- derive an istance for it.
+ | DerivErrBadConIsGADT !DataCon
+ -- | The given 'DataCon' has existentials type vars in its type.
+ | DerivErrBadConHasExistentials !DataCon
+ -- | The given 'DataCon' has constraints in its type.
+ | DerivErrBadConHasConstraints !DataCon
+ -- | The given 'DataCon' has a higher-rank type.
+ | DerivErrBadConHasHigherRankType !DataCon
+
+data DeriveGenericsErrReason
+ = -- | The type must not have some datatype context.
+ DerivErrGenericsMustNotHaveDatatypeContext !TyCon
+ -- | The data constructor must not have exotic unlifted
+ -- or polymorphic arguments.
+ | DerivErrGenericsMustNotHaveExoticArgs !DataCon
+ -- | The data constructor must be a vanilla constructor.
+ | DerivErrGenericsMustBeVanillaDataCon !DataCon
+ -- | The type must have some type parameters.
+ -- check (d) from Note [Requirements for deriving Generic and Rep]
+ -- in GHC.Tc.Deriv.Generics.
+ | DerivErrGenericsMustHaveSomeTypeParams !TyCon
+ -- | The data constructor must not have existential arguments.
+ | DerivErrGenericsMustNotHaveExistentials !DataCon
+ -- | The derivation applies a type to an argument involving
+ -- the last parameter but the applied type is not of kind * -> *.
+ | DerivErrGenericsWrongArgKind !DataCon
+
+data HasWildcard
+ = YesHasWildcard
+ | NoHasWildcard
+ deriving Eq
+
+hasWildcard :: Bool -> HasWildcard
+hasWildcard True = YesHasWildcard
+hasWildcard False = NoHasWildcard
+
+-- | A type representing whether or not the input type has associated data family instances.
+data HasAssociatedDataFamInsts
+ = YesHasAdfs
+ | NoHasAdfs
+ deriving Eq
+
+hasAssociatedDataFamInsts :: Bool -> HasAssociatedDataFamInsts
+hasAssociatedDataFamInsts True = YesHasAdfs
+hasAssociatedDataFamInsts False = NoHasAdfs
+
+-- | If 'YesAssocTyLastVarInKind', the associated type of a typeclass
+-- contains the last type variable of the class in a kind, which is not (yet) allowed
+-- by GHC.
+data AssociatedTyLastVarInKind
+ = YesAssocTyLastVarInKind !TyCon -- ^ The associated type family of the class
+ | NoAssocTyLastVarInKind
+ deriving Eq
+
+associatedTyLastVarInKind :: Maybe TyCon -> AssociatedTyLastVarInKind
+associatedTyLastVarInKind (Just tc) = YesAssocTyLastVarInKind tc
+associatedTyLastVarInKind Nothing = NoAssocTyLastVarInKind
+
+-- | If 'NoAssociatedTyNotParamOverLastTyVar', the associated type of a
+-- typeclass is not parameterized over the last type variable of the class
+data AssociatedTyNotParamOverLastTyVar
+ = YesAssociatedTyNotParamOverLastTyVar !TyCon -- ^ The associated type family of the class
+ | NoAssociatedTyNotParamOverLastTyVar
+ deriving Eq
+
+associatedTyNotParamOverLastTyVar :: Maybe TyCon -> AssociatedTyNotParamOverLastTyVar
+associatedTyNotParamOverLastTyVar (Just tc) = YesAssociatedTyNotParamOverLastTyVar tc
+associatedTyNotParamOverLastTyVar Nothing = NoAssociatedTyNotParamOverLastTyVar