Safe Haskell | None |
---|---|
Language | GHC2021 |
Development.IDE.GHC.Compat.Error
Synopsis
- data MsgEnvelope e = MsgEnvelope {}
- msgEnvelopeErrorL :: forall e f. Functor f => (e -> f e) -> MsgEnvelope e -> f (MsgEnvelope e)
- data GhcMessage where
- data TcRnMessage where
- TcRnUnknownMessage :: UnknownDiagnostic (DiagnosticOpts TcRnMessage) -> TcRnMessage
- TcRnInterfaceError :: !IfaceMessage -> TcRnMessage
- TcRnMessageWithInfo :: !UnitState -> !TcRnMessageDetailed -> TcRnMessage
- TcRnWithHsDocContext :: !HsDocContext -> !TcRnMessage -> TcRnMessage
- TcRnSolverReport :: SolverReportWithCtxt -> DiagnosticReason -> [GhcHint] -> TcRnMessage
- TcRnSolverDepthError :: !Type -> !SubGoalDepth -> TcRnMessage
- TcRnRedundantConstraints :: [Id] -> (SkolemInfoAnon, Bool) -> TcRnMessage
- TcRnInaccessibleCode :: Implication -> SolverReportWithCtxt -> TcRnMessage
- TcRnInaccessibleCoAxBranch :: TyCon -> CoAxBranch -> TcRnMessage
- TcRnTypeDoesNotHaveFixedRuntimeRep :: !Type -> !FixedRuntimeRepProvenance -> !ErrInfo -> TcRnMessage
- TcRnImplicitLift :: Name -> !ErrInfo -> TcRnMessage
- TcRnUnusedPatternBinds :: HsBind GhcRn -> TcRnMessage
- TcRnUnusedQuantifiedTypeVar :: HsDocContext -> HsTyVarBndrExistentialFlag -> TcRnMessage
- TcRnDodgyImports :: !DodgyImportsReason -> TcRnMessage
- TcRnDodgyExports :: GlobalRdrElt -> TcRnMessage
- TcRnMissingImportList :: IE GhcPs -> TcRnMessage
- TcRnUnsafeDueToPlugin :: TcRnMessage
- TcRnModMissingRealSrcSpan :: Module -> TcRnMessage
- TcRnIdNotExportedFromModuleSig :: Name -> Module -> TcRnMessage
- TcRnIdNotExportedFromLocalSig :: Name -> TcRnMessage
- TcRnShadowedName :: OccName -> ShadowedNameProvenance -> TcRnMessage
- TcRnInvalidWarningCategory :: !WarningCategory -> TcRnMessage
- TcRnDuplicateWarningDecls :: !(LocatedN RdrName) -> !RdrName -> TcRnMessage
- TcRnSimplifierTooManyIterations :: Cts -> !IntWithInf -> WantedConstraints -> TcRnMessage
- TcRnIllegalPatSynDecl :: !(LIdP GhcPs) -> TcRnMessage
- TcRnLinearPatSyn :: !Type -> TcRnMessage
- TcRnEmptyRecordUpdate :: TcRnMessage
- TcRnIllegalFieldPunning :: !(Located RdrName) -> TcRnMessage
- TcRnIllegalWildcardsInRecord :: !RecordFieldPart -> TcRnMessage
- TcRnIllegalWildcardInType :: Maybe Name -> !BadAnonWildcardContext -> TcRnMessage
- TcRnDuplicateFieldName :: !RecordFieldPart -> NonEmpty RdrName -> TcRnMessage
- TcRnIllegalViewPattern :: !(Pat GhcPs) -> TcRnMessage
- TcRnCharLiteralOutOfRange :: !Char -> TcRnMessage
- TcRnNegativeNumTypeLiteral :: HsType GhcPs -> TcRnMessage
- TcRnIllegalWildcardsInConstructor :: !Name -> TcRnMessage
- TcRnIgnoringAnnotations :: [LAnnDecl GhcRn] -> TcRnMessage
- TcRnAnnotationInSafeHaskell :: TcRnMessage
- TcRnInvalidTypeApplication :: Type -> LHsWcType GhcRn -> TcRnMessage
- TcRnTagToEnumMissingValArg :: TcRnMessage
- TcRnTagToEnumUnspecifiedResTy :: Type -> TcRnMessage
- TcRnTagToEnumResTyNotAnEnum :: Type -> TcRnMessage
- TcRnTagToEnumResTyTypeData :: Type -> TcRnMessage
- TcRnArrowIfThenElsePredDependsOnResultTy :: TcRnMessage
- TcRnIllegalHsBootOrSigDecl :: !HsBootOrSig -> !BadBootDecls -> TcRnMessage
- TcRnBootMismatch :: !HsBootOrSig -> !BootMismatch -> TcRnMessage
- TcRnRecursivePatternSynonym :: LHsBinds GhcRn -> TcRnMessage
- TcRnPartialTypeSigTyVarMismatch :: Name -> Name -> Name -> LHsSigWcType GhcRn -> TcRnMessage
- TcRnPartialTypeSigBadQuantifier :: Name -> Name -> Maybe Type -> LHsSigWcType GhcRn -> TcRnMessage
- TcRnMissingSignature :: MissingSignature -> Exported -> TcRnMessage
- TcRnPolymorphicBinderMissingSig :: Name -> Type -> TcRnMessage
- TcRnOverloadedSig :: TcIdSigInfo -> TcRnMessage
- TcRnTupleConstraintInst :: !Class -> TcRnMessage
- TcRnUserTypeError :: !Type -> TcRnMessage
- TcRnConstraintInKind :: !Type -> TcRnMessage
- TcRnUnboxedTupleOrSumTypeFuncArg :: UnboxedTupleOrSum -> !Type -> TcRnMessage
- TcRnLinearFuncInKind :: !Type -> TcRnMessage
- TcRnForAllEscapeError :: !Type -> !Kind -> TcRnMessage
- TcRnVDQInTermType :: !(Maybe Type) -> TcRnMessage
- TcRnBadQuantPredHead :: !Type -> TcRnMessage
- TcRnIllegalTupleConstraint :: !Type -> TcRnMessage
- TcRnNonTypeVarArgInConstraint :: !Type -> TcRnMessage
- TcRnIllegalImplicitParam :: !Type -> TcRnMessage
- TcRnIllegalConstraintSynonymOfKind :: !Type -> TcRnMessage
- TcRnOversaturatedVisibleKindArg :: !Type -> TcRnMessage
- TcRnForAllRankErr :: !Rank -> !Type -> TcRnMessage
- TcRnSimplifiableConstraint :: !PredType -> !InstanceWhat -> TcRnMessage
- TcRnArityMismatch :: !TyThing -> !Arity -> !Arity -> TcRnMessage
- TcRnIllegalInstance :: IllegalInstanceReason -> TcRnMessage
- TcRnMonomorphicBindings :: [Name] -> TcRnMessage
- TcRnOrphanInstance :: Either ClsInst FamInst -> TcRnMessage
- TcRnFunDepConflict :: !UnitState -> NonEmpty ClsInst -> TcRnMessage
- TcRnDupInstanceDecls :: !UnitState -> NonEmpty ClsInst -> TcRnMessage
- TcRnConflictingFamInstDecls :: NonEmpty FamInst -> TcRnMessage
- TcRnFamInstNotInjective :: InjectivityErrReason -> TyCon -> NonEmpty CoAxBranch -> TcRnMessage
- TcRnBangOnUnliftedType :: !Type -> TcRnMessage
- TcRnLazyBangOnUnliftedType :: !Type -> TcRnMessage
- TcRnMultipleDefaultDeclarations :: [LDefaultDecl GhcRn] -> TcRnMessage
- TcRnBadDefaultType :: Type -> [Class] -> TcRnMessage
- TcRnPatSynBundledWithNonDataCon :: TcRnMessage
- TcRnPatSynBundledWithWrongType :: Type -> Type -> TcRnMessage
- TcRnDupeModuleExport :: ModuleName -> TcRnMessage
- TcRnExportedModNotImported :: ModuleName -> TcRnMessage
- TcRnNullExportedModule :: ModuleName -> TcRnMessage
- TcRnMissingExportList :: ModuleName -> TcRnMessage
- TcRnExportHiddenComponents :: IE GhcPs -> TcRnMessage
- TcRnDuplicateExport :: GlobalRdrElt -> IE GhcPs -> IE GhcPs -> TcRnMessage
- TcRnExportedParentChildMismatch :: Name -> TyThing -> Name -> [Name] -> TcRnMessage
- TcRnConflictingExports :: OccName -> GlobalRdrElt -> IE GhcPs -> GlobalRdrElt -> IE GhcPs -> TcRnMessage
- TcRnDuplicateFieldExport :: (GlobalRdrElt, IE GhcPs) -> NonEmpty (GlobalRdrElt, IE GhcPs) -> TcRnMessage
- TcRnAmbiguousRecordUpdate :: HsExpr GhcRn -> TyCon -> TcRnMessage
- TcRnMissingFields :: ConLike -> [(FieldLabelString, TcType)] -> TcRnMessage
- TcRnFieldUpdateInvalidType :: [(FieldLabelString, TcType)] -> TcRnMessage
- TcRnMissingStrictFields :: ConLike -> [(FieldLabelString, TcType)] -> TcRnMessage
- TcRnAmbiguousFieldInUpdate :: (GlobalRdrElt, GlobalRdrElt, [GlobalRdrElt]) -> TcRnMessage
- TcRnBadRecordUpdate :: [RdrName] -> BadRecordUpdateReason -> TcRnMessage
- TcRnStaticFormNotClosed :: Name -> NotClosedReason -> TcRnMessage
- TcRnUselessTypeable :: TcRnMessage
- TcRnDerivingDefaults :: !Class -> TcRnMessage
- TcRnNonUnaryTypeclassConstraint :: !(LHsSigType GhcRn) -> TcRnMessage
- TcRnPartialTypeSignatures :: !SuggestPartialTypeSignatures -> !ThetaType -> TcRnMessage
- TcRnCannotDeriveInstance :: !Class -> [Type] -> !(Maybe (DerivStrategy GhcTc)) -> !UsingGeneralizedNewtypeDeriving -> !DeriveInstanceErrReason -> TcRnMessage
- TcRnLazyGADTPattern :: TcRnMessage
- TcRnArrowProcGADTPattern :: TcRnMessage
- TcRnForallIdentifier :: RdrName -> TcRnMessage
- TcRnCapturedTermName :: RdrName -> Either [GlobalRdrElt] Name -> TcRnMessage
- TcRnBindVarAlreadyInScope :: [LocatedN RdrName] -> TcRnMessage
- TcRnBindMultipleVariables :: HsDocContext -> LocatedN RdrName -> TcRnMessage
- TcRnTypeEqualityOutOfScope :: TcRnMessage
- TcRnTypeEqualityRequiresOperators :: TcRnMessage
- TcRnIllegalTypeOperator :: !SDoc -> !RdrName -> TcRnMessage
- TcRnIllegalTypeOperatorDecl :: !RdrName -> TcRnMessage
- TcRnGADTMonoLocalBinds :: TcRnMessage
- TcRnNotInScope :: NotInScopeError -> RdrName -> [ImportError] -> [GhcHint] -> TcRnMessage
- TcRnTermNameInType :: RdrName -> [GhcHint] -> TcRnMessage
- TcRnUntickedPromotedThing :: UntickedPromotedThing -> TcRnMessage
- TcRnIllegalBuiltinSyntax :: SDoc -> RdrName -> TcRnMessage
- TcRnWarnDefaulting :: [Ct] -> Maybe TyVar -> Type -> TcRnMessage
- TcRnIncorrectNameSpace :: Name -> Bool -> TcRnMessage
- TcRnForeignImportPrimExtNotSet :: ForeignImport GhcRn -> TcRnMessage
- TcRnForeignImportPrimSafeAnn :: ForeignImport GhcRn -> TcRnMessage
- TcRnForeignFunctionImportAsValue :: ForeignImport GhcRn -> TcRnMessage
- TcRnFunPtrImportWithoutAmpersand :: ForeignImport GhcRn -> TcRnMessage
- TcRnIllegalForeignDeclBackend :: Either (ForeignExport GhcRn) (ForeignImport GhcRn) -> Backend -> ExpectedBackends -> TcRnMessage
- TcRnUnsupportedCallConv :: Either (ForeignExport GhcRn) (ForeignImport GhcRn) -> UnsupportedCallConvention -> TcRnMessage
- TcRnIllegalForeignType :: !(Maybe ArgOrResult) -> !IllegalForeignTypeReason -> TcRnMessage
- TcRnInvalidCIdentifier :: !CLabelString -> TcRnMessage
- TcRnExpectedValueId :: !TcTyThing -> TcRnMessage
- TcRnRecSelectorEscapedTyVar :: !OccName -> TcRnMessage
- TcRnPatSynNotBidirectional :: !Name -> TcRnMessage
- TcRnIllegalDerivingItem :: !(LHsSigType GhcRn) -> TcRnMessage
- TcRnUnexpectedAnnotation :: !(HsType GhcRn) -> !HsSrcBang -> TcRnMessage
- TcRnIllegalRecordSyntax :: Either (HsType GhcPs) (HsType GhcRn) -> TcRnMessage
- TcRnInvalidVisibleKindArgument :: !(LHsType GhcRn) -> !Type -> TcRnMessage
- TcRnTooManyBinders :: !Kind -> ![LHsTyVarBndr (HsBndrVis GhcRn) GhcRn] -> TcRnMessage
- TcRnDifferentNamesForTyVar :: !Name -> !Name -> TcRnMessage
- TcRnDisconnectedTyVar :: !Name -> TcRnMessage
- TcRnInvalidReturnKind :: !DataSort -> !AllowedDataResKind -> !Kind -> !(Maybe SuggestUnliftedTypes) -> TcRnMessage
- TcRnUnexpectedKindVar :: RdrName -> TcRnMessage
- TcRnIllegalKind :: HsTypeOrSigType GhcPs -> Bool -> TcRnMessage
- TcRnClassKindNotConstraint :: !Kind -> TcRnMessage
- TcRnUnpromotableThing :: !Name -> !PromotionErr -> TcRnMessage
- TcRnMatchesHaveDiffNumArgs :: !(HsMatchContext GhcTc) -> !MatchArgBadMatches -> TcRnMessage
- TcRnUnexpectedPatSigType :: HsPatSigType GhcPs -> TcRnMessage
- TcRnIllegalKindSignature :: HsType GhcPs -> TcRnMessage
- TcRnDataKindsError :: TypeOrKind -> HsType GhcPs -> TcRnMessage
- TcRnCannotBindScopedTyVarInPatSig :: !(NonEmpty (Name, TcTyVar)) -> TcRnMessage
- TcRnCannotBindTyVarsInPatBind :: !(NonEmpty (Name, TcTyVar)) -> TcRnMessage
- TcRnTooManyTyArgsInConPattern :: !ConLike -> !Int -> !Int -> TcRnMessage
- TcRnMultipleInlinePragmas :: !Id -> !(LocatedA InlinePragma) -> !(NonEmpty (LocatedA InlinePragma)) -> TcRnMessage
- TcRnUnexpectedPragmas :: !Id -> !(NonEmpty (LSig GhcRn)) -> TcRnMessage
- TcRnNonOverloadedSpecialisePragma :: !(LIdP GhcRn) -> TcRnMessage
- TcRnSpecialiseNotVisible :: !Name -> TcRnMessage
- TcRnPragmaWarning :: {..} -> TcRnMessage
- TcRnDifferentExportWarnings :: !Name -> NonEmpty SrcSpan -> TcRnMessage
- TcRnIncompleteExportWarnings :: !Name -> NonEmpty SrcSpan -> TcRnMessage
- TcRnIllegalHsigDefaultMethods :: !Name -> NonEmpty (LHsBind GhcRn) -> TcRnMessage
- TcRnHsigFixityMismatch :: !TyThing -> !Fixity -> !Fixity -> TcRnMessage
- TcRnHsigShapeMismatch :: !HsigShapeMismatchReason -> TcRnMessage
- TcRnHsigMissingModuleExport :: !OccName -> !UnitState -> !Module -> TcRnMessage
- TcRnBadGenericMethod :: !Name -> !Name -> TcRnMessage
- TcRnWarningMinimalDefIncomplete :: ClassMinimalDef -> TcRnMessage
- TcRnIllegalQuasiQuotes :: TcRnMessage
- TcRnTHError :: THError -> TcRnMessage
- TcRnDefaultMethodForPragmaLacksBinding :: Id -> Sig GhcRn -> TcRnMessage
- TcRnIgnoreSpecialisePragmaOnDefMethod :: !Name -> TcRnMessage
- TcRnBadMethodErr :: {..} -> TcRnMessage
- TcRnIllegalNewtype :: DataCon -> Bool -> IllegalNewtypeReason -> TcRnMessage
- TcRnIllegalTypeData :: TcRnMessage
- TcRnTypeDataForbids :: !TypeDataForbids -> TcRnMessage
- TcRnUnsatisfiedMinimalDef :: ClassMinimalDef -> TcRnMessage
- TcRnMisplacedInstSig :: Name -> LHsSigType GhcRn -> TcRnMessage
- TcRnNoRebindableSyntaxRecordDot :: TcRnMessage
- TcRnNoFieldPunsRecordDot :: TcRnMessage
- TcRnIllegalStaticExpression :: HsExpr GhcPs -> TcRnMessage
- TcRnListComprehensionDuplicateBinding :: Name -> TcRnMessage
- TcRnEmptyStmtsGroup :: EmptyStatementGroupErrReason -> TcRnMessage
- TcRnLastStmtNotExpr :: HsStmtContext GhcRn -> UnexpectedStatement -> TcRnMessage
- TcRnUnexpectedStatementInContext :: HsStmtContext GhcRn -> UnexpectedStatement -> Maybe Extension -> TcRnMessage
- TcRnIllegalTupleSection :: TcRnMessage
- TcRnIllegalImplicitParameterBindings :: Either (HsLocalBindsLR GhcPs GhcPs) (HsLocalBindsLR GhcRn GhcPs) -> TcRnMessage
- TcRnSectionWithoutParentheses :: HsExpr GhcPs -> TcRnMessage
- TcRnBindingOfExistingName :: RdrName -> TcRnMessage
- TcRnMultipleFixityDecls :: SrcSpan -> RdrName -> TcRnMessage
- TcRnIllegalPatternSynonymDecl :: TcRnMessage
- TcRnIllegalClassBinding :: DeclSort -> HsBindLR GhcPs GhcPs -> TcRnMessage
- TcRnOrphanCompletePragma :: TcRnMessage
- TcRnEmptyCase :: HsMatchContext GhcRn -> TcRnMessage
- TcRnNonStdGuards :: NonStandardGuards -> TcRnMessage
- TcRnDuplicateSigDecl :: NonEmpty (LocatedN RdrName, Sig GhcPs) -> TcRnMessage
- TcRnMisplacedSigDecl :: Sig GhcRn -> TcRnMessage
- TcRnUnexpectedDefaultSig :: Sig GhcPs -> TcRnMessage
- TcRnDuplicateMinimalSig :: LSig GhcPs -> LSig GhcPs -> [LSig GhcPs] -> TcRnMessage
- TcRnIllegalInvisTyVarBndr :: !(LHsTyVarBndr (HsBndrVis GhcRn) GhcRn) -> TcRnMessage
- TcRnInvalidInvisTyVarBndr :: !Name -> !(LHsTyVarBndr (HsBndrVis GhcRn) GhcRn) -> TcRnMessage
- TcRnInvisBndrWithoutSig :: !Name -> !(LHsTyVarBndr (HsBndrVis GhcRn) GhcRn) -> TcRnMessage
- TcRnDeprecatedInvisTyArgInConPat :: TcRnMessage
- TcRnLoopySuperclassSolve :: CtLoc -> PredType -> TcRnMessage
- TcRnUnexpectedStandaloneDerivingDecl :: TcRnMessage
- TcRnUnusedVariableInRuleDecl :: FastString -> Name -> TcRnMessage
- TcRnUnexpectedStandaloneKindSig :: TcRnMessage
- TcRnIllegalRuleLhs :: RuleLhsErrReason -> FastString -> LHsExpr GhcRn -> HsExpr GhcRn -> TcRnMessage
- TcRnDuplicateRoleAnnot :: NonEmpty (LRoleAnnotDecl GhcPs) -> TcRnMessage
- TcRnDuplicateKindSig :: NonEmpty (LStandaloneKindSig GhcPs) -> TcRnMessage
- TcRnIllegalDerivStrategy :: DerivStrategy GhcPs -> TcRnMessage
- TcRnIllegalMultipleDerivClauses :: TcRnMessage
- TcRnNoDerivStratSpecified :: Bool -> TcRnMessage
- TcRnStupidThetaInGadt :: HsDocContext -> TcRnMessage
- TcRnShadowedTyVarNameInFamResult :: IdP GhcPs -> TcRnMessage
- TcRnIncorrectTyVarOnLhsOfInjCond :: IdP GhcRn -> LIdP GhcPs -> TcRnMessage
- TcRnUnknownTyVarsOnRhsOfInjCond :: [Name] -> TcRnMessage
- TcRnLookupInstance :: !Class -> ![Type] -> !LookupInstanceErrReason -> TcRnMessage
- TcRnBadlyStaged :: !StageCheckReason -> !Int -> !Int -> TcRnMessage
- TcRnStageRestriction :: !StageCheckReason -> TcRnMessage
- TcRnTyThingUsedWrong :: !WrongThingSort -> !TcTyThing -> !Name -> TcRnMessage
- TcRnCannotDefaultKindVar :: !TyVar -> !Kind -> TcRnMessage
- TcRnUninferrableTyVar :: ![TyCoVar] -> !UninferrableTyVarCtx -> TcRnMessage
- TcRnSkolemEscape :: ![TcTyVar] -> !TcTyVar -> !Type -> TcRnMessage
- TcRnPatSynEscapedCoercion :: !Id -> !(NonEmpty CoVar) -> TcRnMessage
- TcRnPatSynExistentialInResult :: !Name -> !TcSigmaType -> ![TyVar] -> TcRnMessage
- TcRnPatSynArityMismatch :: !Name -> !Arity -> !Arity -> TcRnMessage
- TcRnPatSynInvalidRhs :: !Name -> !(LPat GhcRn) -> ![LIdP GhcRn] -> !PatSynInvalidRhsReason -> TcRnMessage
- TcRnZonkerMessage :: ZonkerMessage -> TcRnMessage
- TcRnTyFamDepsDisabled :: TcRnMessage
- TcRnAbstractClosedTyFamDecl :: TcRnMessage
- TcRnPartialFieldSelector :: !FieldLabel -> TcRnMessage
- TcRnBadFieldAnnotation :: !Int -> !DataCon -> !BadFieldAnnotationReason -> TcRnMessage
- TcRnSuperclassCycle :: !SuperclassCycle -> TcRnMessage
- TcRnDefaultSigMismatch :: !Id -> !Type -> TcRnMessage
- TcRnTyFamsDisabled :: !TyFamsDisabledReason -> TcRnMessage
- TcRnBadTyConTelescope :: !TyCon -> TcRnMessage
- TcRnTyFamResultDisabled :: !Name -> !(LHsTyVarBndr () GhcRn) -> TcRnMessage
- TcRnRoleValidationFailed :: !Role -> !RoleValidationFailedReason -> TcRnMessage
- TcRnCommonFieldResultTypeMismatch :: !DataCon -> !DataCon -> !FieldLabelString -> TcRnMessage
- TcRnCommonFieldTypeMismatch :: !DataCon -> !DataCon -> !FieldLabelString -> TcRnMessage
- TcRnClassExtensionDisabled :: !Class -> !DisabledClassExtension -> TcRnMessage
- TcRnDataConParentTypeMismatch :: !DataCon -> !Type -> TcRnMessage
- TcRnGADTsDisabled :: !Name -> TcRnMessage
- TcRnExistentialQuantificationDisabled :: !DataCon -> TcRnMessage
- TcRnGADTDataContext :: !Name -> TcRnMessage
- TcRnMultipleConForNewtype :: !Name -> !Int -> TcRnMessage
- TcRnKindSignaturesDisabled :: !(Either (HsType GhcPs) (Name, HsType GhcRn)) -> TcRnMessage
- TcRnEmptyDataDeclsDisabled :: !Name -> TcRnMessage
- TcRnRoleMismatch :: !Name -> !Role -> !Role -> TcRnMessage
- TcRnRoleCountMismatch :: !Int -> !(LRoleAnnotDecl GhcRn) -> TcRnMessage
- TcRnIllegalRoleAnnotation :: !(RoleAnnotDecl GhcRn) -> TcRnMessage
- TcRnRoleAnnotationsDisabled :: !TyCon -> TcRnMessage
- TcRnIncoherentRoles :: !TyCon -> TcRnMessage
- TcRnPrecedenceParsingError :: (OpName, Fixity) -> (OpName, Fixity) -> TcRnMessage
- TcRnSectionPrecedenceError :: (OpName, Fixity) -> (OpName, Fixity) -> HsExpr GhcPs -> TcRnMessage
- TcRnTypeSynonymCycle :: !TySynCycleTyCons -> TcRnMessage
- TcRnSelfImport :: !ModuleName -> TcRnMessage
- TcRnNoExplicitImportList :: !ModuleName -> TcRnMessage
- TcRnSafeImportsDisabled :: !ModuleName -> TcRnMessage
- TcRnDeprecatedModule :: !ModuleName -> !(WarningTxt GhcRn) -> TcRnMessage
- TcRnCompatUnqualifiedImport :: !(ImportDecl GhcPs) -> TcRnMessage
- TcRnRedundantSourceImport :: !ModuleName -> TcRnMessage
- TcRnImportLookup :: !ImportLookupReason -> TcRnMessage
- TcRnUnusedImport :: !(ImportDecl GhcRn) -> !UnusedImportReason -> TcRnMessage
- TcRnDuplicateDecls :: !OccName -> !(NonEmpty Name) -> TcRnMessage
- TcRnPackageImportsDisabled :: TcRnMessage
- TcRnIllegalDataCon :: !RdrName -> TcRnMessage
- TcRnNestedForallsContexts :: !NestedForallsContextsIn -> TcRnMessage
- TcRnRedundantRecordWildcard :: TcRnMessage
- TcRnUnusedRecordWildcard :: ![Name] -> TcRnMessage
- TcRnUnusedName :: !OccName -> !UnusedNameProv -> TcRnMessage
- TcRnQualifiedBinder :: !RdrName -> TcRnMessage
- TcRnTypeApplicationsDisabled :: !TypeApplication -> TcRnMessage
- TcRnInvalidRecordField :: !Name -> !FieldLabelString -> TcRnMessage
- TcRnTupleTooLarge :: !Int -> TcRnMessage
- TcRnCTupleTooLarge :: !Int -> TcRnMessage
- TcRnIllegalInferredTyVars :: !(NonEmpty (HsTyVarBndr Specificity GhcPs)) -> TcRnMessage
- TcRnAmbiguousName :: !GlobalRdrEnv -> !RdrName -> !(NonEmpty GlobalRdrElt) -> TcRnMessage
- TcRnBindingNameConflict :: !RdrName -> !(NonEmpty SrcSpan) -> TcRnMessage
- TcRnNonCanonicalDefinition :: !NonCanonicalDefinition -> !(LHsSigType GhcRn) -> TcRnMessage
- TcRnImplicitImportOfPrelude :: TcRnMessage
- TcRnMissingMain :: !Bool -> !Module -> !OccName -> TcRnMessage
- TcRnGhciUnliftedBind :: !Id -> TcRnMessage
- TcRnGhciMonadLookupFail :: String -> Maybe [GlobalRdrElt] -> TcRnMessage
- TcRnMissingRoleAnnotation :: Name -> [Role] -> TcRnMessage
- TcRnPatersonCondFailure :: PatersonCondFailure -> PatersonCondFailureContext -> Type -> Type -> TcRnMessage
- TcRnImplicitRhsQuantification :: LocatedN RdrName -> TcRnMessage
- data TcRnMessageDetailed = TcRnMessageDetailed !ErrInfo !TcRnMessage
- stripTcRnMessageContext :: TcRnMessage -> TcRnMessage
- data PsMessage = PsHeaderMessage !PsHeaderMessage
- data DsMessage
- = DsUnknownMessage (UnknownDiagnostic (DiagnosticOpts DsMessage))
- | DsEmptyEnumeration
- | DsIdentitiesFound !Id !Type
- | DsOverflowedLiterals !Integer !Name !(Maybe (MinBound, MaxBound)) !NegLiteralExtEnabled
- | DsRedundantBangPatterns !(HsMatchContext GhcTc) !SDoc
- | DsOverlappingPatterns !(HsMatchContext GhcTc) !SDoc
- | DsInaccessibleRhs !(HsMatchContext GhcTc) !SDoc
- | DsMaxPmCheckModelsReached !MaxPmCheckModels
- | DsNonExhaustivePatterns !(HsMatchContext GhcTc) !ExhaustivityCheckType !MaxUncoveredPatterns [Id] [Nabla]
- | DsTopLevelBindsNotAllowed !BindsType !(HsBindLR GhcTc GhcTc)
- | DsUselessSpecialiseForClassMethodSelector !Id
- | DsUselessSpecialiseForNoInlineFunction !Id
- | DsMultiplicityCoercionsNotSupported
- | DsOrphanRule !CoreRule
- | DsRuleLhsTooComplicated !CoreExpr !CoreExpr
- | DsRuleIgnoredDueToConstructor !DataCon
- | DsRuleBindersNotBound ![Var] ![Var] !CoreExpr !CoreExpr
- | DsLazyPatCantBindVarsOfUnliftedType [Var]
- | DsNotYetHandledByTH !ThRejectionReason
- | DsAggregatedViewExpressions [[LHsExpr GhcTc]]
- | DsUnbangedStrictPatterns !(HsBindLR GhcTc GhcTc)
- | DsCannotMixPolyAndUnliftedBindings !(HsBindLR GhcTc GhcTc)
- | DsWrongDoBind !(LHsExpr GhcTc) !Type
- | DsUnusedDoBind !(LHsExpr GhcTc) !Type
- | DsRecBindsNotAllowedForUnliftedTys ![LHsBindLR GhcTc GhcTc]
- | DsRuleMightInlineFirst !RuleName !Var !Activation
- | DsAnotherRuleMightFireFirst !RuleName !RuleName !Var
- data DriverMessage where
- DriverUnknownMessage :: UnknownDiagnostic (DiagnosticOpts DriverMessage) -> DriverMessage
- DriverPsHeaderMessage :: !PsMessage -> DriverMessage
- DriverMissingHomeModules :: UnitId -> [ModuleName] -> !BuildingCabalPackage -> DriverMessage
- DriverUnknownReexportedModules :: UnitId -> [ModuleName] -> DriverMessage
- DriverUnknownHiddenModules :: UnitId -> [ModuleName] -> DriverMessage
- DriverUnusedPackages :: [(UnitId, PackageName, Version, PackageArg)] -> DriverMessage
- DriverUnnecessarySourceImports :: !ModuleName -> DriverMessage
- DriverDuplicatedModuleDeclaration :: !Module -> [FilePath] -> DriverMessage
- DriverModuleNotFound :: !ModuleName -> DriverMessage
- DriverFileModuleNameMismatch :: !ModuleName -> !ModuleName -> DriverMessage
- DriverUnexpectedSignature :: !ModuleName -> !BuildingCabalPackage -> GenInstantiations UnitId -> DriverMessage
- DriverFileNotFound :: !FilePath -> DriverMessage
- DriverStaticPointersNotSupported :: DriverMessage
- DriverBackpackModuleNotFound :: !ModuleName -> DriverMessage
- DriverUserDefinedRuleIgnored :: !(RuleDecl GhcTc) -> DriverMessage
- DriverMixedSafetyImport :: !ModuleName -> DriverMessage
- DriverCannotLoadInterfaceFile :: !Module -> DriverMessage
- DriverInferredSafeModule :: !Module -> DriverMessage
- DriverMarkedTrustworthyButInferredSafe :: !Module -> DriverMessage
- DriverInferredSafeImport :: !Module -> DriverMessage
- DriverCannotImportUnsafeModule :: !Module -> DriverMessage
- DriverMissingSafeHaskellMode :: !Module -> DriverMessage
- DriverPackageNotTrusted :: !UnitState -> !UnitId -> DriverMessage
- DriverCannotImportFromUntrustedPackage :: !UnitState -> !Module -> DriverMessage
- DriverRedirectedNoMain :: !ModuleName -> DriverMessage
- DriverHomePackagesNotClosed :: ![UnitId] -> DriverMessage
- DriverInterfaceError :: !IfaceMessage -> DriverMessage
- DriverInconsistentDynFlags :: String -> DriverMessage
- DriverSafeHaskellIgnoredExtension :: !Extension -> DriverMessage
- DriverPackageTrustIgnored :: DriverMessage
- DriverUnrecognisedFlag :: String -> DriverMessage
- DriverDeprecatedFlag :: String -> String -> DriverMessage
- class HasDefaultDiagnosticOpts (DiagnosticOpts a) => Diagnostic a where
- type DiagnosticOpts a
- diagnosticMessage :: DiagnosticOpts a -> a -> DecoratedSDoc
- diagnosticReason :: a -> DiagnosticReason
- diagnosticHints :: a -> [GhcHint]
- diagnosticCode :: a -> Maybe DiagnosticCode
- _TcRnMessage :: Prism' GhcMessage TcRnMessage
- _GhcPsMessage :: Prism' GhcMessage PsMessage
- _GhcDsMessage :: Prism' GhcMessage DsMessage
- _GhcDriverMessage :: Prism' GhcMessage DriverMessage
Top-level error types and lens for easy access
data MsgEnvelope e #
An envelope for GHC's facts about a running program, parameterised over the domain-specific (i.e. parsing, typecheck-renaming, etc) diagnostics.
To say things differently, GHC emits diagnostics about the running
program, each of which is wrapped into a MsgEnvelope
that carries
specific information like where the error happened, etc. Finally, multiple
MsgEnvelope
s are aggregated into Messages
that are returned to the
user.
Constructors
MsgEnvelope | |
Fields
|
Instances
msgEnvelopeErrorL :: forall e f. Functor f => (e -> f e) -> MsgEnvelope e -> f (MsgEnvelope e) Source #
data GhcMessage where #
The umbrella type that encompasses all the different messages that GHC might output during the different compilation stages. See Note [GhcMessage].
Constructors
GhcPsMessage :: PsMessage -> GhcMessage | A message from the parsing phase. |
GhcTcRnMessage :: TcRnMessage -> GhcMessage | A message from typecheck/renaming phase. |
GhcDsMessage :: DsMessage -> GhcMessage | A message from the desugaring (HsToCore) phase. |
GhcDriverMessage :: DriverMessage -> GhcMessage | A message from the driver. |
GhcUnknownMessage :: UnknownDiagnostic (DiagnosticOpts GhcMessage) -> GhcMessage | An "escape" hatch which can be used when we don't know the source of
the message or if the message is not one of the typed ones. The
|
Instances
Error messages for the typechecking and renamer phase
data TcRnMessage where #
An error which might arise during typechecking/renaming.
Constructors
TcRnUnknownMessage :: UnknownDiagnostic (DiagnosticOpts TcRnMessage) -> TcRnMessage | Simply wraps an unknown |
TcRnInterfaceError :: !IfaceMessage -> TcRnMessage | Wrap an |
TcRnMessageWithInfo | TcRnMessageWithInfo is a constructor which is used when extra information is needed
to be provided in order to qualify a diagnostic and where it was originated (and why).
It carries an extra |
Fields
| |
TcRnWithHsDocContext :: !HsDocContext -> !TcRnMessage -> TcRnMessage | TcRnWithHsDocContext annotates an error message with the context in which it originated. |
TcRnSolverReport :: SolverReportWithCtxt -> DiagnosticReason -> [GhcHint] -> TcRnMessage | TcRnSolverReport is the constructor used to report unsolved constraints after constraint solving, as well as other errors such as hole fit errors. See the documentation of |
TcRnSolverDepthError :: !Type -> !SubGoalDepth -> TcRnMessage | TcRnSolverDepthError is an error that occurs when the constraint solver exceeds the maximum recursion depth. Example: class C a where { meth :: a } instance Cls [a] => Cls a where { meth = head . meth } t :: () t = meth Test cases: T7788 T8550 T9554 T15316A T17267{∅,a,b,c,e} T17458 ContextStack1 T22924b TcCoercibleFail |
TcRnRedundantConstraints | TcRnRedundantConstraints is a warning that is emitted when a binding has a user-written type signature which contains superfluous constraints. Example: f :: (Eq a, Ord a) => a -> a -> a f x y = (x < y) || x == y -- `Eq a` is superfluous: the `Ord a` constraint suffices. Test cases: T9939, T10632, T18036a, T20602, PluralS, T19296. |
Fields
| |
TcRnInaccessibleCode | TcRnInaccessibleCode is a warning that is emitted when the RHS of a pattern match is inaccessible, because the constraint solver has detected a contradiction. Example: data B a where { MkTrue :: B True; MkFalse :: B False } foo :: B False -> Bool foo MkFalse = False foo MkTrue = True -- Inaccessible: requires True ~ False Test cases: T7293, T7294, T15558, T17646, T18572, T18610, tcfail167. |
Fields
| |
TcRnInaccessibleCoAxBranch | TcRnInaccessibleCoAxBranch is a warning that is emitted when a closed type family has a branch which is inaccessible due to a more general, prior branch. Example: type family F a where F a = Int F Bool = Bool Test cases: T9085, T14066a, T9085, T6018, tc265, |
Fields
| |
TcRnTypeDoesNotHaveFixedRuntimeRep :: !Type -> !FixedRuntimeRepProvenance -> !ErrInfo -> TcRnMessage | A type which was expected to have a fixed runtime representation does not have a fixed runtime representation. Example: data D (a :: TYPE r) = MkD a Test cases: T11724, T18534, RepPolyPatSynArg, RepPolyPatSynUnliftedNewtype, RepPolyPatSynRes, T20423 |
TcRnImplicitLift :: Name -> !ErrInfo -> TcRnMessage | TcRnImplicitLift is a warning (controlled with -Wimplicit-lift) that occurs when
a Template Haskell quote implicitly uses Example: warning1 :: Lift t => t -> Q Exp warning1 x = [| x |] Test cases: th/T17804 |
TcRnUnusedPatternBinds :: HsBind GhcRn -> TcRnMessage | TcRnUnusedPatternBinds is a warning (controlled with -Wunused-pattern-binds) that occurs if a pattern binding binds no variables at all, unless it is a lone wild-card pattern, or a banged pattern. Example: Just _ = rhs3 -- Warning: unused pattern binding (_, _) = rhs4 -- Warning: unused pattern binding _ = rhs3 -- No warning: lone wild-card pattern !() = rhs4 -- No warning: banged pattern; behaves like seq Test cases: rename/{T13646,T17c,T17e,T7085} |
TcRnUnusedQuantifiedTypeVar | TcRnUnusedQuantifiedTypeVar is a warning that occurs if there are unused quantified type variables. Examples: f :: forall a. Int -> Char Test cases: renameshould_compileExplicitForAllRules1 renameshould_compileT5331 |
Fields
| |
TcRnDodgyImports :: !DodgyImportsReason -> TcRnMessage | TcRnDodgyImports is a group of warnings (controlled with -Wdodgy-imports). See |
TcRnDodgyExports :: GlobalRdrElt -> TcRnMessage | TcRnDodgyExports is a warning (controlled by -Wdodgy-exports) that occurs when
an export of the form 'T(..)' for a type constructor Example: module Foo ( T(..) -- Warning: T is a type synonym , A(..) -- Warning: A is a type family , C(..) -- Warning: C is a data family ) where type T = Int type family A :: * -> * data family C :: * -> * Test cases: warningsshould_compileDodgyExports01 |
TcRnMissingImportList :: IE GhcPs -> TcRnMessage | TcRnMissingImportList is a warning (controlled by -Wmissing-import-lists) that occurs when an import declaration does not explicitly list all the names brought into scope. Test cases: renameshould_compileT4489 |
TcRnUnsafeDueToPlugin :: TcRnMessage | When a module marked trustworthy or unsafe (using -XTrustworthy or -XUnsafe) is compiled with a plugin, the TcRnUnsafeDueToPlugin warning (controlled by -Wunsafe) is used as the reason the module was inferred to be unsafe. This warning is not raised if the -fplugin-trustworthy flag is passed. Test cases: plugins/T19926 |
TcRnModMissingRealSrcSpan :: Module -> TcRnMessage | TcRnModMissingRealSrcSpan is an error that occurs when compiling a module that lacks
an associated Test cases: None |
TcRnIdNotExportedFromModuleSig :: Name -> Module -> TcRnMessage | TcRnIdNotExportedFromModuleSig is an error pertaining to backpack that occurs when an identifier required by a signature is not exported by the module or signature that is being used as a substitution for that signature. Example(s): None Test cases: backpackshould_failbkpfail36 |
TcRnIdNotExportedFromLocalSig :: Name -> TcRnMessage | TcRnIdNotExportedFromLocalSig is an error pertaining to backpack that occurs when an identifier which is necessary for implementing a module signature is not exported from that signature. Example(s): None Test cases: backpackshould_failbkpfail30 backpackshould_failbkpfail31 backpackshould_failbkpfail34 |
TcRnShadowedName :: OccName -> ShadowedNameProvenance -> TcRnMessage | TcRnShadowedName is a warning (controlled by -Wname-shadowing) that occurs whenever an inner-scope value has the same name as an outer-scope value, i.e. the inner value shadows the outer one. This can catch typographical errors that turn into hard-to-find bugs. The warning is suppressed for names beginning with an underscore. Examples(s):
f = ... let f = id in ... f ... -- NOT OK, Test cases: typecheckshould_compileT10971a renameshould_compilern039 renameshould_compilern064 renameshould_compileT1972 renameshould_failT2723 renameshould_compileT3262 driver/werror |
TcRnInvalidWarningCategory :: !WarningCategory -> TcRnMessage | TcRnInvalidWarningCategory is an error that occurs when a warning is declared with a category name that is not the special category "deprecations", and either does not begin with the prefix "x-" indicating a user-defined category, or contains characters not valid in category names. See Note [Warning categories] in GHC.Unit.Module.Warnings Examples(s): module M {-# WARNING in "invalid" Oops #-} where {-# WARNING in "x- spaces not allowed" foo Oops #-} Test cases: warningsshould_failWarningCategoryInvalid |
TcRnDuplicateWarningDecls :: !(LocatedN RdrName) -> !RdrName -> TcRnMessage | TcRnDuplicateWarningDecls is an error that occurs whenever a warning is declared twice. Examples(s): {-# DEPRECATED foo "Don't use me" #-} {-# DEPRECATED foo "Don't use me" #-} foo :: Int foo = 2 Test cases: renameshould_failrnfail058 |
TcRnSimplifierTooManyIterations | TcRnSimplifierTooManyIterations is an error that occurs whenever the constraint solver in the simplifier hits the iterations' limit. Examples(s): None. Test cases: None. |
Fields
| |
TcRnIllegalPatSynDecl :: !(LIdP GhcPs) -> TcRnMessage | TcRnIllegalPatSynDecl is an error that occurs whenever there is an illegal pattern synonym declaration. Examples(s): varWithLocalPatSyn x = case x of P -> () where pattern P = () -- not valid, it can't be local, it must be defined at top-level. Test cases: patsynshould_faillocal |
TcRnLinearPatSyn :: !Type -> TcRnMessage | TcRnLinearPatSyn is an error that occurs whenever a pattern synonym signature uses a field that is not unrestricted. Example(s): None Test cases: linearshould_failLinearPatSyn2 |
TcRnEmptyRecordUpdate :: TcRnMessage | TcRnEmptyRecordUpdate is an error that occurs whenever a record is updated without specifying any field. Examples(s): $(deriveJSON defaultOptions{} ''Bad) -- not ok, no fields selected for update of defaultOptions Test cases: th/T12788 |
TcRnIllegalFieldPunning :: !(Located RdrName) -> TcRnMessage | TcRnIllegalFieldPunning is an error that occurs whenever
field punning is used without the Examples(s): data Foo = Foo { a :: Int } foo :: Foo -> Int foo Foo{a} = a -- Not ok, punning used without extension. Test cases: parsershould_failRecordDotSyntaxFail12 |
TcRnIllegalWildcardsInRecord :: !RecordFieldPart -> TcRnMessage | TcRnIllegalWildcardsInRecord is an error that occurs whenever wildcards (..) are used in a record without the relevant extension being enabled. Examples(s): data Foo = Foo { a :: Int } foo :: Foo -> Int foo Foo{..} = a -- Not ok, wildcards used without extension. Test cases: parsershould_failRecordWildCardsFail |
TcRnIllegalWildcardInType | TcRnIllegalWildcardInType is an error that occurs when a wildcard appears in a type in a location in which wildcards aren't allowed. Examples: Type synonyms: type T = _ Class declarations and instances: class C _ instance C _ Standalone kind signatures: type D :: _ data D Test cases: ExtraConstraintsWildcardInTypeSplice2 ExtraConstraintsWildcardInTypeSpliceUsed ExtraConstraintsWildcardNotLast ExtraConstraintsWildcardTwice NestedExtraConstraintsWildcard NestedNamedExtraConstraintsWildcard PartialClassMethodSignature PartialClassMethodSignature2 T12039 T13324_fail1 UnnamedConstraintWildcard1 UnnamedConstraintWildcard2 WildcardInADT1 WildcardInADT2 WildcardInADT3 WildcardInADTContext1 WildcardInDefault WildcardInDefaultSignature WildcardInDeriving WildcardInForeignExport WildcardInForeignImport WildcardInGADT1 WildcardInGADT2 WildcardInInstanceHead WildcardInInstanceSig WildcardInNewtype WildcardInPatSynSig WildcardInStandaloneDeriving WildcardInTypeFamilyInstanceRHS WildcardInTypeSynonymRHS saks_fail003 T15433a |
Fields
| |
TcRnDuplicateFieldName :: !RecordFieldPart -> NonEmpty RdrName -> TcRnMessage | TcRnDuplicateFieldName is an error that occurs whenever there are duplicate field names in a single record. Examples(s): data R = MkR { x :: Int, x :: Bool } f r = r { x = 3, x = 4 } Test cases: T21959. |
TcRnIllegalViewPattern :: !(Pat GhcPs) -> TcRnMessage | TcRnIllegalViewPattern is an error that occurs whenever the ViewPatterns syntax is used but the ViewPatterns language extension is not enabled. Examples(s): data Foo = Foo { a :: Int } foo :: Foo -> Int
foo (a -> l) = l -- not OK, the Test cases: parsershould_failViewPatternsFail |
TcRnCharLiteralOutOfRange :: !Char -> TcRnMessage | TcRnCharLiteralOutOfRange is an error that occurs whenever a character is out of range. Examples(s): None Test cases: None |
TcRnNegativeNumTypeLiteral :: HsType GhcPs -> TcRnMessage | TcRnNegativeNumTypeLiteral is an error that occurs whenever a type-level number literal is negative. type Neg = -1 Test cases: th/T8412 typecheckshould_failT8306 |
TcRnIllegalWildcardsInConstructor :: !Name -> TcRnMessage | TcRnIllegalWildcardsInConstructor is an error that occurs whenever the record wildcards '..' are used inside a constructor without labeled fields. Examples(s): None Test cases: renameshould_failT9815.hs renameshould_failT9815b.hs renameshould_failT9815ghci.hs renameshould_failT9815bghci.hs |
TcRnIgnoringAnnotations :: [LAnnDecl GhcRn] -> TcRnMessage | TcRnIgnoringAnnotations is a warning that occurs when the source code contains annotation pragmas but the platform in use does not support an external interpreter such as GHCi and therefore the annotations are ignored. Example(s): None Test cases: None |
TcRnAnnotationInSafeHaskell :: TcRnMessage | TcRnAnnotationInSafeHaskell is an error that occurs if annotation pragmas are used in conjunction with Safe Haskell. Example(s): None Test cases: annotationsshould_failT10826 |
TcRnInvalidTypeApplication :: Type -> LHsWcType GhcRn -> TcRnMessage | TcRnInvalidTypeApplication is an error that occurs when a visible type application is used with an expression that does not accept "specified" type arguments. Example(s): foo :: forall {a}. a -> a foo x = x bar :: () bar = let x = foo @Int 42 in () Test cases: overloadedrecfldsshould_failoverloadedlabelsfail03 typecheckshould_failExplicitSpecificity1 typecheckshould_failExplicitSpecificity10 typecheckshould_failExplicitSpecificity2 typecheckshould_failT17173 typecheckshould_failVtaFail |
TcRnTagToEnumMissingValArg :: TcRnMessage | TcRnTagToEnumMissingValArg is an error that occurs when the 'tagToEnum#' function is not applied to a single value argument. Example(s): tagToEnum# 1 2 Test cases: None |
TcRnTagToEnumUnspecifiedResTy :: Type -> TcRnMessage | TcRnTagToEnumUnspecifiedResTy is an error that occurs when the 'tagToEnum#' function is not given a concrete result type. Example(s): foo :: forall a. a foo = tagToEnum# 0# Test cases: typecheckshould_failtcfail164 |
TcRnTagToEnumResTyNotAnEnum :: Type -> TcRnMessage | TcRnTagToEnumResTyNotAnEnum is an error that occurs when the 'tagToEnum#' function is given a result type that is not an enumeration type. Example(s): foo :: Int -- not an enumeration TyCon foo = tagToEnum# 0# Test cases: typecheckshould_failtcfail164 |
TcRnTagToEnumResTyTypeData :: Type -> TcRnMessage | TcRnTagToEnumResTyTypeData is an error that occurs when the 'tagToEnum#'
function is given a result type that is headed by a Example(s): type data Letter = A | B | C foo :: Letter foo = tagToEnum# 0# Test cases: type-datashould_failTDTagToEnum.hs |
TcRnArrowIfThenElsePredDependsOnResultTy :: TcRnMessage | TcRnArrowIfThenElsePredDependsOnResultTy is an error that occurs when the predicate type of an ifThenElse expression in arrow notation depends on the type of the result. Example(s): None Test cases: None |
TcRnIllegalHsBootOrSigDecl :: !HsBootOrSig -> !BadBootDecls -> TcRnMessage | TcRnIllegalHsBootOrSigDecl is an error that occurs when an hs-boot file contains declarations that are not allowed, such as bindings. Examples:
Test cases:
|
TcRnBootMismatch :: !HsBootOrSig -> !BootMismatch -> TcRnMessage | TcRnBootMismatch is a family of errors that occur when there is a mismatch between the hs-boot and hs files. Examples:
data D = MkD Int Test cases:
|
TcRnRecursivePatternSynonym :: LHsBinds GhcRn -> TcRnMessage | TcRnRecursivePatternSynonym is an error that occurs when a pattern synonym is defined in terms of itself, either directly or indirectly. Example(s): pattern A = B pattern B = A Test cases: patsynshould_failT16900 |
TcRnPartialTypeSigTyVarMismatch | TcRnPartialTypeSigTyVarMismatch is an error that occurs when a partial type signature attempts to unify two different types. Example(s): f :: a -> b -> _ f x y = [x, y] Test cases: partial-sigsshould_failT14449 |
Fields
| |
TcRnPartialTypeSigBadQuantifier | TcRnPartialTypeSigBadQuantifier is an error that occurs when a type variable being quantified over in the partial type signature of a function gets unified with a type that is free in that function's context. Example(s): foo :: Num a => a -> a foo xxx = g xxx where g :: forall b. Num b => _ -> b g y = xxx + y Test cases: partial-sigshould_failT14479 |
Fields
| |
TcRnMissingSignature :: MissingSignature -> Exported -> TcRnMessage | TcRnMissingSignature is a warning that occurs when a top-level binding or a pattern synonym does not have a type signature. Controlled by the flags: -Wmissing-signatures -Wmissing-exported-signatures -Wmissing-pattern-synonym-signatures -Wmissing-exported-pattern-synonym-signatures -Wmissing-kind-signatures -Wmissing-poly-kind-signatures Test cases: T11077 (top-level bindings) T12484 (pattern synonyms) T19564 (kind signatures) |
TcRnPolymorphicBinderMissingSig :: Name -> Type -> TcRnMessage | TcRnPolymorphicBinderMissingSig is a warning controlled by -Wmissing-local-signatures that occurs when a local polymorphic binding lacks a type signature. Example(s): id a = a Test cases: warningsshould_compileT12574 |
TcRnOverloadedSig :: TcIdSigInfo -> TcRnMessage | TcRnOverloadedSig is an error that occurs when a binding group conflicts with the monomorphism restriction. Example(s): data T a = T a mono = ... where x :: Applicative f => f a T x = ... Test cases: typecheckshould_compileT11339 |
TcRnTupleConstraintInst :: !Class -> TcRnMessage | TcRnTupleConstraintInst is an error that occurs whenever an instance for a tuple constraint is specified. Examples(s): class C m a class D m a f :: (forall a. Eq a => (C m a, D m a)) => m a f = undefined Test cases: quantified-constraints/T15334 |
TcRnUserTypeError :: !Type -> TcRnMessage | TcRnUserTypeError is an error that occurs due to a user's custom type error,
which can be triggered by adding a Examples(s): f :: TypeError (Text "This is a type error") f = undefined Test cases: typecheckshould_failCustomTypeErrors02 typecheckshould_failCustomTypeErrors03 |
TcRnConstraintInKind :: !Type -> TcRnMessage | TcRnConstraintInKind is an error that occurs whenever a constraint is specified in a kind. Examples(s): data Q :: Eq a => Type where {} Test cases: dependentshould_failT13895 polykinds/T16263 saksshould_failsaks_fail004 typecheckshould_failT16059a typecheckshould_failT18714 |
TcRnUnboxedTupleOrSumTypeFuncArg | TcRnUnboxedTupleTypeFuncArg is an error that occurs whenever an unboxed tuple or unboxed sum type is specified as a function argument, when the appropriate extension (`-XUnboxedTuples` or `-XUnboxedSums`) isn't enabled. Examples(s): -- T15073.hs import T15073a newtype Foo a = MkFoo a deriving P
Test cases: derivingshould_failT15073.hs derivingshould_failT15073a.hs typecheckshould_failT16059d |
Fields
| |
TcRnLinearFuncInKind :: !Type -> TcRnMessage | TcRnLinearFuncInKind is an error that occurs whenever a linear function is specified in a kind. Examples(s): data A :: * %1 -> * Test cases: linearshould_failLinearKind linearshould_failLinearKind2 linearshould_failLinearKind3 |
TcRnForAllEscapeError :: !Type -> !Kind -> TcRnMessage | TcRnForAllEscapeError is an error that occurs whenever a quantified type's kind mentions quantified type variable. Examples(s): type T :: TYPE (BoxedRep l) data T = MkT Test cases: unlifted-datatypesshould_failUnlDataNullaryPoly |
TcRnVDQInTermType :: !(Maybe Type) -> TcRnMessage | TcRnVDQInTermType is an error that occurs whenever a visible dependent quantification is specified in the type of a term. Examples(s): a = (undefined :: forall k -> k -> Type) @Int Test cases: dependentshould_failT15859 dependentshould_failT16326_Fail1 dependentshould_failT16326_Fail2 dependentshould_failT16326_Fail3 dependentshould_failT16326_Fail4 dependentshould_failT16326_Fail5 dependentshould_failT16326_Fail6 dependentshould_failT16326_Fail7 dependentshould_failT16326_Fail8 dependentshould_failT16326_Fail9 dependentshould_failT16326_Fail10 dependentshould_failT16326_Fail11 dependentshould_failT16326_Fail12 dependentshould_failT17687 dependentshould_failT18271 |
TcRnBadQuantPredHead :: !Type -> TcRnMessage | TcRnBadQuantPredHead is an error that occurs whenever a quantified predicate lacks a class or type variable head. Examples(s): class (forall a. A t a => A t [a]) => B t where type A t a :: Constraint Test cases: quantified-constraints/T16474 |
TcRnIllegalTupleConstraint :: !Type -> TcRnMessage | TcRnIllegalTupleConstraint is an error that occurs whenever an illegal tuple constraint is specified. Examples(s): g :: ((Show a, Num a), Eq a) => a -> a g = undefined Test cases: typecheckshould_failtcfail209a |
TcRnNonTypeVarArgInConstraint :: !Type -> TcRnMessage | TcRnNonTypeVarArgInConstraint is an error that occurs whenever a non type-variable argument is specified in a constraint. Examples(s): data T instance Eq Int => Eq T Test cases: ghciscriptsT13202 ghciscriptsT13202a polykinds/T12055a typecheckshould_failT10351 typecheckshould_failT19187 typecheckshould_failT6022 typecheckshould_failT8883 |
TcRnIllegalImplicitParam :: !Type -> TcRnMessage | TcRnIllegalImplicitParam is an error that occurs whenever an illegal implicit parameter is specified. Examples(s): type Bla = ?x::Int data T = T instance Bla => Eq T Test cases: polykinds/T11466 typecheckshould_failT8912 typecheckshould_failtcfail041 typecheckshould_failtcfail211 typecheckshould_failtcrun045 |
TcRnIllegalConstraintSynonymOfKind :: !Type -> TcRnMessage | TcRnIllegalConstraintSynonymOfKind is an error that occurs whenever an illegal constraint synonym of kind is specified. Examples(s): type Showish = Show f :: (Showish a) => a -> a f = undefined Test cases: typecheckshould_failtcfail209 |
TcRnOversaturatedVisibleKindArg :: !Type -> TcRnMessage | TcRnOversaturatedVisibleKindArg is an error that occurs whenever an illegal oversaturated visible kind argument is specified. Examples(s): type family F2 :: forall (a :: Type). Type where F2 @a = Maybe a Test cases: typecheckshould_failT15793 typecheckshould_failT16255 |
TcRnForAllRankErr :: !Rank -> !Type -> TcRnMessage | TcRnForAllRankErr is an error that occurs whenever an illegal ranked type is specified. Examples(s): foo :: (a,b) -> (a~b => t) -> (a,b) foo p x = p Test cases: - ghcishould_runT15806 - indexed-typesshould_failSimpleFail15 - typecheckshould_failT11355 - typecheckshould_failT12083a - typecheckshould_failT12083b - typecheckshould_failT16059c - typecheckshould_failT16059e - typecheckshould_failT17213 - typecheckshould_failT18939_Fail - typecheckshould_failT2538 - typecheckshould_failT5957 - typecheckshould_failT7019 - typecheckshould_failT7019a - typecheckshould_failT7809 - typecheckshould_failT9196 - typecheckshould_failtcfail127 - typecheckshould_failtcfail184 - typecheckshould_failtcfail196 - typecheckshould_failtcfail197 |
TcRnSimplifiableConstraint :: !PredType -> !InstanceWhat -> TcRnMessage | TcRnSimplifiableConstraint is a warning triggered by the occurrence of a simplifiable constraint in a context, when MonoLocalBinds is not enabled. Examples(s): simplifiableEq :: Eq (a, a) => a -> a -> Bool simplifiableEq = undefined Test cases: - indexed-typesshould_compileT15322 - partial-sigsshould_compileSomethingShowable - typecheckshould_compileT13526 |
TcRnArityMismatch | TcRnArityMismatch is an error that occurs when a type constructor is supplied with fewer arguments than required. Examples(s): f Left = undefined Test cases: - backpackshould_failbkpfail25.bkp - ghcishould_failT16013 - ghcishould_failT16287 - indexed-typesshould_failBadSock - indexed-typesshould_failT9433 - module/mod60 - ndexed-typesshould_failT2157 - parsershould_failParserNoBinaryLiterals2 - parsershould_failParserNoBinaryLiterals3 - patsynshould_failT12819 - polykinds/T10516 - typecheckshould_failT12124 - typecheckshould_failT15954 - typecheckshould_failT16874 - typecheckshould_failtcfail100 - typecheckshould_failtcfail101 - typecheckshould_failtcfail107 - typecheckshould_failtcfail129 - typecheckshould_failtcfail187 |
Fields
| |
TcRnIllegalInstance :: IllegalInstanceReason -> TcRnMessage | TcRnIllegalClassInstance is a collection of diagnostics that arise from an invalid class or family instance declaration. |
TcRnMonomorphicBindings :: [Name] -> TcRnMessage | TcRnMonomorphicBindings is a warning (controlled by -Wmonomorphism-restriction) that arises when the monomorphism restriction applies to the given bindings. Examples(s): {-# OPTIONS_GHC -Wmonomorphism-restriction #-} bar = 10 foo :: Int foo = bar main :: IO () main = print foo The example above emits the warning (for Test cases: typecheckshould_compileT13785 |
TcRnOrphanInstance :: Either ClsInst FamInst -> TcRnMessage | TcRnOrphanInstance is a warning (controlled by -Worphans) that arises when a typeclass instance or family instance is an "orphan", i.e. if it appears in a module in which neither the class/family nor the type being instanced are declared in the same module. Examples(s): None Test cases: warningsshould_compileT9178 typecheckshould_compileT4912 |
TcRnFunDepConflict :: !UnitState -> NonEmpty ClsInst -> TcRnMessage | TcRnFunDepConflict is an error that occurs when there are functional dependencies conflicts between instance declarations. Examples(s): None Test cases: typecheckshould_failT2307 typecheckshould_failtcfail096 typecheckshould_failtcfail202 |
TcRnDupInstanceDecls :: !UnitState -> NonEmpty ClsInst -> TcRnMessage | TcRnDupInstanceDecls is an error that occurs when there are duplicate instance declarations. Examples(s): class Foo a where foo :: a -> Int instance Foo Int where foo = id instance Foo Int where foo = const 42 Test cases: cabalT12733T12733 typecheckshould_failtcfail035 typecheckshould_failtcfail023 backpackshould_failbkpfail18 typecheckshould_failTcNullaryTCFail typecheckshould_failtcfail036 typecheckshould_failtcfail073 module/mod51 module/mod52 module/mod44 |
TcRnConflictingFamInstDecls :: NonEmpty FamInst -> TcRnMessage | TcRnConflictingFamInstDecls is an error that occurs when there are conflicting family instance declarations. Examples(s): None. Test cases: indexed-typesshould_failExplicitForAllFams4b indexed-typesshould_failNoGood indexed-typesshould_failOver indexed-typesshould_failOverDirectThisMod indexed-typesshould_failOverIndirectThisMod indexed-typesshould_failSimpleFail11a indexed-typesshould_failSimpleFail11b indexed-typesshould_failSimpleFail11c indexed-typesshould_failSimpleFail11d indexed-typesshould_failSimpleFail2a indexed-typesshould_failSimpleFail2b indexed-typesshould_failT13092/T13092 indexed-typesshould_failT13092c/T13092c indexed-typesshould_failT14179 indexed-typesshould_failT2334A indexed-typesshould_failT2677 indexed-typesshould_failT3330b indexed-typesshould_failT4246 indexed-typesshould_failT7102a indexed-typesshould_failT9371 polykinds/T7524 typecheckshould_failUnliftedNewtypesOverlap |
TcRnFamInstNotInjective | TcRnFamInstNotInjective is a collection of errors that arise from a type family equation violating the injectivity annotation. See |
Fields
| |
TcRnBangOnUnliftedType :: !Type -> TcRnMessage | TcRnBangOnUnliftedType is a warning (controlled by -Wredundant-strictness-flags) that occurs when a strictness annotation is applied to an unlifted type. Example(s): data T = MkT !Int# -- Strictness flag has no effect on unlifted types Test cases: typecheckshould_compileT20187a typecheckshould_compileT20187b |
TcRnLazyBangOnUnliftedType :: !Type -> TcRnMessage | TcRnLazyBangOnUnliftedType is a warning (controlled by -Wredundant-strictness-flags) that occurs when a lazy annotation is applied to an unlifted type. Example(s): data T = MkT ~Int# -- Lazy flag has no effect on unlifted types Test cases: typecheckshould_compileT21951a typecheckshould_compileT21951b |
TcRnMultipleDefaultDeclarations :: [LDefaultDecl GhcRn] -> TcRnMessage | TcRnMultipleDefaultDeclarations is an error that occurs when a module has more than one default declaration. Example: default (Integer, Int) default (Double, Float) -- 2nd default declaration not allowed Text cases: module/mod58 |
TcRnBadDefaultType :: Type -> [Class] -> TcRnMessage | TcRnBadDefaultType is an error that occurs when a type used in a default declaration does not have an instance for any of the applicable classes. Example(s): data Foo default (Foo) Test cases: typecheckshould_failT11974b |
TcRnPatSynBundledWithNonDataCon :: TcRnMessage | TcRnPatSynBundledWithNonDataCon is an error that occurs when a module's export list bundles a pattern synonym with a type that is not a proper `data` or `newtype` construction. Example(s): module Foo (MyClass(.., P)) where pattern P = Nothing class MyClass a where foo :: a -> Int Test cases: patsynshould_failexport-class |
TcRnPatSynBundledWithWrongType :: Type -> Type -> TcRnMessage | TcRnPatSynBundledWithWrongType is an error that occurs when the export list of a module has a pattern synonym bundled with a type that does not match the type of the pattern synonym. Example(s): module Foo (R(P,x)) where data Q = Q Int data R = R pattern P{x} = Q x Text cases: patsynshould_failexport-ps-rec-sel patsynshould_failexport-type-synonym patsynshould_failexport-type |
TcRnDupeModuleExport :: ModuleName -> TcRnMessage | TcRnDupeModuleExport is a warning controlled by Example(s): module Foo (module Bar, module Bar) import Bar Text cases: None |
TcRnExportedModNotImported :: ModuleName -> TcRnMessage | TcRnExportedModNotImported is an error that occurs when an export list contains a module that is not imported. Example(s): None Text cases: module/mod135 module/mod8 renameshould_failrnfail028 backpackshould_failbkpfail48 |
TcRnNullExportedModule :: ModuleName -> TcRnMessage | TcRnNullExportedModule is a warning controlled by -Wdodgy-exports that occurs when an export list contains a module that has no exports. Example(s): module Foo (module Bar) where import Bar () Test cases: None |
TcRnMissingExportList :: ModuleName -> TcRnMessage | TcRnMissingExportList is a warning controlled by -Wmissing-export-lists that occurs when a module does not have an explicit export list. Example(s): None Test cases: typecheckshould_failMissingExportList03 |
TcRnExportHiddenComponents :: IE GhcPs -> TcRnMessage | TcRnExportHiddenComponents is an error that occurs when an export contains constructor or class methods that are not visible. Example(s): None Test cases: None |
TcRnDuplicateExport :: GlobalRdrElt -> IE GhcPs -> IE GhcPs -> TcRnMessage | TcRnDuplicateExport is a warning (controlled by -Wduplicate-exports) that occurs when an identifier appears in an export list more than once. Example(s): None Test cases: module/MultiExport module/mod128 module/mod14 module/mod5 overloadedrecfldsshould_failDuplicateExports patsynshould_compileT11959 |
TcRnExportedParentChildMismatch | TcRnExportedParentChildMismatch is an error that occurs when an export is bundled with a parent that it does not belong to Example(s): module Foo (T(a)) where data T a = True Test cases: module/T11970 module/T11970B module/mod17 module/mod3 overloadedrecfldsshould_failNoParent |
Fields
| |
TcRnConflictingExports | TcRnConflictingExports is an error that occurs when different identifiers that have the same name are being exported by a module. Example(s): module Foo (Bar.f, module Baz) where import qualified Bar (f) import Baz (f) Test cases: module/mod131 module/mod142 module/mod143 module/mod144 module/mod145 module/mod146 module/mod150 module/mod155 overloadedrecfldsshould_failT14953 overloadedrecfldsshould_failoverloadedrecfldsfail10 renameshould_failrnfail029 renameshould_failrnfail040 typecheckshould_failT16453E2 typecheckshould_failtcfail025 typecheckshould_failtcfail026 |
Fields
| |
TcRnDuplicateFieldExport :: (GlobalRdrElt, IE GhcPs) -> NonEmpty (GlobalRdrElt, IE GhcPs) -> TcRnMessage | TcRnDuplicateFieldExport is an error that occurs when a module exports multiple record fields with the same name, without enabling DuplicateRecordFields. Example: module M1 where data D1 = MkD1 { foo :: Int } module M2 where data D2 = MkD2 { foo :: Int } module M ( D1(..), D2(..) ) where import module M1 import module M2 Test case: overloadedrecfldsshould_failoverloadedrecfldsfail10 |
TcRnAmbiguousRecordUpdate | TcRnAmbiguousRecordUpdate is a warning, controlled by -Wambiguous-fields, which occurs when a user relies on the type-directed disambiguation mechanism to disambiguate a record update. This will not be supported by -XDuplicateRecordFields in future releases. Example(s): data Person = MkPerson { personId :: Int, name :: String } data Address = MkAddress { personId :: Int, address :: String } bad1 x = x { personId = 4 } :: Person -- ambiguous bad2 (x :: Person) = x { personId = 4 } -- ambiguous good x = (x :: Person) { personId = 4 } -- not ambiguous Test cases: overloadedrecfldsshould_failoverloadedrecfldsfail06 |
Fields
| |
TcRnMissingFields :: ConLike -> [(FieldLabelString, TcType)] -> TcRnMessage | TcRnMissingFields is a warning controlled by -Wmissing-fields occurring when the intialisation of a record is missing one or more (lazy) fields. Example(s):
data Rec = Rec { a :: Int, b :: String, c :: Bool }
x = Rec { a = 1, b = "two" } -- missing field Test cases: deSugarshould_compileT13870 deSugarshould_compileds041 patsynshould_compileT11283 renameshould_compileT5334 renameshould_compileT12229 renameshould_compileT5892a warningsshould_failWerrorFail2 |
TcRnFieldUpdateInvalidType :: [(FieldLabelString, TcType)] -> TcRnMessage | TcRnFieldUpdateInvalidType is an error occurring when an updated field's type mentions something that is outside the universally quantified variables of the data constructor, such as an existentially quantified type. Example(s): data X = forall a. MkX { f :: a } x = (MkX ()) { f = False } Test cases: patsynshould_failrecords-exquant typecheckshould_failT3323 |
TcRnMissingStrictFields :: ConLike -> [(FieldLabelString, TcType)] -> TcRnMessage | TcRnMissingStrictFields is an error occurring when a record field marked as strict is omitted when constructing said record. Example(s): data R = R { strictField :: !Bool, nonStrict :: Int } x = R { nonStrict = 1 } Test cases: typecheckshould_failT18869 typecheckshould_failtcfail085 typecheckshould_failtcfail112 |
TcRnAmbiguousFieldInUpdate :: (GlobalRdrElt, GlobalRdrElt, [GlobalRdrElt]) -> TcRnMessage | TcRnAmbiguousFieldInUpdate is an error that occurs when a field in a record update clashes with another field or top-level function of the same name, and the user hasn't enabled -XDisambiguateRecordFields. Example: {-# LANGUAGE NoFieldSelectors #-} {-# LANGUAGE NoDisambiguateRecordFields #-} module M where data A = MkA { fld :: Int } fld :: Bool fld = False f r = r { fld = 3 } |
TcRnBadRecordUpdate | TcRnBadRecordUpdate is an error when a regular (non-overloaded) record update cannot be pinned down to any one parent. The problem with the record update is stored in the Example(s): data R1 = R1 { x :: Int } data R2 = R2 { x :: Int } update r = r { x = 1 } -- ambiguous data R1 = R1 { x :: Int, y :: Int } data R2 = R2 { y :: Int, z :: Int } update r = r { x = 1, y = 2, z = 3 } -- no parent has all the fields Test cases: overloadedrecfldsshould_failoverloadedrecfldsfail01 overloadedrecfldsshould_failoverloadedrecfldsfail01 overloadedrecfldsshould_failoverloadedrecfldsfail14 |
Fields
| |
TcRnStaticFormNotClosed :: Name -> NotClosedReason -> TcRnMessage | TcRnStaticFormNotClosed is an error pertaining to terms that are marked static using the -XStaticPointers extension but which are not closed terms. Example(s): f x = static x Test cases: renameshould_failRnStaticPointersFail01 renameshould_failRnStaticPointersFail03 |
TcRnUselessTypeable :: TcRnMessage | TcRnUselessTypeable is a warning (controlled by -Wderiving-typeable) that
occurs when trying to derive an instance of the Example(s): None. Test cases: warningsshould_compileDerivingTypeable |
TcRnDerivingDefaults :: !Class -> TcRnMessage | TcRnDerivingDefaults is a warning (controlled by -Wderiving-defaults) that
occurs when both Example(s): None. Test cases: typecheckshould_compileT15839a derivingshould_compileT16179 |
TcRnNonUnaryTypeclassConstraint :: !(LHsSigType GhcRn) -> 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: derivingshould_failT7959 derivingshould_faildrvfail005 derivingshould_faildrvfail009 derivingshould_faildrvfail006 |
TcRnPartialTypeSignatures :: !SuggestPartialTypeSignatures -> !ThetaType -> 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: dependentshould_compileT11241 dependentshould_compileT15076 dependentshould_compileT14880-2 typecheckshould_compileT17024 typecheckshould_compileT10072 partial-sigsshould_failTidyClash2 partial-sigsshould_failDefaulting1MROff partial-sigsshould_failWildcardsInPatternAndExprSig partial-sigsshould_failT10615 partial-sigsshould_failT14584a partial-sigsshould_failTidyClash partial-sigsshould_failT11122 partial-sigsshould_failT14584 partial-sigsshould_failT10045 partial-sigsshould_failPartialTypeSignaturesDisabled partial-sigsshould_failT10999 partial-sigsshould_failExtraConstraintsWildcardInExpressionSignature partial-sigsshould_failExtraConstraintsWildcardInPatternSplice partial-sigsshould_failWildcardInstantiations partial-sigsshould_runT15415 partial-sigsshould_compileT10463 partial-sigsshould_compileT15039a partial-sigsshould_compileT16728b partial-sigsshould_compileT15039c partial-sigsshould_compileT10438 partial-sigsshould_compileSplicesUsed partial-sigsshould_compileT18008 partial-sigsshould_compileExprSigLocal partial-sigsshould_compileT11339a partial-sigsshould_compileT11670 partial-sigsshould_compileWarningWildcardInstantiations partial-sigsshould_compileT16728 partial-sigsshould_compileT12033 partial-sigsshould_compileT15039b partial-sigsshould_compileT10403 partial-sigsshould_compileT11192 partial-sigsshould_compileT16728a partial-sigsshould_compileTypedSplice partial-sigsshould_compileT15039d partial-sigsshould_compileT11016 partial-sigsshould_compileT13324_compile2 linearshould_failLinearPartialSig polykinds/T14265 polykinds/T14172 |
TcRnCannotDeriveInstance | TcRnCannotDeriveInstance is an error that occurs every time a typeclass instance
can't be derived. The Example(s): None. Test cases: genericsT10604T10604_no_PolyKinds derivingshould_faildrvfail009 derivingshould_faildrvfail-functor2 derivingshould_failT10598_fail3 derivingshould_failderiving-via-fail2 derivingshould_failderiving-via-fail derivingshould_failT16181 |
Fields
| |
TcRnLazyGADTPattern :: TcRnMessage | TcRnLazyGADTPattern is an error that occurs when a user writes a nested GADT pattern match inside a lazy (~) pattern. Test case: gadt/lazypat |
TcRnArrowProcGADTPattern :: TcRnMessage | TcRnArrowProcGADTPattern is an error that occurs when a user writes a GADT pattern inside arrow proc notation. Test case: arrowsshould_failarrowfail004. |
TcRnForallIdentifier :: RdrName -> TcRnMessage | TcRnForallIdentifier is a warning (controlled with -Wforall-identifier) that occurs
when a definition uses Example: forall x = () g forall = () Test cases: T20609 T20609a T20609b T20609c T20609d |
TcRnCapturedTermName :: RdrName -> Either [GlobalRdrElt] Name -> TcRnMessage | TcRnCapturedTermName is a warning (controlled by -Wterm-variable-capture) that occurs when an implicitly quantified type variable's name is already used for a term. Example: a = 10 f :: a -> a Test cases: T22513a T22513b T22513c T22513d T22513e T22513f T22513g T22513h T22513i |
TcRnBindVarAlreadyInScope :: [LocatedN RdrName] -> TcRnMessage | TcRnTypeMultipleOccurenceOfBindVar is an error that occurs if a bound type variable's name is already in use. Example: f :: forall a. ... f (MkT @a ...) = ... Test cases: TyAppPat_ScopedTyVarConflict TyAppPat_NonlinearMultiPat TyAppPat_NonlinearMultiAppPat |
TcRnBindMultipleVariables :: HsDocContext -> LocatedN RdrName -> TcRnMessage | TcRnBindMultipleVariables is an error that occurs in the case of multiple occurrences of a bound variable. Example: foo (MkFoo @(a,a) ...) = ... Test case: typecheckshould_failTyAppPat_NonlinearSinglePat |
TcRnTypeEqualityOutOfScope :: TcRnMessage | TcRnTypeEqualityOutOfScope is a warning (controlled by -Wtype-equality-out-of-scope) that occurs when the type equality (a ~ b) is not in scope. Test case: warningsshould_compileT18862b |
TcRnTypeEqualityRequiresOperators :: TcRnMessage | TcRnTypeEqualityRequiresOperators is a warning (controlled by -Wtype-equality-requires-operators) that occurs when the type equality (a ~ b) is used without the TypeOperators extension. Example: {-# LANGUAGE NoTypeOperators #-} f :: (a ~ b) => a -> b Test case: T18862a |
TcRnIllegalTypeOperator :: !SDoc -> !RdrName -> TcRnMessage | TcRnIllegalTypeOperator is an error that occurs when a type operator is used without the TypeOperators extension. Example: {-# LANGUAGE NoTypeOperators #-} f :: Vec a n -> Vec a m -> Vec a (n + m) Test case: T12811 |
TcRnIllegalTypeOperatorDecl :: !RdrName -> TcRnMessage | TcRnIllegalTypeOperatorDecl is an error that occurs when a type or class operator is declared without the TypeOperators extension. See Note [Type and class operator definitions] Example: {-# LANGUAGE Haskell2010 #-} {-# LANGUAGE MultiParamTypeClasses #-} module T3265 where data a :+: b = Left a | Right b class a :*: b where {} Test cases: T3265, tcfail173 |
TcRnGADTMonoLocalBinds :: TcRnMessage | TcRnGADTMonoLocalBinds is a warning controlled by -Wgadt-mono-local-binds that occurs when pattern matching on a GADT when -XMonoLocalBinds is off. Example(s): None Test cases: T20485, T20485a |
TcRnNotInScope | The TcRnNotInScope constructor is used for various not-in-scope errors.
See |
Fields
| |
TcRnTermNameInType :: RdrName -> [GhcHint] -> TcRnMessage | TcRnTermNameInType is an error that occurs when a term-level identifier is used in a type. Example: import qualified Prelude bad :: Prelude.fst (Bool, Float) bad = False Test cases: T21605{c,d} |
TcRnUntickedPromotedThing :: UntickedPromotedThing -> TcRnMessage | TcRnUntickedPromotedThing is a warning (controlled with -Wunticked-promoted-constructors) that is triggered by an unticked occurrence of a promoted data constructor. Examples: data A = MkA type family F (a :: A) where { F MkA = Bool } type B = [ Int, Bool ] Test cases: T9778, T19984. |
TcRnIllegalBuiltinSyntax | TcRnIllegalBuiltinSyntax is an error that occurs when built-in syntax appears in an unexpected location, e.g. as a data constructor or in a fixity declaration. Examples: infixl 5 : data P = (,) Test cases: rnfail042, T14907b, T15124, T15233. |
Fields
| |
TcRnWarnDefaulting | TcRnWarnDefaulting is a warning (controlled by -Wtype-defaults) that is triggered whenever a Wanted typeclass constraint is solving through the defaulting of a type variable. Example: one = show 1 -- We get Wanteds Show a0, Num a0, and default a0 to Integer. Test cases: none (which are really specific to defaulting), but see e.g. tcfail204. |
Fields
| |
TcRnIncorrectNameSpace | TcRnIncorrectNameSpace is an error that occurs when a Example: f x = Int Test cases: T18740a, T20884. |
Fields
| |
TcRnForeignImportPrimExtNotSet :: ForeignImport GhcRn -> TcRnMessage | TcRnForeignImportPrimExtNotSet is an error occurring when a foreign import
is declared using the Example(s): foreign import prim "foo" foo :: ByteArray# -> (# Int#, Int# #) Test cases: ffishould_failT20116 |
TcRnForeignImportPrimSafeAnn :: ForeignImport GhcRn -> TcRnMessage | TcRnForeignImportPrimSafeAnn is an error declaring that the safe/unsafe
annotation should not be used with Example(s): foreign import prim unsafe "my_primop_cmm" :: ... Test cases: None |
TcRnForeignFunctionImportAsValue :: ForeignImport GhcRn -> TcRnMessage | TcRnForeignFunctionImportAsValue is an error explaining that foreign Example(s): foreign import capi "math.h value sqrt" f :: CInt -> CInt Test cases: ffishould_failcapi_value_function |
TcRnFunPtrImportWithoutAmpersand :: ForeignImport GhcRn -> TcRnMessage | TcRnFunPtrImportWithoutAmpersand is a warning controlled by Example(s): foreign import ccall "f" f :: FunPtr (Int -> IO ()) Test cases: ffishould_compileT1357 |
TcRnIllegalForeignDeclBackend :: Either (ForeignExport GhcRn) (ForeignImport GhcRn) -> Backend -> ExpectedBackends -> TcRnMessage | TcRnIllegalForeignDeclBackend is an error occurring when a foreign import declaration is not compatible with the code generation backend being used. Example(s): None Test cases: None |
TcRnUnsupportedCallConv :: Either (ForeignExport GhcRn) (ForeignImport GhcRn) -> UnsupportedCallConvention -> TcRnMessage | TcRnUnsupportedCallConv informs the user that the calling convention specified
for a foreign export declaration is not compatible with the target platform.
It is a warning controlled by Example(s): None Test cases: None |
TcRnIllegalForeignType :: !(Maybe ArgOrResult) -> !IllegalForeignTypeReason -> TcRnMessage | TcRnIllegalForeignType is an error for when a type appears in a foreign function signature that is not compatible with the FFI. Example(s): None Test cases: ffishould_failT3066 ffishould_failccfail004 ffishould_failT10461 ffishould_failT7506 ffishould_failT5664 safeHaskellghcip6 safeHaskellsafeLanguageSafeLang08 ffishould_failT16702 linearshould_failLinearFFI ffishould_failT7243 |
TcRnInvalidCIdentifier :: !CLabelString -> TcRnMessage | TcRnInvalidCIdentifier indicates a C identifier that is not valid. Example(s): foreign import prim safe "not valid" cmm_test2 :: Int# -> Int# Test cases: th/T10638 |
TcRnExpectedValueId :: !TcTyThing -> TcRnMessage | TcRnExpectedValueId is an error occurring when something that is not a value identifier is used where one is expected. Example(s): none Test cases: none |
TcRnRecSelectorEscapedTyVar :: !OccName -> TcRnMessage | TcRnRecSelectorEscapedTyVar is an error indicating that a record field selector containing an existential type variable is used as a function rather than in a pattern match. Example(s): data Rec = forall a. Rec { field :: a } field (Rec True) Test cases: patsynshould_failrecords-exquant typecheckshould_failT3176 |
TcRnPatSynNotBidirectional :: !Name -> TcRnMessage | TcRnPatSynNotBidirectional is an error for when a non-bidirectional pattern synonym is used as a constructor. Example(s): pattern Five :: Int pattern Five <- 5 five = Five Test cases: patsynshould_failrecords-no-uni-update patsynshould_failrecords-no-uni-update2 |
TcRnIllegalDerivingItem :: !(LHsSigType GhcRn) -> TcRnMessage | TcRnIllegalDerivingItem is an error for when something other than a type class appears in a deriving statement. Example(s): data X = X deriving Int Test cases: derivingshould_failT5922 |
TcRnUnexpectedAnnotation :: !(HsType GhcRn) -> !HsSrcBang -> TcRnMessage | TcRnUnexpectedAnnotation indicates the erroroneous use of an annotation such as strictness, laziness, or unpacking. Example(s): data T = T { t :: Maybe {-# UNPACK #-} Int } data C = C { f :: !IntMap Int } Test cases: parsershould_failunpack_inside_type typecheckshould_failT7210 |
TcRnIllegalRecordSyntax :: Either (HsType GhcPs) (HsType GhcRn) -> TcRnMessage | TcRnIllegalRecordSyntax is an error indicating an illegal use of record syntax. Example(s): data T = T Int { field :: Int } Test cases: renameshould_failT7943 renameshould_failT9077 |
TcRnInvalidVisibleKindArgument | TcRnInvalidVisibleKindArgument is an error for a kind application on a target type that cannot accept it. Example(s):
bad :: Int Test cases: indexed-typesshould_failT16356_Fail3 typecheckshould_failExplicitSpecificity7 typecheckshould_failT12045b typecheckshould_failT12045c typecheckshould_failT15592a typecheckshould_failT15816 |
Fields
| |
TcRnTooManyBinders :: !Kind -> ![LHsTyVarBndr (HsBndrVis GhcRn) GhcRn] -> TcRnMessage | TcRnTooManyBinders is an error for a type constructor that is declared with more arguments then its kind specifies. Example(s): type T :: Type -> (Type -> Type) -> Type data T a (b :: Type -> Type) x1 (x2 :: Type -> Type) Test cases: saksshould_failsaks_fail008 |
TcRnDifferentNamesForTyVar :: !Name -> !Name -> TcRnMessage | TcRnDifferentNamesForTyVar is an error that indicates different names being used for the same type variable. Example(s): data SameKind :: k -> k -> * data Q (a :: k1) (b :: k2) c = MkQ (SameKind a b) Test cases: polykinds/T11203 polykinds/T11821a saksshould_failT20916 typecheckshould_failT17566b typecheckshould_failT17566c |
TcRnDisconnectedTyVar :: !Name -> TcRnMessage | TcRnDisconnectedTyVar is an error for a data declaration that has a kind signature, where the implicitly-bound type type variables can't be matched up unambiguously with the ones from the signature. See Note [Disconnected type variables] in GHC.Tc.Gen.HsType. |
TcRnInvalidReturnKind | TcRnInvalidReturnKind is an error for a data declaration that has a kind signature with an invalid result kind. Example(s): data family Foo :: Constraint Test cases: typecheckshould_failT14048b typecheckshould_failUnliftedNewtypesConstraintFamily typecheckshould_failT12729 typecheckshould_failT15883 typecheckshould_failT16829a typecheckshould_failT16829b typecheckshould_failUnliftedNewtypesNotEnabled typecheckshould_failtcfail079 |
Fields
| |
TcRnUnexpectedKindVar :: RdrName -> TcRnMessage | TcRnUnexpectedKindVar is an error that occurs when the user tries to use kind variables without -XPolyKinds. Example: f :: forall k a. Proxy (a :: k) Test cases: polykinds/BadKindVar polykinds/T14710 saksshould_failT16722 |
TcRnIllegalKind | TcRnIllegalKind is used for a various illegal kinds errors including Example: type T :: forall k. Type -- without emabled -XPolyKinds Test cases: polykinds/T16762b |
Fields
| |
TcRnClassKindNotConstraint :: !Kind -> TcRnMessage | TcRnClassKindNotConstraint is an error for a type class that has a kind that is not equivalent to Constraint. Example(s): type C :: Type -> Type class C a Test cases: saksshould_failT16826 |
TcRnUnpromotableThing :: !Name -> !PromotionErr -> TcRnMessage | TcRnUnpromotableThing is an error that occurs when the user attempts to use the promoted version of something which is not promotable. Example(s): data T :: T -> * data X a where MkX :: Show a => a -> X a foo :: Proxy ('MkX 'True) foo = Proxy Test cases: dependentshould_failPromotedClass dependentshould_failT14845_fail1 dependentshould_failT14845_fail2 dependentshould_failT15215 dependentshould_failT13780c dependentshould_failT15245 polykinds/T5716 polykinds/T5716a polykinds/T6129 polykinds/T7433 patsynshould_failT11265 patsynshould_failT9161-1 patsynshould_failT9161-2 dependentshould_failSelfDep polykinds/PolyKinds06 polykinds/PolyKinds07 polykinds/T13625 polykinds/T15116 polykinds/T15116a saksshould_failT16727a saksshould_failT16727b renameshould_failT12686 renameshould_failT16635a renameshould_failT16635b renameshould_failT16635c |
TcRnMatchesHaveDiffNumArgs | TcRnMatchesHaveDiffNumArgs is an error occurring when something has matches that have different numbers of arguments Example(s): foo x = True foo x y = False Test cases: renameshould_failrnfail045 typecheckshould_failT20768_fail |
Fields
| |
TcRnUnexpectedPatSigType :: HsPatSigType GhcPs -> TcRnMessage | TcRnUnexpectedPatSigType is an error occurring when there is a type signature in a pattern without -XScopedTypeVariables extension Examples: f (a :: Bool) = ... Test case: renameshould_failT11663 |
TcRnIllegalKindSignature :: HsType GhcPs -> TcRnMessage | TcRnIllegalKindSignature is an error occuring when there is a kind signature without -XKindSignatures extension Examples: data Foo (a :: Nat) = .... Test case: parsershould_failreadFail036 |
TcRnDataKindsError :: TypeOrKind -> HsType GhcPs -> TcRnMessage | TcRnDataKindsError is an error occurring when there is an illegal type or kind, probably required -XDataKinds and is used without the enabled extension. Examples: type Foo = [Nat, Char] type Bar = [Int, String] Test cases: linearshould_failT18888 polykinds/T7151 th/TH_Promoted1Tuple typecheckshould_failtcfail094 |
TcRnCannotBindScopedTyVarInPatSig :: !(NonEmpty (Name, TcTyVar)) -> TcRnMessage | TcRnCannotBindScopedTyVarInPatSig is an error stating that scoped type variables cannot be used in pattern bindings. Example(s): let (x :: a) = 5 Test cases: typecheckshould_compiletc141 |
TcRnCannotBindTyVarsInPatBind :: !(NonEmpty (Name, TcTyVar)) -> TcRnMessage | TcRnCannotBindTyVarsInPatBind is an error for when type variables are introduced in a pattern binding Example(s): Just @a x = Just True Test cases: typecheckshould_failTyAppPat_PatternBinding typecheckshould_failTyAppPat_PatternBindingExistential |
TcRnTooManyTyArgsInConPattern | TcRnTooManyTyArgsInConPattern is an error occurring when a constructor pattern has more than the expected number of type arguments Example(s):
f (Just Test cases: typecheckshould_failTyAppPat_TooMany typecheckshould_failT20443b |
Fields
| |
TcRnMultipleInlinePragmas | TcRnMultipleInlinePragmas is a warning signifying that multiple inline pragmas reference the same definition. Example(s): {-# INLINE foo #-} {-# INLINE foo #-} foo :: Bool -> Bool foo = id Test cases: none |
Fields
| |
TcRnUnexpectedPragmas :: !Id -> !(NonEmpty (LSig GhcRn)) -> TcRnMessage | TcRnUnexpectedPragmas is a warning that occurs when unexpected pragmas appear in the source. Example(s): Test cases: none |
TcRnNonOverloadedSpecialisePragma :: !(LIdP GhcRn) -> TcRnMessage | TcRnNonOverloadedSpecialisePragma is a warning for a specialise pragma being placed on a definition that is not overloaded. Example(s): {-# SPECIALISE foo :: Bool -> Bool #-} foo :: Bool -> Bool foo = id Test cases: simplCoreshould_compileT8537 typecheckshould_compileT10504 |
TcRnSpecialiseNotVisible :: !Name -> TcRnMessage | TcRnSpecialiseNotVisible is a warning that occurs when the subject of a SPECIALISE pragma has a definition that is not visible from the current module. Example(s): none Test cases: none |
TcRnPragmaWarning | TcRnPragmaWarning is a warning that can happen when usage of something is warned or deprecated by pragma. Test cases: DeprU T5281 T5867 rn050 rn066 (here is a warning, not deprecation) T3303 |
Fields
| |
TcRnDifferentExportWarnings | TcRnDifferentExportWarnings is an error that occurs when the warning messages for exports of a name differ between several export items. Test case: DifferentExportWarnings |
Fields
| |
TcRnIncompleteExportWarnings | TcRnIncompleteExportWarnings is a warning (controlled by -Wincomplete-export-warnings) that occurs when some of the exports of a name do not have an export warning and some do Test case: ExportWarnings6 |
Fields
| |
TcRnIllegalHsigDefaultMethods | TcRnIllegalHsigDefaultMethods is an error that occurs when a binding for a class default method is provided in a Backpack signature file. Test case: bkpfail40 |
TcRnHsigFixityMismatch | TcRnHsigFixityMismatch is an error indicating that the fixity decl in a Backpack signature file differs from the one in the source file for the same operator. Test cases: bkpfail37, bkpfail38 |
Fields
| |
TcRnHsigShapeMismatch :: !HsigShapeMismatchReason -> TcRnMessage | TcRnHsigShapeMismatch is a group of errors related to mismatches between backpack signatures. |
TcRnHsigMissingModuleExport | TcRnHsigMissingModuleExport is an error indicating that a module doesn't export a name exported by its signature. Test cases: bkpfail01, bkpfail05, bkpfail09, bkpfail16, bkpfail35, bkpcabal06 |
Fields
| |
TcRnBadGenericMethod | TcRnBadGenericMethod This test ensures that if you provide a "more specific" type signatures for the default method, you must also provide a binding. Example: {-# LANGUAGE DefaultSignatures #-} class C a where meth :: a default meth :: Num a => a meth = 0 Test case: typecheckshould_failMissingDefaultMethodBinding.hs |
Fields
| |
TcRnWarningMinimalDefIncomplete :: ClassMinimalDef -> TcRnMessage | TcRnWarningMinimalDefIncomplete is a warning that one must specify which methods must be implemented by all instances. Example: class Cheater a where -- WARNING LINE cheater :: a {-# MINIMAL #-} -- warning! Test case: warningsminimalWarnMinimal.hs: |
TcRnIllegalQuasiQuotes :: TcRnMessage | TcRnIllegalQuasiQuotes is an error that occurs when a quasi-quote is used without the QuasiQuotes extension. Example: foo = [myQuoter|x y z|] Test cases: none; the parser fails to parse this if QuasiQuotes is off. |
TcRnTHError :: THError -> TcRnMessage | TcRnTHError is a family of errors involving Template Haskell.
See |
TcRnDefaultMethodForPragmaLacksBinding | TcRnDefaultMethodForPragmaLacksBinding is an error that occurs when a default method pragma is missing an accompanying binding. Test cases: typecheckshould_failT5084.hs typecheckshould_failT2354.hs |
Fields
| |
TcRnIgnoreSpecialisePragmaOnDefMethod :: !Name -> TcRnMessage | TcRnIgnoreSpecialisePragmaOnDefMethod is a warning that occurs when a specialise pragma is put on a default method. Test cases: none |
TcRnBadMethodErr | TcRnBadMethodErr is an error that happens when one attempts to provide a method in a class instance, when the class doesn't have a method by that name. Test case: th/T12387 |
Fields
| |
TcRnIllegalNewtype | TcRnIllegalNewtype is an error that occurs when a newtype:
Test cases: gadt/T14719 indexed-typesshould_failT14033 indexed-typesshould_failT2334A linearshould_failLinearGADTNewtype parsershould_failreadFail008 polykinds/T11459 typecheckshould_failT15523 typecheckshould_failT15796 typecheckshould_failT17955 typecheckshould_failT18891a typecheckshould_failT21447 typecheckshould_failtcfail156 |
Fields
| |
TcRnIllegalTypeData :: TcRnMessage | TcRnIllegalTypeData is an error that occurs when a See Note [Type data declarations] Test case: type-datashould_failTDNoPragma |
TcRnTypeDataForbids :: !TypeDataForbids -> TcRnMessage | TcRnTypeDataForbids is an error that occurs when a See Note [Type data declarations] Test cases: type-datashould_failTDDeriving type-datashould_failTDRecordsGADT type-datashould_failTDRecordsH98 type-datashould_failTDStrictnessGADT type-datashould_failTDStrictnessH98 |
TcRnUnsatisfiedMinimalDef :: ClassMinimalDef -> TcRnMessage | TcRnUnsatisfiedMinimalDef is a warning that occurs when a class instance is missing methods that are required by the minimal definition. Example: class C a where foo :: a -> a instance C () -- | foo needs to be defined here Test cases: typecheckprog001typecheck.prog001 typecheckshould_compiletc126 typecheckshould_compileT7903 typecheckshould_compiletc116 typecheckshould_compiletc175 typecheckshould_compileHasKey typecheckshould_compiletc125 typecheckshould_compiletc078 typecheckshould_compiletc161 typecheckshould_failT5051 typecheckshould_compileT21583 backpackshould_compilebkp47 backpackshould_failbkpfail25 parsershould_compileT2245 parsershould_compileread014 indexed-typesshould_compileClass3 indexed-typesshould_compileSimple2 indexed-typesshould_failT7862 derivingshould_compilederiving-1935 derivingshould_compileT9968a derivingshould_compiledrv003 derivingshould_compileT4966 derivingshould_compileT14094 perfcompilerT15304 warningsminimalWarnMinimal simplCoreshould_compilesimpl020 deSugarshould_compileT14546d ghciscriptsT5820 ghciscriptsghci019 |
TcRnMisplacedInstSig :: Name -> LHsSigType GhcRn -> TcRnMessage |
Test case: module/mod45 |
TcRnNoRebindableSyntaxRecordDot :: TcRnMessage | TcRnNoRebindableSyntaxRecordDot is an error triggered by an overloaded record update without RebindableSyntax enabled. Example(s): Test cases: parsershould_failRecordDotSyntaxFail5 |
TcRnNoFieldPunsRecordDot :: TcRnMessage | TcRnNoFieldPunsRecordDot is an error triggered by the use of record field puns in an overloaded record update without enabling NamedFieldPuns. Example(s): print $ a{ foo.bar.baz.quux } Test cases: parsershould_failRecordDotSyntaxFail12 |
TcRnIllegalStaticExpression :: HsExpr GhcPs -> TcRnMessage | TcRnIllegalStaticExpression is an error thrown when user creates a static pointer via TemplateHaskell without enabling the StaticPointers extension. Example(s): Test cases: th/T14204 |
TcRnListComprehensionDuplicateBinding :: Name -> TcRnMessage | TcRnListComprehensionDuplicateBinding is an error triggered by duplicate let-bindings in a list comprehension. Example(s): [ () | let a = 13 | let a = 17 ] Test cases: typecheckshould_failtcfail092 |
TcRnEmptyStmtsGroup :: EmptyStatementGroupErrReason -> TcRnMessage | TcRnEmptyStmtsGroup is an error triggered by an empty list of statements
in a statement block. For more information, see Example(s):
do proc () -> do Test cases: renameshould_failRnEmptyStatementGroup1 |
TcRnLastStmtNotExpr :: HsStmtContext GhcRn -> UnexpectedStatement -> TcRnMessage | TcRnLastStmtNotExpr is an error caused by the last statement in a statement block not being an expression. Example(s): do x <- pure () do let x = 5 Test cases: renameshould_failT6060 parsershould_failT3811g parsershould_failreadFail028 |
TcRnUnexpectedStatementInContext :: HsStmtContext GhcRn -> UnexpectedStatement -> Maybe Extension -> TcRnMessage | TcRnUnexpectedStatementInContext is an error when a statement appears in an unexpected context (e.g. an arrow statement appears in a list comprehension). Example(s): Test cases: parsershould_failreadFail042 parsershould_failreadFail038 parsershould_failreadFail043 |
TcRnIllegalTupleSection :: TcRnMessage | TcRnIllegalTupleSection is an error triggered by usage of a tuple section without enabling the TupleSections extension. Example(s): (5,) Test cases: renameshould_failrnfail056 |
TcRnIllegalImplicitParameterBindings :: Either (HsLocalBindsLR GhcPs GhcPs) (HsLocalBindsLR GhcRn GhcPs) -> TcRnMessage | TcRnIllegalImplicitParameterBindings is an error triggered by binding an implicit parameter in an mdo block. Example(s): mdo { let { ?x = 5 }; () } Test cases: renameshould_failRnImplicitBindInMdoNotation |
TcRnSectionWithoutParentheses :: HsExpr GhcPs -> TcRnMessage | TcRnSectionWithoutParentheses is an error triggered by attempting to use an operator section without parentheses. Example(s):
( Test cases: renameshould_failT2490 renameshould_failT5657 |
TcRnBindingOfExistingName :: RdrName -> TcRnMessage | TcRnBindingOfExistingName is an error triggered by an attempt to rebind built-in syntax, punned list or tuple syntax, or a name quoted via Template Haskell. Examples: data [] data (->) $(pure [ValD (VarP 'succ) (NormalB (ConE 'True)) []]) Test cases: renameshould_failT14907b renameshould_failT22839 renameshould_failrnfail042 th/T13968 |
TcRnMultipleFixityDecls :: SrcSpan -> RdrName -> TcRnMessage | TcRnMultipleFixityDecls is an error triggered by multiple fixity declarations for the same operator. Example(s): infixr 6 $$ infixl 4 $$ Test cases: renameshould_failRnMultipleFixityFail |
TcRnIllegalPatternSynonymDecl :: TcRnMessage | TcRnIllegalPatternSynonymDecl is an error thrown when a user defines a pattern synonyms without enabling the PatternSynonyms extension. Example: pattern O :: Int pattern O = 0 Test cases: renameshould_failRnPatternSynonymFail |
TcRnIllegalClassBinding :: DeclSort -> HsBindLR GhcPs GhcPs -> TcRnMessage | TcRnIllegalClassBinding is an error triggered by a binding in a class or instance declaration of an illegal form. Examples: class ZeroOne a where zero :: a one :: a instance ZeroOne Int where (zero,one) = (0,1) class C a where pattern P = () Test cases: module/mod48 patsynshould_failT9705-1 patsynshould_failT9705-2 typecheckshould_failtcfail021 |
TcRnOrphanCompletePragma :: TcRnMessage | TcRnOrphanCompletePragma is an error triggered by a {-# COMPLETE #-} pragma which does not mention any data constructors or pattern synonyms defined in the current module. Test cases: patsynshould_failT13349 |
TcRnEmptyCase :: HsMatchContext GhcRn -> TcRnMessage | TcRnEmptyCase is an error thrown when a user uses a case expression with an empty list of alternatives without enabling the EmptyCase extension. Example(s): case () of Test cases: renameshould_failRnEmptyCaseFail |
TcRnNonStdGuards :: NonStandardGuards -> TcRnMessage | TcRnNonStdGuards is a warning thrown when a user uses non-standard guards (e.g. patterns in guards) without enabling the PatternGuards extension. More realistically: the user has explicitly disabled PatternGuards, as it is enabled by default with `-XHaskell2010`. Example(s): f | 5 <- 2 + 3 = ... Test cases: renameshould_compilern049 |
TcRnDuplicateSigDecl :: NonEmpty (LocatedN RdrName, Sig GhcPs) -> TcRnMessage | TcRnDuplicateSigDecl is an error triggered by two or more signatures for one entity. Examples: f :: Int -> Bool f :: Int -> Bool f _ = True g x = x {-# INLINE g #-} {-# NOINLINE g #-} pattern P = () {-# COMPLETE P #-} {-# COMPLETE P #-} Test cases: module/mod68 parsershould_failOpaqueParseFail4 patsynshould_failT12165 renameshould_failrnfail048 renameshould_failT5589 renameshould_failT7338 renameshould_failT7338a |
TcRnMisplacedSigDecl :: Sig GhcRn -> TcRnMessage | TcRnMisplacedSigDecl is an error triggered by the pragma application
in the wrong context, like Example: f x = x {-# MINIMAL f #-} Test cases: renameshould_failT18138 warningsminimalWarnMinimalFail1 |
TcRnUnexpectedDefaultSig :: Sig GhcPs -> TcRnMessage | TcRnUnexpectedDefaultSig is an error thrown when a user uses default signatures without enabling the DefaultSignatures extension. Example: class C a where m :: a default m :: Num a => a m = 0 Test cases: renameshould_failRnDefaultSigFail |
TcRnDuplicateMinimalSig :: LSig GhcPs -> LSig GhcPs -> [LSig GhcPs] -> TcRnMessage | TcRnDuplicateMinimalSig is an error triggered by two or more minimal signatures for one type class. Example: class C where f :: () {-# MINIMAL f #-} {-# MINIMAL f #-} Test cases: renameshould_failRnMultipleMinimalPragmaFail |
TcRnIllegalInvisTyVarBndr :: !(LHsTyVarBndr (HsBndrVis GhcRn) GhcRn) -> TcRnMessage |
Example:
{-# LANGUAGE NoTypeAbstractions #-} -- extension disabled
data T Test case: T22560_fail_ext |
TcRnInvalidInvisTyVarBndr :: !Name -> !(LHsTyVarBndr (HsBndrVis GhcRn) GhcRn) -> TcRnMessage |
Example: type P :: forall a -> Type data P @a = MkP Test cases: T22560_fail_a T22560_fail_b |
TcRnInvisBndrWithoutSig :: !Name -> !(LHsTyVarBndr (HsBndrVis GhcRn) GhcRn) -> TcRnMessage |
Example: data T @k (a :: k) -- No CUSK, no SAKS Test case: T22560_fail_d |
TcRnDeprecatedInvisTyArgInConPat :: TcRnMessage | TcRnDeprecatedInvisTyArgInConPat is a warning that triggers on type applications in constructor patterns when the user has not enabled '-XTypeAbstractions' but instead has enabled both '-XScopedTypeVariables' and '-XTypeApplications'. This warning is a deprecation mechanism that is scheduled until GHC 9.12. |
TcRnLoopySuperclassSolve | TcRnLoopySuperclassSolve is a warning, controlled by Example: class Foo f class Foo f => Bar f g instance Bar f f => Bar f (h k) Test cases: T20666, T20666{a,b}, T22891, T22912. |
Fields
| |
TcRnUnexpectedStandaloneDerivingDecl :: TcRnMessage | TcRnUnexpectedStandaloneDerivingDecl is an error thrown when a user uses standalone deriving without enabling the StandaloneDeriving extension. Example: deriving instance Eq Foo Test cases: renameshould_failRnUnexpectedStandaloneDeriving |
TcRnUnusedVariableInRuleDecl :: FastString -> Name -> TcRnMessage | TcRnUnusedVariableInRuleDecl is an error triggered by forall'd variable in rewrite rule that does not appear on left-hand side Example: {-# RULES "rule" forall a. id = id #-} Test cases: renameshould_failExplicitForAllRules2 |
TcRnUnexpectedStandaloneKindSig :: TcRnMessage | TcRnUnexpectedStandaloneKindSig is an error thrown when a user uses standalone kind signature without enabling the StandaloneKindSignatures extension. Example: type D :: Type data D = D Test cases: saksshould_failsaks_fail001 |
TcRnIllegalRuleLhs :: RuleLhsErrReason -> FastString -> LHsExpr GhcRn -> HsExpr GhcRn -> TcRnMessage | TcRnIllegalRuleLhs is an error triggered by malformed left-hand side of rewrite rule Examples: {-# RULES "test" forall x. f x = x #-} {-# RULES "test" forall x. case x of = x #-} Test cases: renameshould_failT15659 |
TcRnDuplicateRoleAnnot :: NonEmpty (LRoleAnnotDecl GhcPs) -> TcRnMessage | TcRnDuplicateRoleAnnot is an error triggered by two or more role annotations for one type Example: data D a type role D phantom type role D phantom Test cases: rolesshould_failRoles8 |
TcRnDuplicateKindSig :: NonEmpty (LStandaloneKindSig GhcPs) -> TcRnMessage | TcRnDuplicateKindSig is an error triggered by two or more standalone kind signatures for one type Example: type D :: Type type D :: Type data D Test cases: saksshould_failsaks_fail002 |
TcRnIllegalDerivStrategy :: DerivStrategy GhcPs -> TcRnMessage | TcRnIllegalDerivStrategy is an error thrown when a user uses deriving strategy without enabling the DerivingStrategies extension or uses deriving via without enabling the DerivingVia extension. Examples: data T = T deriving stock Eq data T = T deriving via Eq T Test cases: derivingshould_failderiving-via-fail3 derivingshould_failT10598_fail4 |
TcRnIllegalMultipleDerivClauses :: TcRnMessage | TcRnIllegalMultipleDerivClauses is an error thrown when a user uses two or more deriving clauses without enabling the DerivingStrategies extension. Example: data T = T deriving Eq deriving Ord Test cases: derivingshould_failT10598_fail5 |
TcRnNoDerivStratSpecified :: Bool -> TcRnMessage | TcRnNoDerivStratSpecified is a warning implied by -Wmissing-deriving-strategies and triggered by deriving clause without specified deriving strategy. Example: data T = T deriving Eq Test cases: renameshould_compileT15798a renameshould_compileT15798b renameshould_compileT15798c |
TcRnStupidThetaInGadt :: HsDocContext -> TcRnMessage | TcRnStupidThetaInGadt is an error triggered by data contexts in GADT-style data declaration Example: data (Eq a) => D a where MkD :: D Int Test cases: renameshould_failRnStupidThetaInGadt |
TcRnShadowedTyVarNameInFamResult :: IdP GhcPs -> TcRnMessage | TcRnShadowedTyVarNameInFamResult is an error triggered by type variable in type family result that shadows type variable from left hand side Example: type family F a b c = b Test cases: ghciscriptsT6018ghcirnfail renameshould_failT6018rnfail |
TcRnIncorrectTyVarOnLhsOfInjCond :: IdP GhcRn -> LIdP GhcPs -> TcRnMessage | TcRnIncorrectTyVarOnRhsOfInjCond is an error caused by a situation where the left-hand side of an injectivity condition of a type family is not a variable referring to the type family result. See Note [Renaming injectivity annotation] for more details. Example: type family F a = r | a -> a Test cases: ghciscriptsT6018ghcirnfail renameshould_failT6018rnfail |
TcRnUnknownTyVarsOnRhsOfInjCond :: [Name] -> TcRnMessage | TcRnUnknownTyVarsOnRhsOfInjCond is an error triggered by out-of-scope type variables on the right-hand side of a of an injectivity condition of a type family Example: type family F a = res | res -> b Test cases: ghciscriptsT6018ghcirnfail renameshould_failT6018rnfail |
TcRnLookupInstance :: !Class -> ![Type] -> !LookupInstanceErrReason -> TcRnMessage | TcRnLookupInstance groups several errors emitted when looking up class instances. Test cases: none |
TcRnBadlyStaged | TcRnBadlyStaged is an error that occurs when a TH binding is used in an invalid stage. Test cases: T17820d |
Fields
| |
TcRnStageRestriction | TcRnStageRestriction is an error that occurs when a top level splice refers to a local name. Test cases: T17820, T21547, T5795, qq00[1-4], annfail0{3,4,6,9} |
Fields
| |
TcRnTyThingUsedWrong | TcRnTyThingUsedWrong is an error that occurs when a thing is used where another thing was expected. Test cases: none |
Fields
| |
TcRnCannotDefaultKindVar | TcRnCannotDefaultKindVar is an error that occurs when attempting to use
unconstrained kind variables whose type isn't Test cases: T11334b |
Fields
| |
TcRnUninferrableTyVar | TcRnUninferrableTyVar is an error that occurs when metavariables in a type could not be defaulted. Test cases: T17301, T17562, T17567, T17567StupidTheta, T15474, T21479 |
Fields
| |
TcRnSkolemEscape | TcRnSkolemEscape is an error that occurs when type variables from an outer scope is used in a context where they should be locally scoped. Test cases: T15076, T15076b, T14880-2, T15825, T14880, T15807, T16946, T14350, T14040A, T15795, T15795a, T14552 |
Fields
| |
TcRnPatSynEscapedCoercion | TcRnPatSynEscapedCoercion is an error indicating that a coercion escaped from a pattern synonym into a type. See Note [Coercions that escape] in GHC.Tc.TyCl.PatSyn Test cases: T14507 |
Fields
| |
TcRnPatSynExistentialInResult | TcRnPatSynExistentialInResult is an error indicating that the result type of a pattern synonym mentions an existential type variable. Test cases: PatSynExistential |
Fields
| |
TcRnPatSynArityMismatch | TcRnPatSynArityMismatch is an error indicating that the number of arguments in a pattern synonym's equation differs from the number of parameters in its signature. Test cases: PatSynArity |
Fields
| |
TcRnPatSynInvalidRhs | TcRnPatSynInvalidRhs is an error group indicating that the pattern on the right hand side of a pattern synonym is invalid. Test cases: unidir, T14112 |
Fields
| |
TcRnZonkerMessage :: ZonkerMessage -> TcRnMessage | TcRnZonkerMessage is collection of errors that occur when zonking, i.e. filling in metavariables with their final values. See |
TcRnTyFamDepsDisabled :: TcRnMessage | TcRnTyFamDepsDisabled is an error indicating that a type family injectivity annotation was used without enabling the extension TypeFamilyDependencies. Test cases: T11381 |
TcRnAbstractClosedTyFamDecl :: TcRnMessage | TcRnAbstractClosedTyFamDecl is an error indicating that an abstract closed type family was declared in a regular source file, while it is only allowed in hs-boot files. Test cases: ClosedFam4 |
TcRnPartialFieldSelector | TcRnPartialFieldSelector is a warning indicating that a record selector was not defined for all constructors of a data type. Test cases: DRFPartialFields, T7169 |
Fields
| |
TcRnBadFieldAnnotation | TcRnBadFieldAnnotation is an error/warning group indicating that a strictness/unpack related data type field annotation is invalid. |
Fields
| |
TcRnSuperclassCycle | TcRnSuperclassCycle is an error indicating that a class has a superclass cycle. Test cases: mod40, tcfail027, tcfail213, tcfail216, tcfail217, T9415, T9739 |
Fields
| |
TcRnDefaultSigMismatch | TcRnDefaultSigMismatch is an error indicating that a default method signature doesn't match the regular method signature. Test cases: T7437, T12918a, T12918b, T12151 |
Fields
| |
TcRnTyFamsDisabled | TcRnTyFamsDisabled is an error indicating that a type family or instance was declared while the extension TypeFamilies was disabled. Test cases: TyFamsDisabled |
Fields
| |
TcRnBadTyConTelescope :: !TyCon -> TcRnMessage | TcRnBadTyConTelescope is an error caused by an ill-scoped Example: class C a (b :: Proxy a) (c :: Proxy b) where type T c a Test cases: BadTelescope{∅,3,4} T14066{f,g} T14887 T15591{b,c} T15743{c,d} T15764 T23252 |
TcRnTyFamResultDisabled | TcRnTyFamResultDisabled is an error indicating that a result variable was used on a type family while the extension TypeFamilyDependencies was disabled. Test cases: T13571, T13571a |
Fields
| |
TcRnRoleValidationFailed | TcRnRoleValidationFailed is an error indicating that a variable was assigned an invalid role by the inference algorithm. This is only performed with -dcore-lint. |
Fields
| |
TcRnCommonFieldResultTypeMismatch | TcRnCommonFieldResultTypeMismatch is an error indicating that a sum type declares the same field name in multiple constructors, but the constructors' result types differ. Test cases: CommonFieldResultTypeMismatch |
Fields
| |
TcRnCommonFieldTypeMismatch | TcRnCommonFieldTypeMismatch is an error indicating that a sum type declares the same field name in multiple constructors, but their types differ. Test cases: CommonFieldTypeMismatch |
Fields
| |
TcRnClassExtensionDisabled | TcRnClassExtensionDisabled is an error indicating that a class was declared with an extension feature while the extension was disabled. |
Fields
| |
TcRnDataConParentTypeMismatch | TcRnDataConParentTypeMismatch is an error indicating that a data constructor was declared with a type that doesn't match its type constructor (i.e. a GADT result type and its data name). Test cases: T7175, T13300, T14719, T18357, T18357b, gadt11, tcfail155, tcfail176 |
Fields
| |
TcRnGADTsDisabled | TcRnGADTsDisabled is an error indicating that a GADT was declared while the extension GADTs was disabled. Test cases: ghci057, T9293 |
Fields
| |
TcRnExistentialQuantificationDisabled | TcRnExistentialQuantificationDisabled is an error indicating that a data constructor was declared with existential features while the extension ExistentialQuantification was disabled. Test cases: ghci057, T9293, gadtSyntaxFail001, gadtSyntaxFail002, gadtSyntaxFail003, prog006, rnfail053, T12083a |
Fields
| |
TcRnGADTDataContext | TcRnGADTDataContext is an error indicating that a GADT was declared with a data type context. This error is emitted in the tc, but it is also caught in the renamer. |
Fields
| |
TcRnMultipleConForNewtype | TcRnMultipleConForNewtype is an error indicating that a newtype was declared with multiple constructors. This error is caught by the parser. |
Fields
| |
TcRnKindSignaturesDisabled | TcRnKindSignaturesDisabled is an error indicating that a kind signature was used in a data type declaration while the extension KindSignatures was disabled. Test cases: T20873c, readFail036 |
TcRnEmptyDataDeclsDisabled | TcRnEmptyDataDeclsDisabled is an error indicating that a data type was declared with no constructors while the extension EmptyDataDecls was disabled. Test cases: readFail035 |
Fields
| |
TcRnRoleMismatch | TcRnRoleMismatch is an error indicating that the role specified in an annotation differs from its inferred role. Test cases: T7253, Roles11 |
Fields
| |
TcRnRoleCountMismatch | TcRnRoleCountMismatch is an error indicating that the number of roles in an annotation doesn't match the number of type parameters. Test cases: Roles6 |
Fields
| |
TcRnIllegalRoleAnnotation | TcRnIllegalRoleAnnotation is an error indicating that a role annotation was attached to a decl that doesn't allow it. Test cases: Roles5 |
Fields
| |
TcRnRoleAnnotationsDisabled | TcRnRoleAnnotationsDisabled is an error indicating that a role annotation was declared while the extension RoleAnnotations was disabled. Test cases: Roles5, TH_Roles1 |
Fields
| |
TcRnIncoherentRoles | TcRnIncoherentRoles is an error indicating that a role annotation for a class parameter was declared as not nominal. Test cases: T8773 |
Fields
| |
TcRnPrecedenceParsingError | TcRnPrecedenceParsingError is an error caused by attempting to use operators with the same precedence in one infix expression. Example: eq :: (a ~ b ~ c) :~: () Test cases: module/mod61 parsershould_failreadFail016 renameshould_failrnfail017 renameshould_failT9077 typecheckshould_failT18252a |
Fields
| |
TcRnSectionPrecedenceError | TcRnPrecedenceParsingError is an error caused by attempting to use an operator with higher precedence than the operand. Example: k = (-3 **) where (**) = const infixl 7 ** Test cases: overloadedrecfldsshould_failT13132_duplicaterecflds parsershould_failreadFail023 renameshould_failrnfail019 th/TH_unresolvedInfix2 |
TcRnTypeSynonymCycle | TcRnTypeSynonymCycle is an error indicating that a cycle between type synonyms has occurred. Test cases: mod27, ghc-e-fail2, bkpfail29 |
Fields
| |
TcRnSelfImport | TcRnSelfImport is an error indicating that a module contains an import of itself. Test cases: T9032 |
Fields
| |
TcRnNoExplicitImportList | TcRnNoExplicitImportList is a warning indicating that an import statement did not include an explicit import list. Test cases: T1789, T4489 |
Fields
| |
TcRnSafeImportsDisabled | TcRnSafeImportsDisabled is an error indicating that an import was
declared using the Test cases: Mixed01 |
Fields
| |
TcRnDeprecatedModule | TcRnDeprecatedModule is a warning indicating that an imported module is annotated with a warning or deprecation pragma. Test cases: DeprU |
Fields
| |
TcRnCompatUnqualifiedImport | TcRnCompatUnqualifiedImport is a warning indicating that a special module (right now only Data.List) was imported unqualified without import list, for compatibility reasons. Test cases: T17244A |
Fields
| |
TcRnRedundantSourceImport | TcRnRedundantSourceImport is a warning indicating that a {-# SOURCE #-} import was used when there is no import cycle. Test cases: none |
Fields
| |
TcRnImportLookup | TcRnImportLookup is a group of errors about bad imported names. |
Fields
| |
TcRnUnusedImport | TcRnUnusedImport is a group of errors about unused imports. |
Fields
| |
TcRnDuplicateDecls | TcRnDuplicateDecls is an error indicating that the same name was used for multiple declarations. Test cases: FieldSelectors, overloadedrecfldsfail03, T17965, NFSDuplicate, T9975a, TDMultiple01, mod19, mod38, mod21, mod66, mod20, TDPunning, mod18, mod22, TDMultiple02, T4127a, ghci048, T8932, rnfail015, rnfail010, rnfail011, rnfail013, rnfail002, rnfail003, rn_dup, rnfail009, T7164, rnfail043, TH_dupdecl, rnfail012 |
Fields
| |
TcRnPackageImportsDisabled :: TcRnMessage | TcRnPackageImportsDisabled is an error indicating that an import uses a package qualifier while the extension PackageImports was disabled. Test cases: PackageImportsDisabled |
TcRnIllegalDataCon | TcRnIllegalDataCon is an error indicating that a data constructor was defined using a lowercase name, or a symbolic name in prefix position. Mostly caught by PsErrNotADataCon. Test cases: None |
Fields
| |
TcRnNestedForallsContexts :: !NestedForallsContextsIn -> TcRnMessage | TcRnNestedForallsContexts is an error indicating that multiple foralls or
contexts are nested/curried where this is not supported,
like Test cases: T12087, T14320, T16114, T16394, T16427, T18191, T18240a, T18240b, T18455, T5951 |
TcRnRedundantRecordWildcard :: TcRnMessage | TcRnRedundantRecordWildcard is a warning indicating that a pattern uses a record wildcard even though all of the record's fields are bound explicitly. Test cases: T15957_Fail |
TcRnUnusedRecordWildcard | TcRnUnusedRecordWildcard is a warning indicating that a pattern uses a record wildcard while none of the fields bound by it are used. Test cases: T15957_Fail |
Fields
| |
TcRnUnusedName | TcRnUnusedName is a warning indicating that a defined or imported name is not used in the module. Test cases: ds053, mc10, overloadedrecfldsfail05, overloadedrecfldsfail06, prog018, read014, rn040, rn041, rn047, rn063, T13839, T13839a, T13919, T17171b, T17a, T17b, T17d, T17e, T18470, T1972, t22391, t22391j, T2497, T3371, T3449, T7145b, T7336, TH_recover_warns, unused_haddock, WarningGroups, werror |
Fields
| |
TcRnQualifiedBinder | TcRnQualifiedBinder is an error indicating that a qualified name was used in binding position. Test cases: mod62, rnfail021, rnfail034, rnfail039, rnfail046 |
Fields
| |
TcRnTypeApplicationsDisabled | TcRnTypeApplicationsDisabled is an error indicating that a type application was used while the extension TypeApplications was disabled. Test cases: T12411, T12446, T15527, T16133, T18251c |
Fields
| |
TcRnInvalidRecordField | TcRnInvalidRecordField is an error indicating that a record field was used that doesn't exist in a constructor. Test cases: T13644, T13847, T17469, T8448, T8570, tcfail083, tcfail084 |
Fields
| |
TcRnTupleTooLarge | TcRnTupleTooLarge is an error indicating that the arity of a tuple exceeds mAX_TUPLE_SIZE. Test cases: T18723a, T18723b, T18723c, T6148a, T6148b, T6148c, T6148d |
Fields
| |
TcRnCTupleTooLarge | TcRnCTupleTooLarge is an error indicating that the arity of a constraint tuple exceeds mAX_CTUPLE_SIZE. Test cases: T10451 |
Fields
| |
TcRnIllegalInferredTyVars | TcRnIllegalInferredTyVars is an error indicating that some type variables
were quantified as inferred (like Test cases: ExplicitSpecificity5, ExplicitSpecificity6, ExplicitSpecificity8, ExplicitSpecificity9 |
Fields
| |
TcRnAmbiguousName | TcRnAmbiguousName is an error indicating that an unbound name might refer to multiple names in scope. Test cases: BootFldReexport, DRFUnused, duplicaterecfldsghci01, GHCiDRF, mod110, mod151, mod152, mod153, mod164, mod165, NoFieldSelectorsFail, overloadedrecfldsfail02, overloadedrecfldsfail04, overloadedrecfldsfail11, overloadedrecfldsfail12, overloadedrecfldsfail13, overloadedrecfldswasrunnowfail06, rnfail044, T11167_ambig, T11167_ambiguous_fixity, T13132_duplicaterecflds, T15487, T16745, T17420, T18999_NoDisambiguateRecordFields, T19397E1, T19397E2, T23010_fail, tcfail037 |
Fields
| |
TcRnBindingNameConflict | TcRnBindingNameConflict is an error indicating that multiple local or top-level bindings have the same name. Test cases: dsrun006, mdofail002, mdofail003, mod23, mod24, qq006, rnfail001, rnfail004, SimpleFail6, T14114, T16110_Fail1, tcfail038, TH_spliceD1 |
Fields
| |
TcRnNonCanonicalDefinition | TcRnNonCanonicalDefinition is a warning indicating that an instance
defines an implementation for a method that should not be defined in a way
that deviates from its default implementation, for example because it has
been scheduled to be absorbed into another method, like Test cases: WCompatWarningsOn, WCompatWarningsOff, WCompatWarningsOnOff |
Fields
| |
TcRnImplicitImportOfPrelude :: TcRnMessage | TcRnImplicitImportOfPrelude is a warning, controlled by Example: {-# OPTIONS_GHC -fwarn-implicit-prelude #-} module M where {} Test case: rn055 |
TcRnMissingMain | TcRnMissingMain is an error that occurs when a Main module does
not define a main function (named Example: module Main where {} Test cases: T414, T7765, readFail021, rnfail007, T13839b, T17171a, T16453E1, tcfail030, T19397E3, T19397E4 |
Fields
| |
TcRnGhciUnliftedBind :: !Id -> TcRnMessage | TcRnGhciUnliftedBind is an error that occurs when a user attempts to bind an unlifted value in GHCi. Example (in GHCi): let a = (# 1#, 3# #) Test cases: T9140, T19035b |
TcRnGhciMonadLookupFail | TcRnGhciMonadLookupFail is an error that occurs when the user sets
the GHCi monad, using the GHC API Example: import GHC ( setGHCiMonad ) ... setGHCiMonad NoSuchThing Test cases: none |
Fields
| |
TcRnMissingRoleAnnotation :: Name -> [Role] -> TcRnMessage | TcRnMissingRoleAnnotation is a warning that occurs when type declaration doesn't have a role annotatiosn Controlled by flags: - Wmissing-role-annotations Test cases: T22702 |
TcRnPatersonCondFailure | TcRnPatersonCondFailure is an error that occurs when an instance declaration fails to conform to the Paterson conditions. Which particular condition fails depends on the constructor of PatersonCondFailure See Note [Paterson conditions]. Test cases: T15231, tcfail157, T15316, T19187a, fd-loop, tcfail108, tcfail154, T15172, tcfail214 |
Fields
| |
TcRnImplicitRhsQuantification :: LocatedN RdrName -> TcRnMessage | TcRnImplicitRhsQuantification is a warning that occurs when GHC implicitly quantifies over a type variable that occurs free on the RHS of the type declaration that is not mentioned on the LHS Example: type T = 'Nothing :: Maybe a Controlled by flags: - Wimplicit-rhs-quantification Test cases: T23510a T23510b |
Instances
Generic TcRnMessage | |||||
Defined in GHC.Tc.Errors.Types Associated Types
| |||||
type Rep TcRnMessage | |||||
Defined in GHC.Tc.Errors.Types type Rep TcRnMessage = D1 ('MetaData "TcRnMessage" "GHC.Tc.Errors.Types" "ghc-9.8.4-inplace" 'False) ((((((((C1 ('MetaCons "TcRnUnknownMessage" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (UnknownDiagnostic (DiagnosticOpts TcRnMessage)))) :+: C1 ('MetaCons "TcRnInterfaceError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 IfaceMessage))) :+: (C1 ('MetaCons "TcRnMessageWithInfo" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 UnitState) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TcRnMessageDetailed)) :+: C1 ('MetaCons "TcRnWithHsDocContext" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 HsDocContext) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TcRnMessage)))) :+: ((C1 ('MetaCons "TcRnSolverReport" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 SolverReportWithCtxt) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 DiagnosticReason) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [GhcHint]))) :+: C1 ('MetaCons "TcRnSolverDepthError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Type) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 SubGoalDepth))) :+: (C1 ('MetaCons "TcRnRedundantConstraints" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Id]) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (SkolemInfoAnon, Bool))) :+: C1 ('MetaCons "TcRnInaccessibleCode" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Implication) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 SolverReportWithCtxt))))) :+: (((C1 ('MetaCons "TcRnInaccessibleCoAxBranch" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TyCon) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 CoAxBranch)) :+: C1 ('MetaCons "TcRnTypeDoesNotHaveFixedRuntimeRep" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Type) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 FixedRuntimeRepProvenance) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ErrInfo)))) :+: (C1 ('MetaCons "TcRnImplicitLift" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Name) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ErrInfo)) :+: C1 ('MetaCons "TcRnUnusedPatternBinds" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HsBind GhcRn))))) :+: ((C1 ('MetaCons "TcRnUnusedQuantifiedTypeVar" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 HsDocContext) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 HsTyVarBndrExistentialFlag)) :+: C1 ('MetaCons "TcRnDodgyImports" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 DodgyImportsReason))) :+: (C1 ('MetaCons "TcRnDodgyExports" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 GlobalRdrElt)) :+: (C1 ('MetaCons "TcRnMissingImportList" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (IE GhcPs))) :+: C1 ('MetaCons "TcRnUnsafeDueToPlugin" 'PrefixI 'False) (U1 :: Type -> Type)))))) :+: ((((C1 ('MetaCons "TcRnModMissingRealSrcSpan" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Module)) :+: C1 ('MetaCons "TcRnIdNotExportedFromModuleSig" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Name) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Module))) :+: (C1 ('MetaCons "TcRnIdNotExportedFromLocalSig" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Name)) :+: C1 ('MetaCons "TcRnShadowedName" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 OccName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ShadowedNameProvenance)))) :+: ((C1 ('MetaCons "TcRnInvalidWarningCategory" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 WarningCategory)) :+: C1 ('MetaCons "TcRnDuplicateWarningDecls" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LocatedN RdrName)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 RdrName))) :+: (C1 ('MetaCons "TcRnSimplifierTooManyIterations" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Cts) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 IntWithInf) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 WantedConstraints))) :+: (C1 ('MetaCons "TcRnIllegalPatSynDecl" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LIdP GhcPs))) :+: C1 ('MetaCons "TcRnLinearPatSyn" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Type)))))) :+: (((C1 ('MetaCons "TcRnEmptyRecordUpdate" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TcRnIllegalFieldPunning" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Located RdrName)))) :+: (C1 ('MetaCons "TcRnIllegalWildcardsInRecord" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 RecordFieldPart)) :+: C1 ('MetaCons "TcRnIllegalWildcardInType" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Name)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 BadAnonWildcardContext)))) :+: ((C1 ('MetaCons "TcRnDuplicateFieldName" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 RecordFieldPart) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (NonEmpty RdrName))) :+: C1 ('MetaCons "TcRnIllegalViewPattern" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Pat GhcPs)))) :+: (C1 ('MetaCons "TcRnCharLiteralOutOfRange" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Char)) :+: (C1 ('MetaCons "TcRnNegativeNumTypeLiteral" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HsType GhcPs))) :+: C1 ('MetaCons "TcRnIllegalWildcardsInConstructor" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name)))))))) :+: (((((C1 ('MetaCons "TcRnIgnoringAnnotations" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [LAnnDecl GhcRn])) :+: C1 ('MetaCons "TcRnAnnotationInSafeHaskell" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "TcRnInvalidTypeApplication" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Type) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (LHsWcType GhcRn))) :+: C1 ('MetaCons "TcRnTagToEnumMissingValArg" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "TcRnTagToEnumUnspecifiedResTy" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Type)) :+: C1 ('MetaCons "TcRnTagToEnumResTyNotAnEnum" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Type))) :+: (C1 ('MetaCons "TcRnTagToEnumResTyTypeData" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Type)) :+: C1 ('MetaCons "TcRnArrowIfThenElsePredDependsOnResultTy" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: (((C1 ('MetaCons "TcRnIllegalHsBootOrSigDecl" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 HsBootOrSig) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 BadBootDecls)) :+: C1 ('MetaCons "TcRnBootMismatch" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 HsBootOrSig) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 BootMismatch))) :+: (C1 ('MetaCons "TcRnRecursivePatternSynonym" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (LHsBinds GhcRn))) :+: C1 ('MetaCons "TcRnPartialTypeSigTyVarMismatch" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Name) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Name)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Name) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (LHsSigWcType GhcRn)))))) :+: ((C1 ('MetaCons "TcRnPartialTypeSigBadQuantifier" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Name) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Name)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Type)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (LHsSigWcType GhcRn)))) :+: C1 ('MetaCons "TcRnMissingSignature" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 MissingSignature) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Exported))) :+: (C1 ('MetaCons "TcRnPolymorphicBinderMissingSig" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Name) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Type)) :+: (C1 ('MetaCons "TcRnOverloadedSig" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TcIdSigInfo)) :+: C1 ('MetaCons "TcRnTupleConstraintInst" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Class))))))) :+: ((((C1 ('MetaCons "TcRnUserTypeError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Type)) :+: C1 ('MetaCons "TcRnConstraintInKind" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Type))) :+: (C1 ('MetaCons "TcRnUnboxedTupleOrSumTypeFuncArg" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 UnboxedTupleOrSum) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Type)) :+: C1 ('MetaCons "TcRnLinearFuncInKind" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Type)))) :+: ((C1 ('MetaCons "TcRnForAllEscapeError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Type) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Kind)) :+: C1 ('MetaCons "TcRnVDQInTermType" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe Type)))) :+: (C1 ('MetaCons "TcRnBadQuantPredHead" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Type)) :+: (C1 ('MetaCons "TcRnIllegalTupleConstraint" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Type)) :+: C1 ('MetaCons "TcRnNonTypeVarArgInConstraint" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Type)))))) :+: (((C1 ('MetaCons "TcRnIllegalImplicitParam" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Type)) :+: C1 ('MetaCons "TcRnIllegalConstraintSynonymOfKind" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Type))) :+: (C1 ('MetaCons "TcRnOversaturatedVisibleKindArg" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Type)) :+: C1 ('MetaCons "TcRnForAllRankErr" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Rank) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Type)))) :+: ((C1 ('MetaCons "TcRnSimplifiableConstraint" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 PredType) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 InstanceWhat)) :+: C1 ('MetaCons "TcRnArityMismatch" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TyThing) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Arity) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Arity)))) :+: (C1 ('MetaCons "TcRnIllegalInstance" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 IllegalInstanceReason)) :+: (C1 ('MetaCons "TcRnMonomorphicBindings" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Name])) :+: C1 ('MetaCons "TcRnOrphanInstance" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Either ClsInst FamInst)))))))))) :+: ((((((C1 ('MetaCons "TcRnFunDepConflict" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 UnitState) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (NonEmpty ClsInst))) :+: C1 ('MetaCons "TcRnDupInstanceDecls" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 UnitState) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (NonEmpty ClsInst)))) :+: (C1 ('MetaCons "TcRnConflictingFamInstDecls" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (NonEmpty FamInst))) :+: C1 ('MetaCons "TcRnFamInstNotInjective" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 InjectivityErrReason) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TyCon) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (NonEmpty CoAxBranch)))))) :+: ((C1 ('MetaCons "TcRnBangOnUnliftedType" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Type)) :+: C1 ('MetaCons "TcRnLazyBangOnUnliftedType" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Type))) :+: (C1 ('MetaCons "TcRnMultipleDefaultDeclarations" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [LDefaultDecl GhcRn])) :+: C1 ('MetaCons "TcRnBadDefaultType" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Type) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Class]))))) :+: (((C1 ('MetaCons "TcRnPatSynBundledWithNonDataCon" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TcRnPatSynBundledWithWrongType" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Type) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Type))) :+: (C1 ('MetaCons "TcRnDupeModuleExport" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ModuleName)) :+: C1 ('MetaCons "TcRnExportedModNotImported" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ModuleName)))) :+: ((C1 ('MetaCons "TcRnNullExportedModule" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ModuleName)) :+: C1 ('MetaCons "TcRnMissingExportList" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ModuleName))) :+: (C1 ('MetaCons "TcRnExportHiddenComponents" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (IE GhcPs))) :+: (C1 ('MetaCons "TcRnDuplicateExport" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 GlobalRdrElt) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (IE GhcPs)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (IE GhcPs)))) :+: C1 ('MetaCons "TcRnExportedParentChildMismatch" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Name) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TyThing)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Name) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Name])))))))) :+: ((((C1 ('MetaCons "TcRnConflictingExports" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 OccName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 GlobalRdrElt)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (IE GhcPs)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 GlobalRdrElt) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (IE GhcPs))))) :+: C1 ('MetaCons "TcRnDuplicateFieldExport" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (GlobalRdrElt, IE GhcPs)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (NonEmpty (GlobalRdrElt, IE GhcPs))))) :+: (C1 ('MetaCons "TcRnAmbiguousRecordUpdate" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HsExpr GhcRn)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TyCon)) :+: C1 ('MetaCons "TcRnMissingFields" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ConLike) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [(FieldLabelString, TcType)])))) :+: ((C1 ('MetaCons "TcRnFieldUpdateInvalidType" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [(FieldLabelString, TcType)])) :+: C1 ('MetaCons "TcRnMissingStrictFields" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ConLike) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [(FieldLabelString, TcType)]))) :+: (C1 ('MetaCons "TcRnAmbiguousFieldInUpdate" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (GlobalRdrElt, GlobalRdrElt, [GlobalRdrElt]))) :+: (C1 ('MetaCons "TcRnBadRecordUpdate" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [RdrName]) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 BadRecordUpdateReason)) :+: C1 ('MetaCons "TcRnStaticFormNotClosed" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Name) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 NotClosedReason)))))) :+: (((C1 ('MetaCons "TcRnUselessTypeable" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TcRnDerivingDefaults" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Class))) :+: (C1 ('MetaCons "TcRnNonUnaryTypeclassConstraint" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsSigType GhcRn))) :+: C1 ('MetaCons "TcRnPartialTypeSignatures" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 SuggestPartialTypeSignatures) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ThetaType)))) :+: ((C1 ('MetaCons "TcRnCannotDeriveInstance" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Class) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Type])) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe (DerivStrategy GhcTc))) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 UsingGeneralizedNewtypeDeriving) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 DeriveInstanceErrReason)))) :+: C1 ('MetaCons "TcRnLazyGADTPattern" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "TcRnArrowProcGADTPattern" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "TcRnForallIdentifier" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RdrName)) :+: C1 ('MetaCons "TcRnCapturedTermName" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RdrName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Either [GlobalRdrElt] Name))))))))) :+: (((((C1 ('MetaCons "TcRnBindVarAlreadyInScope" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [LocatedN RdrName])) :+: C1 ('MetaCons "TcRnBindMultipleVariables" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 HsDocContext) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (LocatedN RdrName)))) :+: (C1 ('MetaCons "TcRnTypeEqualityOutOfScope" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TcRnTypeEqualityRequiresOperators" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "TcRnIllegalTypeOperator" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 SDoc) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 RdrName)) :+: C1 ('MetaCons "TcRnIllegalTypeOperatorDecl" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 RdrName))) :+: (C1 ('MetaCons "TcRnGADTMonoLocalBinds" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TcRnNotInScope" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 NotInScopeError) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RdrName)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [ImportError]) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [GhcHint])))))) :+: (((C1 ('MetaCons "TcRnTermNameInType" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RdrName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [GhcHint])) :+: C1 ('MetaCons "TcRnUntickedPromotedThing" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 UntickedPromotedThing))) :+: (C1 ('MetaCons "TcRnIllegalBuiltinSyntax" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 SDoc) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RdrName)) :+: C1 ('MetaCons "TcRnWarnDefaulting" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Ct]) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe TyVar)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Type))))) :+: ((C1 ('MetaCons "TcRnIncorrectNameSpace" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Name) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Bool)) :+: C1 ('MetaCons "TcRnForeignImportPrimExtNotSet" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (ForeignImport GhcRn)))) :+: (C1 ('MetaCons "TcRnForeignImportPrimSafeAnn" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (ForeignImport GhcRn))) :+: (C1 ('MetaCons "TcRnForeignFunctionImportAsValue" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (ForeignImport GhcRn))) :+: C1 ('MetaCons "TcRnFunPtrImportWithoutAmpersand" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (ForeignImport GhcRn)))))))) :+: ((((C1 ('MetaCons "TcRnIllegalForeignDeclBackend" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Either (ForeignExport GhcRn) (ForeignImport GhcRn))) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Backend) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ExpectedBackends))) :+: C1 ('MetaCons "TcRnUnsupportedCallConv" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Either (ForeignExport GhcRn) (ForeignImport GhcRn))) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 UnsupportedCallConvention))) :+: (C1 ('MetaCons "TcRnIllegalForeignType" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe ArgOrResult)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 IllegalForeignTypeReason)) :+: C1 ('MetaCons "TcRnInvalidCIdentifier" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 CLabelString)))) :+: ((C1 ('MetaCons "TcRnExpectedValueId" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TcTyThing)) :+: C1 ('MetaCons "TcRnRecSelectorEscapedTyVar" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 OccName))) :+: (C1 ('MetaCons "TcRnPatSynNotBidirectional" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name)) :+: (C1 ('MetaCons "TcRnIllegalDerivingItem" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsSigType GhcRn))) :+: C1 ('MetaCons "TcRnUnexpectedAnnotation" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (HsType GhcRn)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 HsSrcBang)))))) :+: (((C1 ('MetaCons "TcRnIllegalRecordSyntax" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Either (HsType GhcPs) (HsType GhcRn)))) :+: C1 ('MetaCons "TcRnInvalidVisibleKindArgument" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsType GhcRn)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Type))) :+: (C1 ('MetaCons "TcRnTooManyBinders" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Kind) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [LHsTyVarBndr (HsBndrVis GhcRn) GhcRn])) :+: C1 ('MetaCons "TcRnDifferentNamesForTyVar" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name)))) :+: ((C1 ('MetaCons "TcRnDisconnectedTyVar" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name)) :+: C1 ('MetaCons "TcRnInvalidReturnKind" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 DataSort) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 AllowedDataResKind)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Kind) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe SuggestUnliftedTypes))))) :+: (C1 ('MetaCons "TcRnUnexpectedKindVar" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RdrName)) :+: (C1 ('MetaCons "TcRnIllegalKind" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HsTypeOrSigType GhcPs)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Bool)) :+: C1 ('MetaCons "TcRnClassKindNotConstraint" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Kind)))))))))) :+: (((((((C1 ('MetaCons "TcRnUnpromotableThing" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 PromotionErr)) :+: C1 ('MetaCons "TcRnMatchesHaveDiffNumArgs" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (HsMatchContext GhcTc)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 MatchArgBadMatches))) :+: (C1 ('MetaCons "TcRnUnexpectedPatSigType" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HsPatSigType GhcPs))) :+: C1 ('MetaCons "TcRnIllegalKindSignature" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HsType GhcPs))))) :+: ((C1 ('MetaCons "TcRnDataKindsError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TypeOrKind) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HsType GhcPs))) :+: C1 ('MetaCons "TcRnCannotBindScopedTyVarInPatSig" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (NonEmpty (Name, TcTyVar))))) :+: (C1 ('MetaCons "TcRnCannotBindTyVarsInPatBind" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (NonEmpty (Name, TcTyVar)))) :+: C1 ('MetaCons "TcRnTooManyTyArgsInConPattern" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ConLike) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Int) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Int)))))) :+: (((C1 ('MetaCons "TcRnMultipleInlinePragmas" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Id) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LocatedA InlinePragma)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (NonEmpty (LocatedA InlinePragma))))) :+: C1 ('MetaCons "TcRnUnexpectedPragmas" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Id) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (NonEmpty (LSig GhcRn))))) :+: (C1 ('MetaCons "TcRnNonOverloadedSpecialisePragma" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LIdP GhcRn))) :+: C1 ('MetaCons "TcRnSpecialiseNotVisible" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name)))) :+: ((C1 ('MetaCons "TcRnPragmaWarning" 'PrefixI 'True) ((S1 ('MetaSel ('Just "pragma_warning_occ") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 OccName) :*: S1 ('MetaSel ('Just "pragma_warning_msg") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (WarningTxt GhcRn))) :*: (S1 ('MetaSel ('Just "pragma_warning_import_mod") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ModuleName) :*: S1 ('MetaSel ('Just "pragma_warning_defined_mod") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe ModuleName)))) :+: C1 ('MetaCons "TcRnDifferentExportWarnings" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (NonEmpty SrcSpan)))) :+: (C1 ('MetaCons "TcRnIncompleteExportWarnings" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (NonEmpty SrcSpan))) :+: (C1 ('MetaCons "TcRnIllegalHsigDefaultMethods" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (NonEmpty (LHsBind GhcRn)))) :+: C1 ('MetaCons "TcRnHsigFixityMismatch" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TyThing) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Fixity) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Fixity)))))))) :+: ((((C1 ('MetaCons "TcRnHsigShapeMismatch" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 HsigShapeMismatchReason)) :+: C1 ('MetaCons "TcRnHsigMissingModuleExport" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 OccName) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 UnitState) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Module)))) :+: (C1 ('MetaCons "TcRnBadGenericMethod" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name)) :+: C1 ('MetaCons "TcRnWarningMinimalDefIncomplete" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ClassMinimalDef)))) :+: ((C1 ('MetaCons "TcRnIllegalQuasiQuotes" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TcRnTHError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 THError))) :+: (C1 ('MetaCons "TcRnDefaultMethodForPragmaLacksBinding" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Id) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Sig GhcRn))) :+: (C1 ('MetaCons "TcRnIgnoreSpecialisePragmaOnDefMethod" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name)) :+: C1 ('MetaCons "TcRnBadMethodErr" 'PrefixI 'True) (S1 ('MetaSel ('Just "badMethodErrClassName") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name) :*: S1 ('MetaSel ('Just "badMethodErrMethodName") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name)))))) :+: (((C1 ('MetaCons "TcRnIllegalNewtype" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 DataCon) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Bool) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 IllegalNewtypeReason))) :+: C1 ('MetaCons "TcRnIllegalTypeData" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "TcRnTypeDataForbids" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TypeDataForbids)) :+: C1 ('MetaCons "TcRnUnsatisfiedMinimalDef" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ClassMinimalDef)))) :+: ((C1 ('MetaCons "TcRnMisplacedInstSig" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Name) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (LHsSigType GhcRn))) :+: C1 ('MetaCons "TcRnNoRebindableSyntaxRecordDot" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "TcRnNoFieldPunsRecordDot" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "TcRnIllegalStaticExpression" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HsExpr GhcPs))) :+: C1 ('MetaCons "TcRnListComprehensionDuplicateBinding" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Name)))))))) :+: (((((C1 ('MetaCons "TcRnEmptyStmtsGroup" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 EmptyStatementGroupErrReason)) :+: C1 ('MetaCons "TcRnLastStmtNotExpr" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HsStmtContext GhcRn)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 UnexpectedStatement))) :+: (C1 ('MetaCons "TcRnUnexpectedStatementInContext" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HsStmtContext GhcRn)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 UnexpectedStatement) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Extension)))) :+: C1 ('MetaCons "TcRnIllegalTupleSection" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "TcRnIllegalImplicitParameterBindings" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Either (HsLocalBindsLR GhcPs GhcPs) (HsLocalBindsLR GhcRn GhcPs)))) :+: C1 ('MetaCons "TcRnSectionWithoutParentheses" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HsExpr GhcPs)))) :+: (C1 ('MetaCons "TcRnBindingOfExistingName" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RdrName)) :+: C1 ('MetaCons "TcRnMultipleFixityDecls" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 SrcSpan) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RdrName))))) :+: (((C1 ('MetaCons "TcRnIllegalPatternSynonymDecl" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TcRnIllegalClassBinding" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 DeclSort) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HsBindLR GhcPs GhcPs)))) :+: (C1 ('MetaCons "TcRnOrphanCompletePragma" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TcRnEmptyCase" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HsMatchContext GhcRn))))) :+: ((C1 ('MetaCons "TcRnNonStdGuards" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 NonStandardGuards)) :+: C1 ('MetaCons "TcRnDuplicateSigDecl" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (NonEmpty (LocatedN RdrName, Sig GhcPs))))) :+: (C1 ('MetaCons "TcRnMisplacedSigDecl" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Sig GhcRn))) :+: (C1 ('MetaCons "TcRnUnexpectedDefaultSig" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Sig GhcPs))) :+: C1 ('MetaCons "TcRnDuplicateMinimalSig" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (LSig GhcPs)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (LSig GhcPs)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [LSig GhcPs])))))))) :+: ((((C1 ('MetaCons "TcRnIllegalInvisTyVarBndr" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsTyVarBndr (HsBndrVis GhcRn) GhcRn))) :+: C1 ('MetaCons "TcRnInvalidInvisTyVarBndr" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsTyVarBndr (HsBndrVis GhcRn) GhcRn)))) :+: (C1 ('MetaCons "TcRnInvisBndrWithoutSig" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsTyVarBndr (HsBndrVis GhcRn) GhcRn))) :+: C1 ('MetaCons "TcRnDeprecatedInvisTyArgInConPat" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "TcRnLoopySuperclassSolve" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 CtLoc) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 PredType)) :+: C1 ('MetaCons "TcRnUnexpectedStandaloneDerivingDecl" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "TcRnUnusedVariableInRuleDecl" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 FastString) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Name)) :+: (C1 ('MetaCons "TcRnUnexpectedStandaloneKindSig" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TcRnIllegalRuleLhs" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RuleLhsErrReason) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 FastString)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (LHsExpr GhcRn)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HsExpr GhcRn)))))))) :+: (((C1 ('MetaCons "TcRnDuplicateRoleAnnot" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (NonEmpty (LRoleAnnotDecl GhcPs)))) :+: C1 ('MetaCons "TcRnDuplicateKindSig" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (NonEmpty (LStandaloneKindSig GhcPs))))) :+: (C1 ('MetaCons "TcRnIllegalDerivStrategy" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (DerivStrategy GhcPs))) :+: C1 ('MetaCons "TcRnIllegalMultipleDerivClauses" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "TcRnNoDerivStratSpecified" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Bool)) :+: C1 ('MetaCons "TcRnStupidThetaInGadt" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 HsDocContext))) :+: (C1 ('MetaCons "TcRnShadowedTyVarNameInFamResult" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (IdP GhcPs))) :+: (C1 ('MetaCons "TcRnIncorrectTyVarOnLhsOfInjCond" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (IdP GhcRn)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (LIdP GhcPs))) :+: C1 ('MetaCons "TcRnUnknownTyVarsOnRhsOfInjCond" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Name]))))))))) :+: ((((((C1 ('MetaCons "TcRnLookupInstance" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Class) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [Type]) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 LookupInstanceErrReason))) :+: C1 ('MetaCons "TcRnBadlyStaged" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StageCheckReason) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Int) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Int)))) :+: (C1 ('MetaCons "TcRnStageRestriction" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StageCheckReason)) :+: C1 ('MetaCons "TcRnTyThingUsedWrong" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 WrongThingSort) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TcTyThing) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name))))) :+: ((C1 ('MetaCons "TcRnCannotDefaultKindVar" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TyVar) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Kind)) :+: C1 ('MetaCons "TcRnUninferrableTyVar" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [TyCoVar]) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 UninferrableTyVarCtx))) :+: (C1 ('MetaCons "TcRnSkolemEscape" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [TcTyVar]) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TcTyVar) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Type))) :+: C1 ('MetaCons "TcRnPatSynEscapedCoercion" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Id) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (NonEmpty CoVar)))))) :+: (((C1 ('MetaCons "TcRnPatSynExistentialInResult" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TcSigmaType) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [TyVar]))) :+: C1 ('MetaCons "TcRnPatSynArityMismatch" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Arity) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Arity)))) :+: (C1 ('MetaCons "TcRnPatSynInvalidRhs" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LPat GhcRn))) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [LIdP GhcRn]) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 PatSynInvalidRhsReason))) :+: C1 ('MetaCons "TcRnZonkerMessage" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ZonkerMessage)))) :+: ((C1 ('MetaCons "TcRnTyFamDepsDisabled" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TcRnAbstractClosedTyFamDecl" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "TcRnPartialFieldSelector" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 FieldLabel)) :+: (C1 ('MetaCons "TcRnBadFieldAnnotation" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Int) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 DataCon) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 BadFieldAnnotationReason))) :+: C1 ('MetaCons "TcRnSuperclassCycle" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 SuperclassCycle))))))) :+: ((((C1 ('MetaCons "TcRnDefaultSigMismatch" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Id) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Type)) :+: C1 ('MetaCons "TcRnTyFamsDisabled" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TyFamsDisabledReason))) :+: (C1 ('MetaCons "TcRnBadTyConTelescope" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TyCon)) :+: C1 ('MetaCons "TcRnTyFamResultDisabled" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsTyVarBndr () GhcRn))))) :+: ((C1 ('MetaCons "TcRnRoleValidationFailed" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Role) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 RoleValidationFailedReason)) :+: C1 ('MetaCons "TcRnCommonFieldResultTypeMismatch" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 DataCon) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 DataCon) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 FieldLabelString)))) :+: (C1 ('MetaCons "TcRnCommonFieldTypeMismatch" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 DataCon) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 DataCon) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 FieldLabelString))) :+: (C1 ('MetaCons "TcRnClassExtensionDisabled" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Class) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 DisabledClassExtension)) :+: C1 ('MetaCons "TcRnDataConParentTypeMismatch" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 DataCon) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Type)))))) :+: (((C1 ('MetaCons "TcRnGADTsDisabled" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name)) :+: C1 ('MetaCons "TcRnExistentialQuantificationDisabled" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 DataCon))) :+: (C1 ('MetaCons "TcRnGADTDataContext" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name)) :+: C1 ('MetaCons "TcRnMultipleConForNewtype" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Int)))) :+: ((C1 ('MetaCons "TcRnKindSignaturesDisabled" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Either (HsType GhcPs) (Name, HsType GhcRn)))) :+: C1 ('MetaCons "TcRnEmptyDataDeclsDisabled" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name))) :+: (C1 ('MetaCons "TcRnRoleMismatch" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Role) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Role))) :+: (C1 ('MetaCons "TcRnRoleCountMismatch" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Int) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LRoleAnnotDecl GhcRn))) :+: C1 ('MetaCons "TcRnIllegalRoleAnnotation" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (RoleAnnotDecl GhcRn))))))))) :+: (((((C1 ('MetaCons "TcRnRoleAnnotationsDisabled" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TyCon)) :+: C1 ('MetaCons "TcRnIncoherentRoles" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TyCon))) :+: (C1 ('MetaCons "TcRnPrecedenceParsingError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (OpName, Fixity)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (OpName, Fixity))) :+: C1 ('MetaCons "TcRnSectionPrecedenceError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (OpName, Fixity)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (OpName, Fixity)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HsExpr GhcPs)))))) :+: ((C1 ('MetaCons "TcRnTypeSynonymCycle" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TySynCycleTyCons)) :+: C1 ('MetaCons "TcRnSelfImport" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ModuleName))) :+: (C1 ('MetaCons "TcRnNoExplicitImportList" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ModuleName)) :+: (C1 ('MetaCons "TcRnSafeImportsDisabled" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ModuleName)) :+: C1 ('MetaCons "TcRnDeprecatedModule" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ModuleName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (WarningTxt GhcRn))))))) :+: (((C1 ('MetaCons "TcRnCompatUnqualifiedImport" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (ImportDecl GhcPs))) :+: C1 ('MetaCons "TcRnRedundantSourceImport" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ModuleName))) :+: (C1 ('MetaCons "TcRnImportLookup" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ImportLookupReason)) :+: C1 ('MetaCons "TcRnUnusedImport" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (ImportDecl GhcRn)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 UnusedImportReason)))) :+: ((C1 ('MetaCons "TcRnDuplicateDecls" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 OccName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (NonEmpty Name))) :+: C1 ('MetaCons "TcRnPackageImportsDisabled" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "TcRnIllegalDataCon" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 RdrName)) :+: (C1 ('MetaCons "TcRnNestedForallsContexts" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 NestedForallsContextsIn)) :+: C1 ('MetaCons "TcRnRedundantRecordWildcard" 'PrefixI 'False) (U1 :: Type -> Type)))))) :+: ((((C1 ('MetaCons "TcRnUnusedRecordWildcard" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [Name])) :+: C1 ('MetaCons "TcRnUnusedName" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 OccName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 UnusedNameProv))) :+: (C1 ('MetaCons "TcRnQualifiedBinder" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 RdrName)) :+: C1 ('MetaCons "TcRnTypeApplicationsDisabled" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TypeApplication)))) :+: ((C1 ('MetaCons "TcRnInvalidRecordField" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 FieldLabelString)) :+: C1 ('MetaCons "TcRnTupleTooLarge" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Int))) :+: (C1 ('MetaCons "TcRnCTupleTooLarge" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Int)) :+: (C1 ('MetaCons "TcRnIllegalInferredTyVars" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (NonEmpty (HsTyVarBndr Specificity GhcPs)))) :+: C1 ('MetaCons "TcRnAmbiguousName" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 GlobalRdrEnv) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 RdrName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (NonEmpty GlobalRdrElt)))))))) :+: (((C1 ('MetaCons "TcRnBindingNameConflict" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 RdrName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (NonEmpty SrcSpan))) :+: C1 ('MetaCons "TcRnNonCanonicalDefinition" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 NonCanonicalDefinition) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsSigType GhcRn)))) :+: (C1 ('MetaCons "TcRnImplicitImportOfPrelude" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TcRnMissingMain" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Module) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 OccName))))) :+: ((C1 ('MetaCons "TcRnGhciUnliftedBind" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Id)) :+: C1 ('MetaCons "TcRnGhciMonadLookupFail" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 String) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe [GlobalRdrElt])))) :+: (C1 ('MetaCons "TcRnMissingRoleAnnotation" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Name) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Role])) :+: (C1 ('MetaCons "TcRnPatersonCondFailure" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 PatersonCondFailure) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 PatersonCondFailureContext)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Type) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Type))) :+: C1 ('MetaCons "TcRnImplicitRhsQuantification" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (LocatedN RdrName)))))))))))) | |||||
type DiagnosticOpts TcRnMessage | |||||
Defined in GHC.Tc.Errors.Ppr |
data TcRnMessageDetailed #
TcRnMessageDetailed
is an "internal" type (used only inside
Monad
that wraps a TcRnMessage
while also providing
any extra info needed to correctly pretty-print this diagnostic later on.
Constructors
TcRnMessageDetailed | |
Fields
|
Instances
Generic TcRnMessageDetailed | |||||
Defined in GHC.Tc.Errors.Types Associated Types
Methods from :: TcRnMessageDetailed -> Rep TcRnMessageDetailed x # to :: Rep TcRnMessageDetailed x -> TcRnMessageDetailed # | |||||
type Rep TcRnMessageDetailed | |||||
Defined in GHC.Tc.Errors.Types type Rep TcRnMessageDetailed = D1 ('MetaData "TcRnMessageDetailed" "GHC.Tc.Errors.Types" "ghc-9.8.4-inplace" 'False) (C1 ('MetaCons "TcRnMessageDetailed" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ErrInfo) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TcRnMessage))) |
stripTcRnMessageContext :: TcRnMessage -> TcRnMessage Source #
Some TcRnMessage
s are nested in other constructors for additional context.
For example, TcRnWithHsDocContext
and TcRnMessageWithInfo
.
However, in some occasions you don't need the additional context and you just want
the error message.
recursively unwraps these constructors,
until there are no more constructors with additional context.stripTcRnMessageContext
Parsing error message
Constructors
PsHeaderMessage !PsHeaderMessage | A group of parser messages emitted in |
Instances
Generic PsMessage | |||||
Defined in GHC.Parser.Errors.Types Associated Types
| |||||
type Rep PsMessage | |||||
Defined in GHC.Parser.Errors.Types type Rep PsMessage = D1 ('MetaData "PsMessage" "GHC.Parser.Errors.Types" "ghc-9.8.4-inplace" 'False) ((((((C1 ('MetaCons "PsUnknownMessage" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (UnknownDiagnostic (DiagnosticOpts PsMessage)))) :+: (C1 ('MetaCons "PsHeaderMessage" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 PsHeaderMessage)) :+: C1 ('MetaCons "PsWarnBidirectionalFormatChars" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (NonEmpty (PsLoc, Char, String)))))) :+: ((C1 ('MetaCons "PsWarnTab" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Word)) :+: C1 ('MetaCons "PsWarnTransitionalLayout" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TransLayoutReason))) :+: (C1 ('MetaCons "PsWarnUnrecognisedPragma" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 String) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [String])) :+: C1 ('MetaCons "PsWarnMisplacedPragma" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 FileHeaderPragmaType))))) :+: ((C1 ('MetaCons "PsWarnHaddockInvalidPos" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "PsWarnHaddockIgnoreMulti" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "PsWarnStarBinder" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "PsWarnStarIsType" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "PsWarnImportPreQualified" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "PsWarnOperatorWhitespaceExtConflict" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 OperatorWhitespaceSymbol)) :+: C1 ('MetaCons "PsWarnOperatorWhitespace" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 FastString) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 OperatorWhitespaceOccurrence)))))) :+: (((C1 ('MetaCons "PsErrLambdaCase" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "PsErrEmptyLambda" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "PsErrNumUnderscores" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 NumUnderscoreReason)))) :+: ((C1 ('MetaCons "PsErrPrimStringInvalidChar" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "PsErrMissingBlock" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "PsErrLexer" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 LexErr) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 LexErrKind)) :+: C1 ('MetaCons "PsErrSuffixAT" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: (((C1 ('MetaCons "PsErrParse" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 String) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 PsErrParseDetails)) :+: C1 ('MetaCons "PsErrCmmLexer" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "PsErrUnsupportedBoxedSumExpr" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (SumOrTuple (HsExpr GhcPs)))) :+: C1 ('MetaCons "PsErrUnsupportedBoxedSumPat" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (SumOrTuple (PatBuilder GhcPs)))))) :+: ((C1 ('MetaCons "PsErrUnexpectedQualifiedConstructor" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 RdrName)) :+: C1 ('MetaCons "PsErrTupleSectionInPat" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "PsErrIllegalBangPattern" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Pat GhcPs))) :+: C1 ('MetaCons "PsErrOpFewArgs" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StarIsType) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 RdrName))))))) :+: ((((C1 ('MetaCons "PsErrImportQualifiedTwice" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "PsErrImportPostQualified" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "PsErrIllegalExplicitNamespace" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "PsErrVarForTyCon" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 RdrName)) :+: C1 ('MetaCons "PsErrIllegalPatSynExport" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "PsErrMalformedEntityString" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "PsErrDotsInRecordUpdate" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: ((C1 ('MetaCons "PsErrPrecedenceOutOfRange" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Int)) :+: (C1 ('MetaCons "PsErrOverloadedRecordDotInvalid" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "PsErrOverloadedRecordUpdateNotEnabled" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "PsErrOverloadedRecordUpdateNoQualifiedFields" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "PsErrInvalidDataCon" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (HsType GhcPs)))) :+: (C1 ('MetaCons "PsErrInvalidInfixDataCon" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (HsType GhcPs)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 RdrName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (HsType GhcPs)))) :+: C1 ('MetaCons "PsErrIllegalPromotionQuoteDataCon" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 RdrName)))))) :+: (((C1 ('MetaCons "PsErrUnpackDataCon" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "PsErrUnexpectedKindAppInDataCon" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 DataConBuilder) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (HsType GhcPs))) :+: C1 ('MetaCons "PsErrInvalidRecordCon" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (PatBuilder GhcPs))))) :+: ((C1 ('MetaCons "PsErrIllegalUnboxedStringInPat" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (HsLit GhcPs))) :+: C1 ('MetaCons "PsErrIllegalUnboxedFloatingLitInPat" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (HsLit GhcPs)))) :+: (C1 ('MetaCons "PsErrDoNotationInPat" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "PsErrIfThenElseInPat" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: (((C1 ('MetaCons "PsErrLambdaCaseInPat" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 LamCaseVariant)) :+: C1 ('MetaCons "PsErrCaseInPat" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "PsErrLetInPat" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "PsErrLambdaInPat" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "PsErrArrowExprInPat" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (HsExpr GhcPs))) :+: C1 ('MetaCons "PsErrArrowCmdInPat" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (HsCmd GhcPs)))) :+: (C1 ('MetaCons "PsErrArrowCmdInExpr" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (HsCmd GhcPs))) :+: C1 ('MetaCons "PsErrViewPatInExpr" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsExpr GhcPs)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsExpr GhcPs))))))))) :+: (((((C1 ('MetaCons "PsErrTypeAppWithoutSpace" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 RdrName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsExpr GhcPs))) :+: (C1 ('MetaCons "PsErrLazyPatWithoutSpace" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsExpr GhcPs))) :+: C1 ('MetaCons "PsErrBangPatWithoutSpace" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsExpr GhcPs))))) :+: ((C1 ('MetaCons "PsErrUnallowedPragma" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (HsPragE GhcPs))) :+: C1 ('MetaCons "PsErrQualifiedDoInCmd" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ModuleName))) :+: (C1 ('MetaCons "PsErrInvalidInfixHole" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "PsErrSemiColonsInCondExpr" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (HsExpr GhcPs)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (HsExpr GhcPs)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (HsExpr GhcPs)))))))) :+: ((C1 ('MetaCons "PsErrSemiColonsInCondCmd" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (HsExpr GhcPs)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (HsCmd GhcPs)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (HsCmd GhcPs))))) :+: (C1 ('MetaCons "PsErrAtInPatPos" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "PsErrLambdaCmdInFunAppCmd" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsCmd GhcPs))))) :+: ((C1 ('MetaCons "PsErrCaseCmdInFunAppCmd" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsCmd GhcPs))) :+: C1 ('MetaCons "PsErrLambdaCaseCmdInFunAppCmd" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 LamCaseVariant) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsCmd GhcPs)))) :+: (C1 ('MetaCons "PsErrIfCmdInFunAppCmd" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsCmd GhcPs))) :+: C1 ('MetaCons "PsErrLetCmdInFunAppCmd" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsCmd GhcPs))))))) :+: (((C1 ('MetaCons "PsErrDoCmdInFunAppCmd" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsCmd GhcPs))) :+: (C1 ('MetaCons "PsErrDoInFunAppExpr" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe ModuleName)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsExpr GhcPs))) :+: C1 ('MetaCons "PsErrMDoInFunAppExpr" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe ModuleName)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsExpr GhcPs))))) :+: ((C1 ('MetaCons "PsErrLambdaInFunAppExpr" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsExpr GhcPs))) :+: C1 ('MetaCons "PsErrCaseInFunAppExpr" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsExpr GhcPs)))) :+: (C1 ('MetaCons "PsErrLambdaCaseInFunAppExpr" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 LamCaseVariant) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsExpr GhcPs))) :+: C1 ('MetaCons "PsErrLetInFunAppExpr" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsExpr GhcPs)))))) :+: (((C1 ('MetaCons "PsErrIfInFunAppExpr" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsExpr GhcPs))) :+: C1 ('MetaCons "PsErrProcInFunAppExpr" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsExpr GhcPs)))) :+: (C1 ('MetaCons "PsErrMalformedTyOrClDecl" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsType GhcPs))) :+: C1 ('MetaCons "PsErrIllegalWhereInDataDecl" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "PsErrIllegalDataTypeContext" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsContext GhcPs))) :+: C1 ('MetaCons "PsErrParseErrorOnInput" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 OccName))) :+: (C1 ('MetaCons "PsErrMalformedDecl" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 SDoc) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 RdrName)) :+: C1 ('MetaCons "PsErrNotADataCon" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 RdrName))))))) :+: ((((C1 ('MetaCons "PsErrRecordSyntaxInPatSynDecl" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LPat GhcPs))) :+: (C1 ('MetaCons "PsErrEmptyWhereInPatSynDecl" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 RdrName)) :+: C1 ('MetaCons "PsErrInvalidWhereBindInPatSynDecl" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 RdrName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (HsDecl GhcPs))))) :+: ((C1 ('MetaCons "PsErrNoSingleWhereBindInPatSynDecl" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 RdrName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (HsDecl GhcPs))) :+: C1 ('MetaCons "PsErrDeclSpliceNotAtTopLevel" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (SpliceDecl GhcPs)))) :+: (C1 ('MetaCons "PsErrInferredTypeVarNotAllowed" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "PsErrMultipleNamesInStandaloneKindSignature" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [LIdP GhcPs]))))) :+: ((C1 ('MetaCons "PsErrIllegalImportBundleForm" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "PsErrIllegalRoleName" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 FastString) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Role])) :+: C1 ('MetaCons "PsErrInvalidTypeSignature" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsExpr GhcPs))))) :+: ((C1 ('MetaCons "PsErrUnexpectedTypeInDecl" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsType GhcPs)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 SDoc)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 RdrName) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [LHsTypeArg GhcPs]) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 SDoc)))) :+: C1 ('MetaCons "PsErrExpectedHyphen" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "PsErrSpaceInSCC" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "PsErrEmptyDoubleQuotes" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool)))))) :+: (((C1 ('MetaCons "PsErrInvalidPackageName" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 FastString)) :+: (C1 ('MetaCons "PsErrInvalidRuleActivationMarker" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "PsErrLinearFunction" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "PsErrMultiWayIf" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "PsErrExplicitForall" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Bool))) :+: (C1 ('MetaCons "PsErrIllegalQualifiedDo" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 SDoc)) :+: C1 ('MetaCons "PsErrCmmParser" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 CmmParserError))))) :+: (((C1 ('MetaCons "PsErrIllegalTraditionalRecordSyntax" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 SDoc)) :+: C1 ('MetaCons "PsErrParseErrorInCmd" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 SDoc))) :+: (C1 ('MetaCons "PsErrInPat" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (PatBuilder GhcPs)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 PsErrInPatDetails)) :+: C1 ('MetaCons "PsErrParseRightOpSectionInPat" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 RdrName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (PatBuilder GhcPs))))) :+: ((C1 ('MetaCons "PsErrIllegalGadtRecordMultiplicity" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (HsArrow GhcPs))) :+: C1 ('MetaCons "PsErrInvalidCApiImport" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "PsErrMultipleConForNewtype" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 RdrName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 Int)) :+: C1 ('MetaCons "PsErrUnicodeCharLooksLike" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Char) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Char) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 String)))))))))) | |||||
type DiagnosticOpts PsMessage | |||||
Defined in GHC.Parser.Errors.Ppr |
Desugaring diagnostic
Diagnostics messages emitted during desugaring.
Constructors
DsUnknownMessage (UnknownDiagnostic (DiagnosticOpts DsMessage)) | Simply wraps a generic |
DsEmptyEnumeration | DsEmptyEnumeration is a warning (controlled by the -Wempty-enumerations flag) that is emitted if an enumeration is empty. Example(s): main :: IO () main = do let enum = [5 .. 3] print enum Here Test case(s): warningsshould_compileT10930 warningsshould_compileT18402 warningsshould_compileT10930b numericshould_compileT10929 numericshould_compileT7881 deSugarshould_runT18172 |
DsIdentitiesFound !Id !Type | DsIdentitiesFound is a warning (controlled by the -Widentities flag) that is emitted on uses of Prelude numeric conversions that are probably the identity (and hence could be omitted). Example(s): main :: IO () main = do let x = 10 print $ conv 10 where conv :: Int -> Int conv x = fromIntegral x Here calling Test case(s): deSugarshould_compileT4488 |
DsOverflowedLiterals !Integer !Name !(Maybe (MinBound, MaxBound)) !NegLiteralExtEnabled | |
DsRedundantBangPatterns !(HsMatchContext GhcTc) !SDoc | |
DsOverlappingPatterns !(HsMatchContext GhcTc) !SDoc | |
DsInaccessibleRhs !(HsMatchContext GhcTc) !SDoc | |
DsMaxPmCheckModelsReached !MaxPmCheckModels | |
DsNonExhaustivePatterns !(HsMatchContext GhcTc) !ExhaustivityCheckType !MaxUncoveredPatterns [Id] [Nabla] | |
DsTopLevelBindsNotAllowed !BindsType !(HsBindLR GhcTc GhcTc) | |
DsUselessSpecialiseForClassMethodSelector !Id | |
DsUselessSpecialiseForNoInlineFunction !Id | |
DsMultiplicityCoercionsNotSupported | |
DsOrphanRule !CoreRule | |
DsRuleLhsTooComplicated !CoreExpr !CoreExpr | |
DsRuleIgnoredDueToConstructor !DataCon | |
DsRuleBindersNotBound | |
DsLazyPatCantBindVarsOfUnliftedType [Var] | |
DsNotYetHandledByTH !ThRejectionReason | |
DsAggregatedViewExpressions [[LHsExpr GhcTc]] | |
DsUnbangedStrictPatterns !(HsBindLR GhcTc GhcTc) | |
DsCannotMixPolyAndUnliftedBindings !(HsBindLR GhcTc GhcTc) | |
DsWrongDoBind !(LHsExpr GhcTc) !Type | |
DsUnusedDoBind !(LHsExpr GhcTc) !Type | |
DsRecBindsNotAllowedForUnliftedTys ![LHsBindLR GhcTc GhcTc] | |
DsRuleMightInlineFirst !RuleName !Var !Activation | |
DsAnotherRuleMightFireFirst !RuleName !RuleName !Var |
Instances
Generic DsMessage | |||||
Defined in GHC.HsToCore.Errors.Types Associated Types
| |||||
type Rep DsMessage | |||||
Defined in GHC.HsToCore.Errors.Types type Rep DsMessage = D1 ('MetaData "DsMessage" "GHC.HsToCore.Errors.Types" "ghc-9.8.4-inplace" 'False) ((((C1 ('MetaCons "DsUnknownMessage" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (UnknownDiagnostic (DiagnosticOpts DsMessage)))) :+: (C1 ('MetaCons "DsEmptyEnumeration" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "DsIdentitiesFound" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Id) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Type)))) :+: (C1 ('MetaCons "DsOverflowedLiterals" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Integer) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Name)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Maybe (MinBound, MaxBound))) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 NegLiteralExtEnabled))) :+: (C1 ('MetaCons "DsRedundantBangPatterns" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (HsMatchContext GhcTc)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 SDoc)) :+: C1 ('MetaCons "DsOverlappingPatterns" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (HsMatchContext GhcTc)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 SDoc))))) :+: ((C1 ('MetaCons "DsInaccessibleRhs" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (HsMatchContext GhcTc)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 SDoc)) :+: (C1 ('MetaCons "DsMaxPmCheckModelsReached" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 MaxPmCheckModels)) :+: C1 ('MetaCons "DsNonExhaustivePatterns" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (HsMatchContext GhcTc)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ExhaustivityCheckType)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedUnpack) (Rec0 MaxUncoveredPatterns) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Id]) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Nabla])))))) :+: ((C1 ('MetaCons "DsTopLevelBindsNotAllowed" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 BindsType) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (HsBindLR GhcTc GhcTc))) :+: C1 ('MetaCons "DsUselessSpecialiseForClassMethodSelector" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Id))) :+: (C1 ('MetaCons "DsUselessSpecialiseForNoInlineFunction" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Id)) :+: C1 ('MetaCons "DsMultiplicityCoercionsNotSupported" 'PrefixI 'False) (U1 :: Type -> Type))))) :+: (((C1 ('MetaCons "DsOrphanRule" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 CoreRule)) :+: (C1 ('MetaCons "DsRuleLhsTooComplicated" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 CoreExpr) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 CoreExpr)) :+: C1 ('MetaCons "DsRuleIgnoredDueToConstructor" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 DataCon)))) :+: ((C1 ('MetaCons "DsRuleBindersNotBound" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [Var]) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [Var])) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 CoreExpr) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 CoreExpr))) :+: C1 ('MetaCons "DsLazyPatCantBindVarsOfUnliftedType" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Var]))) :+: (C1 ('MetaCons "DsNotYetHandledByTH" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ThRejectionReason)) :+: C1 ('MetaCons "DsAggregatedViewExpressions" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [[LHsExpr GhcTc]]))))) :+: ((C1 ('MetaCons "DsUnbangedStrictPatterns" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (HsBindLR GhcTc GhcTc))) :+: (C1 ('MetaCons "DsCannotMixPolyAndUnliftedBindings" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (HsBindLR GhcTc GhcTc))) :+: C1 ('MetaCons "DsWrongDoBind" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsExpr GhcTc)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Type)))) :+: ((C1 ('MetaCons "DsUnusedDoBind" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (LHsExpr GhcTc)) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Type)) :+: C1 ('MetaCons "DsRecBindsNotAllowedForUnliftedTys" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [LHsBindLR GhcTc GhcTc]))) :+: (C1 ('MetaCons "DsRuleMightInlineFirst" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 RuleName) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Var) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Activation))) :+: C1 ('MetaCons "DsAnotherRuleMightFireFirst" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 RuleName) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 RuleName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Var)))))))) | |||||
type DiagnosticOpts DsMessage | |||||
Defined in GHC.HsToCore.Errors.Ppr |
Driver error message
data DriverMessage where #
A message from the driver.
Constructors
DriverUnknownMessage :: UnknownDiagnostic (DiagnosticOpts DriverMessage) -> DriverMessage | Simply wraps a generic |
DriverPsHeaderMessage :: !PsMessage -> DriverMessage | A parse error in parsing a Haskell file header during dependency analysis |
DriverMissingHomeModules :: UnitId -> [ModuleName] -> !BuildingCabalPackage -> DriverMessage | DriverMissingHomeModules is a warning (controlled with -Wmissing-home-modules) that arises when running GHC in --make mode when some modules needed for compilation are not included on the command line. For example, if A imports B, `ghc --make A.hs` will cause this warning, while `ghc --make A.hs B.hs` will not. Useful for cabal to ensure GHC won't pick up modules listed neither in 'exposed-modules' nor in 'other-modules'. Test case: warningsshould_compileMissingMod |
DriverUnknownReexportedModules :: UnitId -> [ModuleName] -> DriverMessage | DriverUnknown is a warning that arises when a user tries to reexport a module which isn't part of that unit. |
DriverUnknownHiddenModules :: UnitId -> [ModuleName] -> DriverMessage | DriverUnknownHiddenModules is a warning that arises when a user tries to hide a module which isn't part of that unit. |
DriverUnusedPackages :: [(UnitId, PackageName, Version, PackageArg)] -> DriverMessage | DriverUnusedPackages occurs when when package is requested on command line, but was never needed during compilation. Activated by -Wunused-packages. Test cases: warningsshould_compileUnusedPackages |
DriverUnnecessarySourceImports :: !ModuleName -> DriverMessage | DriverUnnecessarySourceImports (controlled with -Wunused-imports) occurs if there
are {-# SOURCE #-} imports which are not necessary. See Test cases: warningsshould_compileT10637 |
DriverDuplicatedModuleDeclaration :: !Module -> [FilePath] -> DriverMessage | DriverDuplicatedModuleDeclaration occurs if a module Test cases: None. |
DriverModuleNotFound :: !ModuleName -> DriverMessage | DriverModuleNotFound occurs if a module Test cases: None. |
DriverFileModuleNameMismatch :: !ModuleName -> !ModuleName -> DriverMessage | DriverFileModuleNameMismatch occurs if a module Test cases: modulemod178, driver/bug1677 |
DriverUnexpectedSignature :: !ModuleName -> !BuildingCabalPackage -> GenInstantiations UnitId -> DriverMessage | DriverUnexpectedSignature occurs when GHC encounters a module Example:
Test cases: driver/T12955 |
DriverFileNotFound :: !FilePath -> DriverMessage | DriverFileNotFound occurs when the input file (e.g. given on the command line) can't be found. Test cases: None. |
DriverStaticPointersNotSupported :: DriverMessage | DriverStaticPointersNotSupported occurs when the Test cases: ghciscriptsStaticPtr |
DriverBackpackModuleNotFound :: !ModuleName -> DriverMessage | DriverBackpackModuleNotFound occurs when Backpack can't find a particular module during its dependency analysis. Test cases: - |
DriverUserDefinedRuleIgnored :: !(RuleDecl GhcTc) -> DriverMessage | DriverUserDefinedRuleIgnored is a warning that occurs when user-defined rules are ignored. This typically happens when Safe Haskell. Test cases: testssafeHaskellsafeInfered/UnsafeWarn05 testssafeHaskellsafeInfered/UnsafeWarn06 testssafeHaskellsafeInfered/UnsafeWarn07 testssafeHaskellsafeInfered/UnsafeInfered11 testssafeHaskellsafeLanguage/SafeLang03 |
DriverMixedSafetyImport :: !ModuleName -> DriverMessage | DriverMixedSafetyImport is an error that occurs when a module is imported both as safe and unsafe. Test cases: testssafeHaskellsafeInfered/Mixed03 testssafeHaskellsafeInfered/Mixed02 |
DriverCannotLoadInterfaceFile :: !Module -> DriverMessage | DriverCannotLoadInterfaceFile is an error that occurs when we cannot load the interface file for a particular module. This can happen for example in the context of Safe Haskell, when we have to load a module to check if it can be safely imported. Test cases: None. |
DriverInferredSafeModule :: !Module -> DriverMessage | DriverInferredSafeImport is a warning (controlled by the Opt_WarnSafe flag) that occurs when a module is inferred safe. Test cases: None. |
DriverMarkedTrustworthyButInferredSafe :: !Module -> DriverMessage | DriverMarkedTrustworthyButInferredSafe is a warning (controlled by the Opt_WarnTrustworthySafe flag) that occurs when a module is marked trustworthy in SafeHaskell but it has been inferred safe. Test cases: testssafeHaskellsafeInfered/TrustworthySafe02 testssafeHaskellsafeInfered/TrustworthySafe03 |
DriverInferredSafeImport :: !Module -> DriverMessage | DriverInferredSafeImport is a warning (controlled by the Opt_WarnInferredSafeImports flag) that occurs when a safe-inferred module is imported from a safe module. Test cases: None. |
DriverCannotImportUnsafeModule :: !Module -> DriverMessage | DriverCannotImportUnsafeModule is an error that occurs when an usafe module is being imported from a safe one. Test cases: None. |
DriverMissingSafeHaskellMode :: !Module -> DriverMessage | DriverMissingSafeHaskellMode is a warning (controlled by the Opt_WarnMissingSafeHaskellMode flag) that occurs when a module is using SafeHaskell features but SafeHaskell mode is not enabled. Test cases: None. |
DriverPackageNotTrusted :: !UnitState -> !UnitId -> DriverMessage | DriverPackageNotTrusted is an error that occurs when a package is required to be trusted but it isn't. Test cases: testssafeHaskellcheck/Check01 testssafeHaskellcheck/Check08 testssafeHaskellcheck/Check06 testssafeHaskellcheckpkg01ImpSafeOnly09 testssafeHaskellcheckpkg01ImpSafe03 testssafeHaskellcheckpkg01ImpSafeOnly07 testssafeHaskellcheckpkg01ImpSafeOnly08 |
DriverCannotImportFromUntrustedPackage :: !UnitState -> !Module -> DriverMessage | DriverCannotImportFromUntrustedPackage is an error that occurs in the context of Safe Haskell when trying to import a module coming from an untrusted package. Test cases: testssafeHaskellcheck/Check09 testssafeHaskellcheckpkg01ImpSafe01 testssafeHaskellcheckpkg01ImpSafe04 testssafeHaskellcheckpkg01ImpSafeOnly03 testssafeHaskellcheckpkg01ImpSafeOnly05 testssafeHaskellflags/SafeFlags17 testssafeHaskellflags/SafeFlags22 testssafeHaskellflags/SafeFlags23 testssafeHaskellghci/p11 testssafeHaskellghci/p12 testssafeHaskellghci/p17 testssafeHaskellghci/p3 testssafeHaskellsafeInfered/UnsafeInfered01 testssafeHaskellsafeInfered/UnsafeInfered02 testssafeHaskellsafeInfered/UnsafeInfered02 testssafeHaskellsafeInfered/UnsafeInfered03 testssafeHaskellsafeInfered/UnsafeInfered05 testssafeHaskellsafeInfered/UnsafeInfered06 testssafeHaskellsafeInfered/UnsafeInfered09 testssafeHaskellsafeInfered/UnsafeInfered10 testssafeHaskellsafeInfered/UnsafeInfered11 testssafeHaskellsafeInfered/UnsafeWarn01 testssafeHaskellsafeInfered/UnsafeWarn03 testssafeHaskellsafeInfered/UnsafeWarn04 testssafeHaskellsafeInfered/UnsafeWarn05 testssafeHaskellunsafeLibs/BadImport01 testssafeHaskellunsafeLibs/BadImport06 testssafeHaskellunsafeLibs/BadImport07 testssafeHaskellunsafeLibs/BadImport08 testssafeHaskellunsafeLibs/BadImport09 testssafeHaskellunsafeLibs/Dep05 testssafeHaskellunsafeLibs/Dep06 testssafeHaskellunsafeLibs/Dep07 testssafeHaskellunsafeLibs/Dep08 testssafeHaskellunsafeLibs/Dep09 testssafeHaskellunsafeLibs/Dep10 |
DriverRedirectedNoMain :: !ModuleName -> DriverMessage | |
DriverHomePackagesNotClosed :: ![UnitId] -> DriverMessage | |
DriverInterfaceError :: !IfaceMessage -> DriverMessage | |
DriverInconsistentDynFlags :: String -> DriverMessage | |
DriverSafeHaskellIgnoredExtension :: !Extension -> DriverMessage | |
DriverPackageTrustIgnored :: DriverMessage | |
DriverUnrecognisedFlag :: String -> DriverMessage | |
DriverDeprecatedFlag :: String -> String -> DriverMessage |
Instances
Generic DriverMessage | |||||
Defined in GHC.Driver.Errors.Types Associated Types
| |||||
type Rep DriverMessage | |||||
Defined in GHC.Driver.Errors.Types type Rep DriverMessage = D1 ('MetaData "DriverMessage" "GHC.Driver.Errors.Types" "ghc-9.8.4-inplace" 'False) (((((C1 ('MetaCons "DriverUnknownMessage" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (UnknownDiagnostic (DiagnosticOpts DriverMessage)))) :+: C1 ('MetaCons "DriverPsHeaderMessage" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 PsMessage))) :+: (C1 ('MetaCons "DriverMissingHomeModules" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 UnitId) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [ModuleName]) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 BuildingCabalPackage))) :+: C1 ('MetaCons "DriverUnknownReexportedModules" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 UnitId) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [ModuleName])))) :+: ((C1 ('MetaCons "DriverUnknownHiddenModules" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 UnitId) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [ModuleName])) :+: C1 ('MetaCons "DriverUnusedPackages" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [(UnitId, PackageName, Version, PackageArg)]))) :+: (C1 ('MetaCons "DriverUnnecessarySourceImports" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ModuleName)) :+: C1 ('MetaCons "DriverDuplicatedModuleDeclaration" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Module) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [FilePath]))))) :+: (((C1 ('MetaCons "DriverModuleNotFound" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ModuleName)) :+: C1 ('MetaCons "DriverFileModuleNameMismatch" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ModuleName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ModuleName))) :+: (C1 ('MetaCons "DriverUnexpectedSignature" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ModuleName) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 BuildingCabalPackage) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (GenInstantiations UnitId)))) :+: C1 ('MetaCons "DriverFileNotFound" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 FilePath)))) :+: ((C1 ('MetaCons "DriverStaticPointersNotSupported" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "DriverBackpackModuleNotFound" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ModuleName))) :+: (C1 ('MetaCons "DriverUserDefinedRuleIgnored" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (RuleDecl GhcTc))) :+: C1 ('MetaCons "DriverMixedSafetyImport" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ModuleName)))))) :+: ((((C1 ('MetaCons "DriverCannotLoadInterfaceFile" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Module)) :+: C1 ('MetaCons "DriverInferredSafeModule" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Module))) :+: (C1 ('MetaCons "DriverMarkedTrustworthyButInferredSafe" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Module)) :+: C1 ('MetaCons "DriverInferredSafeImport" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Module)))) :+: ((C1 ('MetaCons "DriverCannotImportUnsafeModule" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Module)) :+: C1 ('MetaCons "DriverMissingSafeHaskellMode" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Module))) :+: (C1 ('MetaCons "DriverPackageNotTrusted" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 UnitState) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 UnitId)) :+: C1 ('MetaCons "DriverCannotImportFromUntrustedPackage" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 UnitState) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Module))))) :+: (((C1 ('MetaCons "DriverRedirectedNoMain" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 ModuleName)) :+: C1 ('MetaCons "DriverHomePackagesNotClosed" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 [UnitId]))) :+: (C1 ('MetaCons "DriverInterfaceError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 IfaceMessage)) :+: C1 ('MetaCons "DriverInconsistentDynFlags" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 String)))) :+: ((C1 ('MetaCons "DriverSafeHaskellIgnoredExtension" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Extension)) :+: C1 ('MetaCons "DriverPackageTrustIgnored" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "DriverUnrecognisedFlag" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 String)) :+: C1 ('MetaCons "DriverDeprecatedFlag" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 String) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 String))))))) | |||||
type DiagnosticOpts DriverMessage | |||||
Defined in GHC.Driver.Errors.Ppr |
General Diagnostics
class HasDefaultDiagnosticOpts (DiagnosticOpts a) => Diagnostic a where #
A class identifying a diagnostic. Dictionary.com defines a diagnostic as:
"a message output by a computer diagnosing an error in a computer program, computer system, or component device".
A Diagnostic
carries the actual description of the message (which, in
GHC's case, it can be an error or a warning) and the reason why such
message was generated in the first place.
Methods
diagnosticMessage :: DiagnosticOpts a -> a -> DecoratedSDoc #
Extract the error message text from a Diagnostic
.
diagnosticReason :: a -> DiagnosticReason #
Extract the reason for this diagnostic. For warnings,
a DiagnosticReason
includes the warning flag.
diagnosticHints :: a -> [GhcHint] #
Extract any hints a user might use to repair their code to avoid this diagnostic.
diagnosticCode :: a -> Maybe DiagnosticCode #
Get the DiagnosticCode
associated with this Diagnostic
.
This can return Nothing
for at least two reasons:
- The message might be from a plugin that does not supply codes.
- The message might not yet have been assigned a code. See the
Diagnostic
instance forDiagnosticMessage
.
Ideally, case (2) would not happen, but because some errors in GHC still use the old system of just writing the error message in-place (instead of using a dedicated error type and constructor), we do not have error codes for all errors. #18516 tracks our progress toward this goal.
Instances
Diagnostic DiagnosticMessage | |||||
Defined in GHC.Types.Error Associated Types
| |||||
HasDefaultDiagnosticOpts opts => Diagnostic (UnknownDiagnostic opts) | |||||
Defined in GHC.Types.Error Associated Types
Methods diagnosticMessage :: DiagnosticOpts (UnknownDiagnostic opts) -> UnknownDiagnostic opts -> DecoratedSDoc # diagnosticReason :: UnknownDiagnostic opts -> DiagnosticReason # diagnosticHints :: UnknownDiagnostic opts -> [GhcHint] # diagnosticCode :: UnknownDiagnostic opts -> Maybe DiagnosticCode # |