{-# LANGUAGE UndecidableInstances #-}
module GHC.Tc.Types.ErrCtxt
( HsCtxt(..), isHsCtxtLandmark
, UserSigType(..), FunAppCtxtFunArg(..)
, TyConInstFlavour(..)
, ErrCtxtStack
, UserTypeCtxt(..), pprUserTypeCtxt, isSigMaybe
, ReportRedundantConstraints(..), reportRedundantConstraints
, redundantConstraintsSpan,
)
where
import GHC.Prelude
import {-# SOURCE #-} GHC.Hs.Expr (SplicePointName, HsMatchContextRn, HsStmtContextRn)
import {-# SOURCE #-} GHC.Hs.Expr ()
import GHC.Hs.Type ()
import GHC.Hs.Extension
import GHC.Parser.Annotation ( LocatedN, SrcSpanAnnA )
import GHC.Tc.Errors.Types.PromotionErr ( TermLevelUseCtxt )
import {-# SOURCE #-} GHC.Tc.Types.Origin ( CtOrigin, ExpectedFunTyCtxt )
import GHC.Tc.Utils.TcType ( TcType, TcTyCon, ExpType )
import GHC.Types.Basic ( TyConFlavour )
import GHC.Types.Name ( Name )
import GHC.Types.SrcLoc ( SrcSpan, noSrcSpan )
import GHC.Types.Var ( Id, TyCoVar )
import GHC.Unit.Types ( Module, InstantiatedModule )
import GHC.Core.Class ( Class )
import GHC.Core.ConLike ( ConLike )
import GHC.Core.PatSyn ( PatSyn )
import GHC.Core.TyCon ( TyCon )
import GHC.Core.TyCo.Rep ( Type, ThetaType, PredType )
import {-# SOURCE #-} GHC.Unit.State ( UnitState )
import GHC.Data.FastString ( FastString )
import GHC.Utils.Outputable
import Language.Haskell.Syntax
import Language.Haskell.Syntax.Basic ( FieldLabelString(..) )
import GHC.Boot.TH.Syntax qualified as TH
import qualified Data.List.NonEmpty as NE
data UserTypeCtxt
= FunSigCtxt
Name
ReportRedundantConstraints
| InfSigCtxt Name
| ExprSigCtxt
ReportRedundantConstraints
| KindSigCtxt
| StandaloneKindSigCtxt
Name
| TypeAppCtxt
| ConArgCtxt Name
| TySynCtxt Name
| PatSynCtxt Name
| PatSigCtxt
| ForSigCtxt Name
| DefaultDeclCtxt
| InstDeclCtxt Bool
| SpecInstCtxt
| GenSigCtxt
| GhciCtxt Bool
| ClassSCCtxt Name
| SigmaCtxt
| DataTyCtxt Name
| DerivClauseCtxt
| TyVarBndrKindCtxt Name
| RuleBndrTypeCtxt Name
| DataKindCtxt Name
| TySynKindCtxt Name
| TyFamResKindCtxt Name
deriving( UserTypeCtxt -> UserTypeCtxt -> Bool
(UserTypeCtxt -> UserTypeCtxt -> Bool)
-> (UserTypeCtxt -> UserTypeCtxt -> Bool) -> Eq UserTypeCtxt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserTypeCtxt -> UserTypeCtxt -> Bool
== :: UserTypeCtxt -> UserTypeCtxt -> Bool
$c/= :: UserTypeCtxt -> UserTypeCtxt -> Bool
/= :: UserTypeCtxt -> UserTypeCtxt -> Bool
Eq )
data ReportRedundantConstraints
= NoRRC
| WantRRC SrcSpan
deriving( ReportRedundantConstraints -> ReportRedundantConstraints -> Bool
(ReportRedundantConstraints -> ReportRedundantConstraints -> Bool)
-> (ReportRedundantConstraints
-> ReportRedundantConstraints -> Bool)
-> Eq ReportRedundantConstraints
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReportRedundantConstraints -> ReportRedundantConstraints -> Bool
== :: ReportRedundantConstraints -> ReportRedundantConstraints -> Bool
$c/= :: ReportRedundantConstraints -> ReportRedundantConstraints -> Bool
/= :: ReportRedundantConstraints -> ReportRedundantConstraints -> Bool
Eq )
reportRedundantConstraints :: ReportRedundantConstraints -> Bool
reportRedundantConstraints :: ReportRedundantConstraints -> Bool
reportRedundantConstraints ReportRedundantConstraints
NoRRC = Bool
False
reportRedundantConstraints (WantRRC {}) = Bool
True
redundantConstraintsSpan :: UserTypeCtxt -> SrcSpan
redundantConstraintsSpan :: UserTypeCtxt -> SrcSpan
redundantConstraintsSpan (FunSigCtxt Name
_ (WantRRC SrcSpan
span)) = SrcSpan
span
redundantConstraintsSpan (ExprSigCtxt (WantRRC SrcSpan
span)) = SrcSpan
span
redundantConstraintsSpan UserTypeCtxt
_ = SrcSpan
noSrcSpan
pprUserTypeCtxt :: UserTypeCtxt -> SDoc
pprUserTypeCtxt :: UserTypeCtxt -> SDoc
pprUserTypeCtxt (FunSigCtxt Name
n ReportRedundantConstraints
_) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the type signature for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (InfSigCtxt Name
n) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the inferred type for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (ExprSigCtxt ReportRedundantConstraints
_) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"an expression type signature"
pprUserTypeCtxt UserTypeCtxt
KindSigCtxt = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a kind signature"
pprUserTypeCtxt (StandaloneKindSigCtxt Name
n) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a standalone kind signature for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt UserTypeCtxt
TypeAppCtxt = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a type argument"
pprUserTypeCtxt (ConArgCtxt Name
c) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the type of the constructor" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
c)
pprUserTypeCtxt (TySynCtxt Name
c) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the RHS of the type synonym" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
c)
pprUserTypeCtxt UserTypeCtxt
PatSigCtxt = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a pattern type signature"
pprUserTypeCtxt (ForSigCtxt Name
n) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the foreign declaration for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt UserTypeCtxt
DefaultDeclCtxt = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a `default' declaration"
pprUserTypeCtxt (InstDeclCtxt Bool
False) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"an instance declaration"
pprUserTypeCtxt (InstDeclCtxt Bool
True) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a stand-alone deriving instance declaration"
pprUserTypeCtxt UserTypeCtxt
SpecInstCtxt = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a SPECIALISE instance pragma"
pprUserTypeCtxt UserTypeCtxt
GenSigCtxt = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a type expected by the context"
pprUserTypeCtxt (GhciCtxt {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a type in a GHCi command"
pprUserTypeCtxt (ClassSCCtxt Name
c) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the super-classes of class" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
c)
pprUserTypeCtxt UserTypeCtxt
SigmaCtxt = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the context of a polymorphic type"
pprUserTypeCtxt (DataTyCtxt Name
tc) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the context of the data type declaration for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
tc)
pprUserTypeCtxt (PatSynCtxt Name
n) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the signature for pattern synonym" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (UserTypeCtxt
DerivClauseCtxt) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a `deriving' clause"
pprUserTypeCtxt (TyVarBndrKindCtxt Name
n) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the kind annotation on the type variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (RuleBndrTypeCtxt Name
n) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the type signature for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (DataKindCtxt Name
n) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the kind annotation on the declaration for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (TySynKindCtxt Name
n) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the kind annotation on the declaration for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (TyFamResKindCtxt Name
n) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the result kind for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
isSigMaybe :: UserTypeCtxt -> Maybe Name
isSigMaybe :: UserTypeCtxt -> Maybe Name
isSigMaybe (FunSigCtxt Name
n ReportRedundantConstraints
_) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
isSigMaybe (ConArgCtxt Name
n) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
isSigMaybe (ForSigCtxt Name
n) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
isSigMaybe (PatSynCtxt Name
n) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
isSigMaybe UserTypeCtxt
_ = Maybe Name
forall a. Maybe a
Nothing
type ErrCtxtStack = [HsCtxt]
data UserSigType
= UserLHsSigType !(LHsSigType GhcRn)
| UserLHsType !(LHsType GhcRn)
instance Outputable UserSigType where
ppr :: UserSigType -> SDoc
ppr (UserLHsSigType LHsSigType GhcRn
ty) = GenLocated SrcSpanAnnA (HsSigType GhcRn) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsSigType GhcRn
GenLocated SrcSpanAnnA (HsSigType GhcRn)
ty
ppr (UserLHsType LHsType GhcRn
ty) = GenLocated SrcSpanAnnA (HsType GhcRn) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
ty
data FunAppCtxtFunArg
= FunAppCtxtExpr !(HsExpr GhcRn) !(HsExpr GhcRn)
| FunAppCtxtTy !(LHsType GhcRn) !(LHsType GhcRn)
data TyConInstFlavour
= TyConInstFlavour
{ TyConInstFlavour -> TyConFlavour TyCon
tyConInstFlavour :: !(TyConFlavour TyCon)
, TyConInstFlavour -> Bool
tyConInstIsDefault :: !Bool
}
data HsCtxt
= ExprCtxt !(HsExpr GhcRn)
| ThetaCtxt !UserTypeCtxt !ThetaType
| QuantifiedCtCtxt !PredType
| InferredTypeCtxt !Name !TcType
| SigCtxt !(Sig GhcRn)
| UserSigCtxt !UserTypeCtxt !UserSigType
| RecordUpdCtxt !(NE.NonEmpty ConLike) ![Name] ![TyCoVar]
| ClassOpCtxt !Id !Type
| MethSigCtxt !Name !TcType !TcType
| PatSigErrCtxt !TcType !ExpType
| PatCtxt !(Pat GhcRn)
| PatSynDeclCtxt !Name
| MatchCtxt !HsMatchContextRn
| forall body. (Outputable body)
=> MatchInCtxt !(Match GhcRn body)
| FunAppCtxt !FunAppCtxtFunArg !Int
| FunTysCtxt !ExpectedFunTyCtxt !Type !Int !Int
| FunResCtxt !(HsExpr GhcTc) !Int !TcType !ExpType
| TyConDeclCtxt !Name !(TyConFlavour TyCon)
| TyConInstCtxt !Name !TyConInstFlavour
| DataConDefCtxt !(NE.NonEmpty (LocatedN Name))
| DataConResTyCtxt !(NE.NonEmpty (LocatedN Name))
| ClosedFamEqnCtxt !TyCon
| TySynErrCtxt !TyCon
| RoleAnnotErrCtxt !Name
| CmdCtxt !(HsCmd GhcRn)
| InstDeclErrCtxt !(Either (LHsType GhcRn) PredType)
| DefaultDeclErrCtxt { HsCtxt -> Bool
ddec_in_type_list :: !Bool }
| StaticFormCtxt !(LHsExpr GhcRn)
| forall p. OutputableBndrId p
=> PatMonoBindsCtxt !(LPat (GhcPass p)) !(GRHSs GhcRn (LHsExpr GhcRn))
| ForeignDeclCtxt !(ForeignDecl GhcRn)
| FieldCtxt !FieldLabelString
| TypeCtxt !(LHsType GhcRn)
| KindCtxt !(LHsKind GhcRn)
| AmbiguityCheckCtxt !UserTypeCtxt !Bool
| TermLevelUseCtxt !Name !TermLevelUseCtxt
| MainCtxt !Name
| VDQWarningCtxt !TcTyCon
| forall body.
( Anno (StmtLR GhcRn GhcRn body) ~ SrcSpanAnnA
, Outputable body
) => StmtErrCtxt !HsStmtContextRn !(LStmtLR GhcRn GhcRn body)
| StmtErrCtxtPat (LPat GhcRn)
| SyntaxNameCtxt !(HsExpr GhcRn) !CtOrigin !TcType !SrcSpan
| RuleCtxt !FastString
| SubTypeCtxt !TcType !TcType
| forall p. OutputableBndrId p
=> ExportCtxt (IE (GhcPass p))
| PatSynExportCtxt !PatSyn
| PatSynRecSelExportCtxt !PatSyn !Name
| forall p. OutputableBndrId p
=> AnnCtxt (AnnDecl (GhcPass p))
| SpecPragmaCtxt !(Sig GhcRn)
| DerivInstCtxt !PredType
| StandaloneDerivCtxt !(LHsSigWcType GhcRn)
| DerivBindCtxt !Id !Class ![Type]
| UntypedTHBracketCtxt !(HsQuote GhcPs)
| forall p. OutputableBndrId p
=> TypedTHBracketCtxt !(LHsExpr (GhcPass p))
| UntypedSpliceCtxt !(HsUntypedSplice GhcPs)
| forall p. OutputableBndrId p
=> TypedSpliceCtxt !(Maybe SplicePointName) !(HsTypedSplice (GhcPass p))
| TypedSpliceResultCtxt !(LHsExpr GhcTc)
| ReifyInstancesCtxt !TH.Name ![TH.Type]
| MergeSignaturesCtxt !UnitState !ModuleName ![InstantiatedModule]
| CheckImplementsCtxt !UnitState !Module !InstantiatedModule
isHsCtxtLandmark :: HsCtxt -> Bool
isHsCtxtLandmark :: HsCtxt -> Bool
isHsCtxtLandmark (DerivBindCtxt{}) = Bool
True
isHsCtxtLandmark (FunResCtxt{}) = Bool
True
isHsCtxtLandmark (VDQWarningCtxt{}) = Bool
True
isHsCtxtLandmark HsCtxt
_ = Bool
False