{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
module GHC.Types.Error.Codes
( GhcDiagnosticCode, constructorCode, constructorCodes )
where
import GHC.Prelude
import GHC.Types.Error ( DiagnosticCode(..), UnknownDiagnostic (..), diagnosticCode, NoDiagnosticOpts )
import GHC.Hs.Extension ( GhcRn )
import GHC.Core.InstEnv (LookupInstanceErrReason)
import GHC.Iface.Errors.Types
import GHC.Driver.Errors.Types ( DriverMessage, GhcMessageOpts, DriverMessageOpts )
import GHC.Parser.Errors.Types ( PsMessage, PsHeaderMessage )
import GHC.HsToCore.Errors.Types ( DsMessage )
import GHC.Tc.Errors.Types
import GHC.Unit.Module.Warnings ( WarningTxt )
import GHC.Utils.Panic.Plain
import Data.Kind ( Type, Constraint )
import GHC.Exts ( proxy# )
import GHC.Generics
import GHC.TypeLits ( Symbol, KnownSymbol, symbolVal'
, TypeError, ErrorMessage(..) )
import GHC.TypeNats ( Nat, KnownNat, natVal' )
import Data.Map.Strict ( Map )
import qualified Data.Map.Strict as Map
constructorCode :: (Generic diag, GDiagnosticCode (Rep diag))
=> diag -> Maybe DiagnosticCode
constructorCode :: forall diag.
(Generic diag, GDiagnosticCode (Rep diag)) =>
diag -> Maybe DiagnosticCode
constructorCode diag
diag = Rep diag (ZonkAny 0) -> Maybe DiagnosticCode
forall a. Rep diag a -> Maybe DiagnosticCode
forall (f :: * -> *) a.
GDiagnosticCode f =>
f a -> Maybe DiagnosticCode
gdiagnosticCode (diag -> Rep diag (ZonkAny 0)
forall x. diag -> Rep diag x
forall a x. Generic a => a -> Rep a x
from diag
diag)
constructorCodes :: forall diag. (Generic diag, GDiagnosticCodes '[diag] (Rep diag))
=> Map DiagnosticCode String
constructorCodes :: forall diag.
(Generic diag, GDiagnosticCodes '[diag] (Rep diag)) =>
Map DiagnosticCode String
constructorCodes = forall (seen :: [*]) (f :: * -> *).
GDiagnosticCodes seen f =>
Map DiagnosticCode String
gdiagnosticCodes @'[diag] @(Rep diag)
type GhcDiagnosticCode :: Symbol -> Nat
type family GhcDiagnosticCode c = n | n -> c where
GhcDiagnosticCode "DsEmptyEnumeration" = 10190
GhcDiagnosticCode "DsIdentitiesFound" = 04214
GhcDiagnosticCode "DsOverflowedLiterals" = 97441
GhcDiagnosticCode "DsRedundantBangPatterns" = 38520
GhcDiagnosticCode "DsOverlappingPatterns" = 53633
GhcDiagnosticCode "DsInaccessibleRhs" = 94210
GhcDiagnosticCode "DsMaxPmCheckModelsReached" = 61505
GhcDiagnosticCode "DsNonExhaustivePatterns" = 62161
GhcDiagnosticCode "DsTopLevelBindsNotAllowed" = 48099
GhcDiagnosticCode "DsUselessSpecialiseForClassMethodSelector" = 93315
GhcDiagnosticCode "DsUselessSpecialiseForNoInlineFunction" = 38524
GhcDiagnosticCode "DsOrphanRule" = 58181
GhcDiagnosticCode "DsRuleLhsTooComplicated" = 69441
GhcDiagnosticCode "DsRuleIgnoredDueToConstructor" = 00828
GhcDiagnosticCode "DsRuleBindersNotBound" = 40548
GhcDiagnosticCode "DsLazyPatCantBindVarsOfUnliftedType" = 17879
GhcDiagnosticCode "DsNotYetHandledByTH" = 65904
GhcDiagnosticCode "DsAggregatedViewExpressions" = 19551
GhcDiagnosticCode "DsUnbangedStrictPatterns" = 21030
GhcDiagnosticCode "DsCannotMixPolyAndUnliftedBindings" = 20036
GhcDiagnosticCode "DsWrongDoBind" = 08838
GhcDiagnosticCode "DsUnusedDoBind" = 81995
GhcDiagnosticCode "DsRecBindsNotAllowedForUnliftedTys" = 20185
GhcDiagnosticCode "DsRuleMightInlineFirst" = 95396
GhcDiagnosticCode "DsAnotherRuleMightFireFirst" = 87502
GhcDiagnosticCode "DsIncompleteRecordSelector" = 17335
GhcDiagnosticCode "PsErrParseLanguagePragma" = 68686
GhcDiagnosticCode "PsErrUnsupportedExt" = 46537
GhcDiagnosticCode "PsErrParseOptionsPragma" = 24342
GhcDiagnosticCode "PsErrUnknownOptionsPragma" = 04924
GhcDiagnosticCode "PsWarnBidirectionalFormatChars" = 03272
GhcDiagnosticCode "PsWarnTab" = 94817
GhcDiagnosticCode "PsWarnTransitionalLayout" = 93617
GhcDiagnosticCode "PsWarnOperatorWhitespaceExtConflict" = 47082
GhcDiagnosticCode "PsWarnOperatorWhitespace" = 40798
GhcDiagnosticCode "PsWarnHaddockInvalidPos" = 94458
GhcDiagnosticCode "PsWarnHaddockIgnoreMulti" = 05641
GhcDiagnosticCode "PsWarnStarBinder" = 21887
GhcDiagnosticCode "PsWarnStarIsType" = 39567
GhcDiagnosticCode "PsWarnUnrecognisedPragma" = 42044
GhcDiagnosticCode "PsWarnMisplacedPragma" = 28007
GhcDiagnosticCode "PsWarnImportPreQualified" = 07924
GhcDiagnosticCode "PsWarnViewPatternSignatures" = 00834
GhcDiagnosticCode "PsErrLexer" = 21231
GhcDiagnosticCode "PsErrCmmLexer" = 75725
GhcDiagnosticCode "PsErrCmmParser" = 09848
GhcDiagnosticCode "PsErrParse" = 58481
GhcDiagnosticCode "PsErrTypeAppWithoutSpace" = 84077
GhcDiagnosticCode "PsErrLazyPatWithoutSpace" = 27207
GhcDiagnosticCode "PsErrBangPatWithoutSpace" = 95644
GhcDiagnosticCode "PsErrInvalidInfixHole" = 45106
GhcDiagnosticCode "PsErrExpectedHyphen" = 44524
GhcDiagnosticCode "PsErrSpaceInSCC" = 76176
GhcDiagnosticCode "PsErrEmptyDoubleQuotes" = 11861
GhcDiagnosticCode "PsErrLambdaCase" = 51179
GhcDiagnosticCode "PsErrEmptyLambda" = 71614
GhcDiagnosticCode "PsErrLinearFunction" = 31574
GhcDiagnosticCode "PsErrMultiWayIf" = 28985
GhcDiagnosticCode "PsErrOverloadedRecordUpdateNotEnabled" = 82135
GhcDiagnosticCode "PsErrNumUnderscores" = 62330
GhcDiagnosticCode "PsErrIllegalBangPattern" = 79767
GhcDiagnosticCode "PsErrOverloadedRecordDotInvalid" = 26832
GhcDiagnosticCode "PsErrIllegalPatSynExport" = 89515
GhcDiagnosticCode "PsErrOverloadedRecordUpdateNoQualifiedFields" = 94863
GhcDiagnosticCode "PsErrExplicitForall" = 25955
GhcDiagnosticCode "PsErrIllegalQualifiedDo" = 40280
GhcDiagnosticCode "PsErrQualifiedDoInCmd" = 54089
GhcDiagnosticCode "PsErrRecordSyntaxInPatSynDecl" = 28021
GhcDiagnosticCode "PsErrEmptyWhereInPatSynDecl" = 13248
GhcDiagnosticCode "PsErrInvalidWhereBindInPatSynDecl" = 24737
GhcDiagnosticCode "PsErrNoSingleWhereBindInPatSynDecl" = 65536
GhcDiagnosticCode "PsErrDeclSpliceNotAtTopLevel" = 08451
GhcDiagnosticCode "PsErrMultipleNamesInStandaloneKindSignature" = 42569
GhcDiagnosticCode "PsErrIllegalExplicitNamespace" = 47007
GhcDiagnosticCode "PsErrUnallowedPragma" = 85314
GhcDiagnosticCode "PsErrImportPostQualified" = 87491
GhcDiagnosticCode "PsErrImportQualifiedTwice" = 05661
GhcDiagnosticCode "PsErrIllegalImportBundleForm" = 81284
GhcDiagnosticCode "PsErrInvalidRuleActivationMarker" = 50396
GhcDiagnosticCode "PsErrMissingBlock" = 16849
GhcDiagnosticCode "PsErrUnsupportedBoxedSumExpr" = 09550
GhcDiagnosticCode "PsErrUnsupportedBoxedSumPat" = 16863
GhcDiagnosticCode "PsErrUnexpectedQualifiedConstructor" = 73413
GhcDiagnosticCode "PsErrTupleSectionInPat" = 09646
GhcDiagnosticCode "PsErrOpFewArgs" = 24180
GhcDiagnosticCode "PsErrVarForTyCon" = 18208
GhcDiagnosticCode "PsErrMalformedEntityString" = 26204
GhcDiagnosticCode "PsErrDotsInRecordUpdate" = 70712
GhcDiagnosticCode "PsErrInvalidDataCon" = 46574
GhcDiagnosticCode "PsErrInvalidInfixDataCon" = 30670
GhcDiagnosticCode "PsErrIllegalPromotionQuoteDataCon" = 80236
GhcDiagnosticCode "PsErrUnpackDataCon" = 40845
GhcDiagnosticCode "PsErrUnexpectedKindAppInDataCon" = 83653
GhcDiagnosticCode "PsErrInvalidRecordCon" = 08195
GhcDiagnosticCode "PsErrIllegalUnboxedStringInPat" = 69925
GhcDiagnosticCode "PsErrIllegalUnboxedFloatingLitInPat" = 76595
GhcDiagnosticCode "PsErrDoNotationInPat" = 06446
GhcDiagnosticCode "PsErrIfThenElseInPat" = 45696
GhcDiagnosticCode "PsErrLambdaCaseInPat" = Outdated 07636
GhcDiagnosticCode "PsErrCaseInPat" = 53786
GhcDiagnosticCode "PsErrLetInPat" = 78892
GhcDiagnosticCode "PsErrLambdaInPat" = 00482
GhcDiagnosticCode "PsErrArrowExprInPat" = 04584
GhcDiagnosticCode "PsErrArrowCmdInPat" = 98980
GhcDiagnosticCode "PsErrArrowCmdInExpr" = 66043
GhcDiagnosticCode "PsErrViewPatInExpr" = Outdated 66228
GhcDiagnosticCode "PsErrOrPatInExpr" = 66718
GhcDiagnosticCode "PsErrLambdaCmdInFunAppCmd" = 12178
GhcDiagnosticCode "PsErrCaseCmdInFunAppCmd" = 92971
GhcDiagnosticCode "PsErrLambdaCaseCmdInFunAppCmd" = Outdated 47171
GhcDiagnosticCode "PsErrIfCmdInFunAppCmd" = 97005
GhcDiagnosticCode "PsErrLetCmdInFunAppCmd" = 70526
GhcDiagnosticCode "PsErrDoCmdInFunAppCmd" = 77808
GhcDiagnosticCode "PsErrDoInFunAppExpr" = 52095
GhcDiagnosticCode "PsErrMDoInFunAppExpr" = 67630
GhcDiagnosticCode "PsErrLambdaInFunAppExpr" = 06074
GhcDiagnosticCode "PsErrCaseInFunAppExpr" = 25037
GhcDiagnosticCode "PsErrLambdaCaseInFunAppExpr" = Outdated 77182
GhcDiagnosticCode "PsErrLetInFunAppExpr" = 90355
GhcDiagnosticCode "PsErrIfInFunAppExpr" = 01239
GhcDiagnosticCode "PsErrProcInFunAppExpr" = 04807
GhcDiagnosticCode "PsErrMalformedTyOrClDecl" = 47568
GhcDiagnosticCode "PsErrIllegalWhereInDataDecl" = 36952
GhcDiagnosticCode "PsErrIllegalDataTypeContext" = 87429
GhcDiagnosticCode "PsErrPrimStringInvalidChar" = 43080
GhcDiagnosticCode "PsErrSuffixAT" = 33856
GhcDiagnosticCode "PsErrPrecedenceOutOfRange" = 25078
GhcDiagnosticCode "PsErrSemiColonsInCondExpr" = 75254
GhcDiagnosticCode "PsErrSemiColonsInCondCmd" = 18910
GhcDiagnosticCode "PsErrAtInPatPos" = 08382
GhcDiagnosticCode "PsErrParseErrorOnInput" = 66418
GhcDiagnosticCode "PsErrMalformedDecl" = 85316
GhcDiagnosticCode "PsErrNotADataCon" = 25742
GhcDiagnosticCode "PsErrInferredTypeVarNotAllowed" = 57342
GhcDiagnosticCode "PsErrIllegalTraditionalRecordSyntax" = 65719
GhcDiagnosticCode "PsErrParseErrorInCmd" = 03790
GhcDiagnosticCode "PsErrInPat" = 07626
GhcDiagnosticCode "PsErrIllegalRoleName" = 09009
GhcDiagnosticCode "PsErrInvalidTypeSignature" = 94426
GhcDiagnosticCode "PsErrUnexpectedTypeInDecl" = 77878
GhcDiagnosticCode "PsErrInvalidPackageName" = 21926
GhcDiagnosticCode "PsErrParseRightOpSectionInPat" = 72516
GhcDiagnosticCode "PsErrIllegalGadtRecordMultiplicity" = 37475
GhcDiagnosticCode "PsErrInvalidCApiImport" = 72744
GhcDiagnosticCode "PsErrMultipleConForNewtype" = 05380
GhcDiagnosticCode "PsErrUnicodeCharLooksLike" = 31623
GhcDiagnosticCode "PsErrInvalidPun" = 52943
GhcDiagnosticCode "PsErrIllegalOrPat" = 29847
GhcDiagnosticCode "PsErrTypeSyntaxInPat" = 32181
GhcDiagnosticCode "DriverMissingHomeModules" = 32850
GhcDiagnosticCode "DriverUnknownHiddenModules" = 38189
GhcDiagnosticCode "DriverUnknownReexportedModules" = 68286
GhcDiagnosticCode "DriverUnusedPackages" = 42258
GhcDiagnosticCode "DriverUnnecessarySourceImports" = 88907
GhcDiagnosticCode "DriverDuplicatedModuleDeclaration" = 29235
GhcDiagnosticCode "DriverModuleNotFound" = 82272
GhcDiagnosticCode "DriverFileModuleNameMismatch" = 28623
GhcDiagnosticCode "DriverUnexpectedSignature" = 66004
GhcDiagnosticCode "DriverFileNotFound" = 49196
GhcDiagnosticCode "DriverStaticPointersNotSupported" = 77799
GhcDiagnosticCode "DriverBackpackModuleNotFound" = 19971
GhcDiagnosticCode "DriverUserDefinedRuleIgnored" = 56147
GhcDiagnosticCode "DriverMixedSafetyImport" = 70172
GhcDiagnosticCode "DriverCannotLoadInterfaceFile" = 37141
GhcDiagnosticCode "DriverInferredSafeModule" = 58656
GhcDiagnosticCode "DriverMarkedTrustworthyButInferredSafe" = 19244
GhcDiagnosticCode "DriverInferredSafeImport" = 82658
GhcDiagnosticCode "DriverCannotImportUnsafeModule" = 44360
GhcDiagnosticCode "DriverMissingSafeHaskellMode" = 29747
GhcDiagnosticCode "DriverPackageNotTrusted" = 08674
GhcDiagnosticCode "DriverCannotImportFromUntrustedPackage" = 75165
GhcDiagnosticCode "DriverRedirectedNoMain" = 95379
GhcDiagnosticCode "DriverHomePackagesNotClosed" = 03271
GhcDiagnosticCode "DriverInconsistentDynFlags" = 74335
GhcDiagnosticCode "DriverSafeHaskellIgnoredExtension" = 98887
GhcDiagnosticCode "DriverPackageTrustIgnored" = 83552
GhcDiagnosticCode "DriverUnrecognisedFlag" = 93741
GhcDiagnosticCode "DriverDeprecatedFlag" = 53692
GhcDiagnosticCode "DriverModuleGraphCycle" = 92213
GhcDiagnosticCode "DriverInstantiationNodeInDependencyGeneration" = 74284
GhcDiagnosticCode "DriverNoConfiguredLLVMToolchain" = 66599
GhcDiagnosticCode "BadTelescope" = 97739
GhcDiagnosticCode "UserTypeError" = 64725
GhcDiagnosticCode "UnsatisfiableError" = 22250
GhcDiagnosticCode "ReportHoleError" = 88464
GhcDiagnosticCode "FixedRuntimeRepError" = 55287
GhcDiagnosticCode "BlockedEquality" = 06200
GhcDiagnosticCode "ExpectingMoreArguments" = 81325
GhcDiagnosticCode "UnboundImplicitParams" = 91416
GhcDiagnosticCode "AmbiguityPreventsSolvingCt" = 78125
GhcDiagnosticCode "CannotResolveInstance" = 39999
GhcDiagnosticCode "OverlappingInstances" = 43085
GhcDiagnosticCode "UnsafeOverlap" = 36705
GhcDiagnosticCode "MultiplicityCoercionsNotSupported" = 59840
GhcDiagnosticCode "BasicMismatch" = 18872
GhcDiagnosticCode "KindMismatch" = 89223
GhcDiagnosticCode "TypeEqMismatch" = 83865
GhcDiagnosticCode "CouldNotDeduce" = 05617
GhcDiagnosticCode "CannotUnifyWithPolytype" = 91028
GhcDiagnosticCode "OccursCheck" = 27958
GhcDiagnosticCode "SkolemEscape" = 46956
GhcDiagnosticCode "DifferentTyVars" = 25897
GhcDiagnosticCode "RepresentationalEq" = 10283
GhcDiagnosticCode "TcRnSolverDepthError" = 40404
GhcDiagnosticCode "TcRnRedundantConstraints" = 30606
GhcDiagnosticCode "TcRnInaccessibleCode" = 40564
GhcDiagnosticCode "TcRnInaccessibleCoAxBranch" = 28129
GhcDiagnosticCode "TcRnTypeDoesNotHaveFixedRuntimeRep" = 18478
GhcDiagnosticCode "TcRnImplicitLift" = 00846
GhcDiagnosticCode "TcRnUnusedPatternBinds" = 61367
GhcDiagnosticCode "TcRnDodgyExports" = 75356
GhcDiagnosticCode "TcRnMissingImportList" = 77037
GhcDiagnosticCode "TcRnUnsafeDueToPlugin" = 01687
GhcDiagnosticCode "TcRnModMissingRealSrcSpan" = 84170
GhcDiagnosticCode "TcRnIdNotExportedFromModuleSig" = 44188
GhcDiagnosticCode "TcRnIdNotExportedFromLocalSig" = 50058
GhcDiagnosticCode "TcRnShadowedName" = 63397
GhcDiagnosticCode "TcRnInvalidWarningCategory" = 53573
GhcDiagnosticCode "TcRnDuplicateWarningDecls" = 00711
GhcDiagnosticCode "TcRnSimplifierTooManyIterations" = 95822
GhcDiagnosticCode "TcRnIllegalPatSynDecl" = 82077
GhcDiagnosticCode "TcRnLinearPatSyn" = 15172
GhcDiagnosticCode "TcRnEmptyRecordUpdate" = 20825
GhcDiagnosticCode "TcRnIllegalFieldPunning" = 44287
GhcDiagnosticCode "TcRnIllegalWildcardsInRecord" = 37132
GhcDiagnosticCode "TcRnIllegalWildcardInType" = 65507
GhcDiagnosticCode "TcRnIllegalNamedWildcardInTypeArgument" = 93411
GhcDiagnosticCode "TcRnIllegalImplicitTyVarInTypeArgument" = 80557
GhcDiagnosticCode "TcRnDuplicateFieldName" = 85524
GhcDiagnosticCode "TcRnIllegalViewPattern" = 22406
GhcDiagnosticCode "TcRnCharLiteralOutOfRange" = 17268
GhcDiagnosticCode "TcRnIllegalWildcardsInConstructor" = 47217
GhcDiagnosticCode "TcRnIgnoringAnnotations" = 66649
GhcDiagnosticCode "TcRnAnnotationInSafeHaskell" = 68934
GhcDiagnosticCode "TcRnInvalidTypeApplication" = 95781
GhcDiagnosticCode "TcRnTagToEnumMissingValArg" = 36495
GhcDiagnosticCode "TcRnTagToEnumUnspecifiedResTy" = 08522
GhcDiagnosticCode "TcRnTagToEnumResTyNotAnEnum" = 49356
GhcDiagnosticCode "TcRnTagToEnumResTyTypeData" = 96189
GhcDiagnosticCode "TcRnArrowIfThenElsePredDependsOnResultTy" = 55868
GhcDiagnosticCode "TcRnIllegalHsBootOrSigDecl" = 58195
GhcDiagnosticCode "TcRnRecursivePatternSynonym" = 72489
GhcDiagnosticCode "TcRnPartialTypeSigTyVarMismatch" = 88793
GhcDiagnosticCode "TcRnPartialTypeSigBadQuantifier" = 94185
GhcDiagnosticCode "TcRnMissingSignature" = 38417
GhcDiagnosticCode "TcRnPolymorphicBinderMissingSig" = 64414
GhcDiagnosticCode "TcRnOverloadedSig" = 16675
GhcDiagnosticCode "TcRnTupleConstraintInst" = 69012
GhcDiagnosticCode "TcRnUserTypeError" = 47403
GhcDiagnosticCode "TcRnConstraintInKind" = 01259
GhcDiagnosticCode "TcRnUnboxedTupleOrSumTypeFuncArg" = 19590
GhcDiagnosticCode "TcRnLinearFuncInKind" = 13218
GhcDiagnosticCode "TcRnForAllEscapeError" = 31147
GhcDiagnosticCode "TcRnVDQInTermType" = 51580
GhcDiagnosticCode "TcRnBadQuantPredHead" = 02550
GhcDiagnosticCode "TcRnIllegalTupleConstraint" = 77539
GhcDiagnosticCode "TcRnNonTypeVarArgInConstraint" = 80003
GhcDiagnosticCode "TcRnIllegalImplicitParam" = 75863
GhcDiagnosticCode "TcRnIllegalConstraintSynonymOfKind" = 75844
GhcDiagnosticCode "TcRnOversaturatedVisibleKindArg" = 45474
GhcDiagnosticCode "TcRnForAllRankErr" = 91510
GhcDiagnosticCode "TcRnMonomorphicBindings" = 55524
GhcDiagnosticCode "TcRnOrphanInstance" = 90177
GhcDiagnosticCode "TcRnFunDepConflict" = 46208
GhcDiagnosticCode "TcRnDupInstanceDecls" = 59692
GhcDiagnosticCode "TcRnConflictingFamInstDecls" = 34447
GhcDiagnosticCode "TcRnFamInstNotInjective" = 05175
GhcDiagnosticCode "TcRnBangOnUnliftedType" = 55666
GhcDiagnosticCode "TcRnLazyBangOnUnliftedType" = 71444
GhcDiagnosticCode "TcRnPatSynBundledWithNonDataCon" = 66775
GhcDiagnosticCode "TcRnPatSynBundledWithWrongType" = 66025
GhcDiagnosticCode "TcRnDupeModuleExport" = 51876
GhcDiagnosticCode "TcRnExportedModNotImported" = 90973
GhcDiagnosticCode "TcRnNullExportedModule" = 64649
GhcDiagnosticCode "TcRnMissingExportList" = 85401
GhcDiagnosticCode "TcRnExportHiddenComponents" = 94558
GhcDiagnosticCode "TcRnExportHiddenDefault" = 74775
GhcDiagnosticCode "TcRnDuplicateExport" = 47854
GhcDiagnosticCode "TcRnExportedParentChildMismatch" = 88993
GhcDiagnosticCode "TcRnConflictingExports" = 69158
GhcDiagnosticCode "TcRnDuplicateFieldExport" = 97219
GhcDiagnosticCode "TcRnAmbiguousFieldInUpdate" = 56428
GhcDiagnosticCode "TcRnAmbiguousRecordUpdate" = 02256
GhcDiagnosticCode "TcRnMissingFields" = 20125
GhcDiagnosticCode "TcRnFieldUpdateInvalidType" = 63055
GhcDiagnosticCode "TcRnMissingStrictFields" = 95909
GhcDiagnosticCode "TcRnStaticFormNotClosed" = 88431
GhcDiagnosticCode "TcRnIllegalStaticExpression" = 23800
GhcDiagnosticCode "TcRnUselessTypeable" = 90584
GhcDiagnosticCode "TcRnDerivingDefaults" = 20042
GhcDiagnosticCode "TcRnNonUnaryTypeclassConstraint" = 73993
GhcDiagnosticCode "TcRnPartialTypeSignatures" = 60661
GhcDiagnosticCode "TcRnLazyGADTPattern" = 87005
GhcDiagnosticCode "TcRnArrowProcGADTPattern" = 64525
GhcDiagnosticCode "TcRnTypeEqualityOutOfScope" = 12003
GhcDiagnosticCode "TcRnTypeEqualityRequiresOperators" = 58520
GhcDiagnosticCode "TcRnIllegalTypeOperator" = 62547
GhcDiagnosticCode "TcRnGADTMonoLocalBinds" = 58008
GhcDiagnosticCode "TcRnIncorrectNameSpace" = 31891
GhcDiagnosticCode "TcRnNoRebindableSyntaxRecordDot" = 65945
GhcDiagnosticCode "TcRnNoFieldPunsRecordDot" = 57365
GhcDiagnosticCode "TcRnListComprehensionDuplicateBinding" = 81232
GhcDiagnosticCode "TcRnLastStmtNotExpr" = 55814
GhcDiagnosticCode "TcRnUnexpectedStatementInContext" = 42026
GhcDiagnosticCode "TcRnSectionWithoutParentheses" = 95880
GhcDiagnosticCode "TcRnIllegalImplicitParameterBindings" = 50730
GhcDiagnosticCode "TcRnIllegalTupleSection" = 59155
GhcDiagnosticCode "TcRnTermNameInType" = 37479
GhcDiagnosticCode "TcRnUnexpectedKindVar" = 12875
GhcDiagnosticCode "TcRnNegativeNumTypeLiteral" = 93632
GhcDiagnosticCode "TcRnUnusedQuantifiedTypeVar" = 54180
GhcDiagnosticCode "TcRnMissingRoleAnnotation" = 65490
GhcDiagnosticCode "TcRnUntickedPromotedThing" = 49957
GhcDiagnosticCode "TcRnIllegalBuiltinSyntax" = 39716
GhcDiagnosticCode "TcRnForeignImportPrimExtNotSet" = 49692
GhcDiagnosticCode "TcRnForeignImportPrimSafeAnn" = 26133
GhcDiagnosticCode "TcRnForeignFunctionImportAsValue" = 76251
GhcDiagnosticCode "TcRnFunPtrImportWithoutAmpersand" = 57989
GhcDiagnosticCode "TcRnIllegalForeignDeclBackend" = 03355
GhcDiagnosticCode "TcRnUnsupportedCallConv" = 01245
GhcDiagnosticCode "TcRnInvalidCIdentifier" = 95774
GhcDiagnosticCode "TcRnExpectedValueId" = 01570
GhcDiagnosticCode "TcRnRecSelectorEscapedTyVar" = 55876
GhcDiagnosticCode "TcRnPatSynNotBidirectional" = 16444
GhcDiagnosticCode "TcRnIllegalDerivingItem" = 11913
GhcDiagnosticCode "TcRnUnexpectedAnnotation" = 18932
GhcDiagnosticCode "TcRnIllegalRecordSyntax" = 89246
GhcDiagnosticCode "TcRnInvalidVisibleKindArgument" = 20967
GhcDiagnosticCode "TcRnTooManyBinders" = 05989
GhcDiagnosticCode "TcRnDifferentNamesForTyVar" = 17370
GhcDiagnosticCode "TcRnDisconnectedTyVar" = 59738
GhcDiagnosticCode "TcRnInvalidReturnKind" = 55233
GhcDiagnosticCode "TcRnClassKindNotConstraint" = 80768
GhcDiagnosticCode "TcRnMatchesHaveDiffNumArgs" = 91938
GhcDiagnosticCode "TcRnCannotBindScopedTyVarInPatSig" = 46131
GhcDiagnosticCode "TcRnCannotBindTyVarsInPatBind" = 48361
GhcDiagnosticCode "TcRnTooManyTyArgsInConPattern" = 01629
GhcDiagnosticCode "TcRnMultipleInlinePragmas" = 96665
GhcDiagnosticCode "TcRnUnexpectedPragmas" = 88293
GhcDiagnosticCode "TcRnNonOverloadedSpecialisePragma" = 35827
GhcDiagnosticCode "TcRnSpecialiseNotVisible" = 85337
GhcDiagnosticCode "TcRnDifferentExportWarnings" = 92878
GhcDiagnosticCode "TcRnIncompleteExportWarnings" = 94721
GhcDiagnosticCode "TcRnIllegalTypeOperatorDecl" = 50649
GhcDiagnosticCode "TcRnOrPatBindsVariables" = 81303
GhcDiagnosticCode "TcRnIllegalKind" = 64861
GhcDiagnosticCode "TcRnUnexpectedPatSigType" = 74097
GhcDiagnosticCode "TcRnIllegalKindSignature" = 91382
GhcDiagnosticCode "TcRnDataKindsError" = 68567
GhcDiagnosticCode "TcRnIllegalHsigDefaultMethods" = 93006
GhcDiagnosticCode "TcRnHsigFixityMismatch" = 93007
GhcDiagnosticCode "TcRnHsigMissingModuleExport" = 93011
GhcDiagnosticCode "TcRnBadGenericMethod" = 59794
GhcDiagnosticCode "TcRnWarningMinimalDefIncomplete" = 13511
GhcDiagnosticCode "TcRnDefaultMethodForPragmaLacksBinding" = 28587
GhcDiagnosticCode "TcRnIgnoreSpecialisePragmaOnDefMethod" = 72520
GhcDiagnosticCode "TcRnBadMethodErr" = 46284
GhcDiagnosticCode "TcRnIllegalTypeData" = 15013
GhcDiagnosticCode "TcRnTypeDataForbids" = 67297
GhcDiagnosticCode "TcRnUnsatisfiedMinimalDef" = 06201
GhcDiagnosticCode "TcRnMisplacedInstSig" = 06202
GhcDiagnosticCode "TcRnCapturedTermName" = 54201
GhcDiagnosticCode "TcRnBindingOfExistingName" = 58805
GhcDiagnosticCode "TcRnMultipleFixityDecls" = 50419
GhcDiagnosticCode "TcRnIllegalPatternSynonymDecl" = 41507
GhcDiagnosticCode "TcRnIllegalClassBinding" = 69248
GhcDiagnosticCode "TcRnOrphanCompletePragma" = 93961
GhcDiagnosticCode "TcRnEmptyCase" = 48010
GhcDiagnosticCode "TcRnNonStdGuards" = 59119
GhcDiagnosticCode "TcRnDuplicateSigDecl" = 31744
GhcDiagnosticCode "TcRnMisplacedSigDecl" = 87866
GhcDiagnosticCode "TcRnUnexpectedDefaultSig" = 40700
GhcDiagnosticCode "TcRnDuplicateMinimalSig" = 85346
GhcDiagnosticCode "TcRnLoopySuperclassSolve" = Outdated 36038
GhcDiagnosticCode "TcRnUnexpectedStandaloneDerivingDecl" = 95159
GhcDiagnosticCode "TcRnUnusedVariableInRuleDecl" = 65669
GhcDiagnosticCode "TcRnUnexpectedStandaloneKindSig" = 45906
GhcDiagnosticCode "TcRnIllegalRuleLhs" = 63294
GhcDiagnosticCode "TcRnDuplicateRoleAnnot" = 97170
GhcDiagnosticCode "TcRnDuplicateKindSig" = 43371
GhcDiagnosticCode "TcRnIllegalDerivStrategy" = 87139
GhcDiagnosticCode "TcRnIllegalMultipleDerivClauses" = 30281
GhcDiagnosticCode "TcRnNoDerivStratSpecified" = 55631
GhcDiagnosticCode "TcRnStupidThetaInGadt" = 18403
GhcDiagnosticCode "TcRnShadowedTyVarNameInFamResult" = 99412
GhcDiagnosticCode "TcRnIncorrectTyVarOnLhsOfInjCond" = 88333
GhcDiagnosticCode "TcRnUnknownTyVarsOnRhsOfInjCond" = 48254
GhcDiagnosticCode "TcRnBadlyStaged" = 28914
GhcDiagnosticCode "TcRnBadlyStagedType" = 86357
GhcDiagnosticCode "TcRnStageRestriction" = 18157
GhcDiagnosticCode "TcRnTyThingUsedWrong" = 10969
GhcDiagnosticCode "TcRnCannotDefaultKindVar" = 79924
GhcDiagnosticCode "TcRnUninferrableTyVar" = 16220
GhcDiagnosticCode "TcRnSkolemEscape" = 71451
GhcDiagnosticCode "TcRnPatSynEscapedCoercion" = 88986
GhcDiagnosticCode "TcRnPatSynExistentialInResult" = 33973
GhcDiagnosticCode "TcRnPatSynArityMismatch" = 18365
GhcDiagnosticCode "TcRnTyFamDepsDisabled" = 43991
GhcDiagnosticCode "TcRnAbstractClosedTyFamDecl" = 60012
GhcDiagnosticCode "TcRnPartialFieldSelector" = 82712
GhcDiagnosticCode "TcRnHasFieldResolvedIncomplete" = 86894
GhcDiagnosticCode "TcRnSuperclassCycle" = 29210
GhcDiagnosticCode "TcRnDefaultSigMismatch" = 72771
GhcDiagnosticCode "TcRnTyFamResultDisabled" = 44012
GhcDiagnosticCode "TcRnCommonFieldResultTypeMismatch" = 31004
GhcDiagnosticCode "TcRnCommonFieldTypeMismatch" = 91827
GhcDiagnosticCode "TcRnDataConParentTypeMismatch" = 45219
GhcDiagnosticCode "TcRnGADTsDisabled" = 23894
GhcDiagnosticCode "TcRnExistentialQuantificationDisabled" = 25709
GhcDiagnosticCode "TcRnGADTDataContext" = 61072
GhcDiagnosticCode "TcRnMultipleConForNewtype" = 16409
GhcDiagnosticCode "TcRnKindSignaturesDisabled" = 49378
GhcDiagnosticCode "TcRnEmptyDataDeclsDisabled" = 32478
GhcDiagnosticCode "TcRnRoleMismatch" = 29178
GhcDiagnosticCode "TcRnRoleCountMismatch" = 54298
GhcDiagnosticCode "TcRnIllegalRoleAnnotation" = 77192
GhcDiagnosticCode "TcRnRoleAnnotationsDisabled" = 17779
GhcDiagnosticCode "TcRnIncoherentRoles" = 18273
GhcDiagnosticCode "TcRnTypeSynonymCycle" = 97522
GhcDiagnosticCode "TcRnSelfImport" = 43281
GhcDiagnosticCode "TcRnNoExplicitImportList" = 16029
GhcDiagnosticCode "TcRnSafeImportsDisabled" = 26971
GhcDiagnosticCode "TcRnDeprecatedModule" = 15328
GhcDiagnosticCode "TcRnCompatUnqualifiedImport" = Outdated 82347
GhcDiagnosticCode "TcRnRedundantSourceImport" = 54478
GhcDiagnosticCode "TcRnDuplicateDecls" = 29916
GhcDiagnosticCode "TcRnPackageImportsDisabled" = 10032
GhcDiagnosticCode "TcRnIllegalDataCon" = 78448
GhcDiagnosticCode "TcRnNestedForallsContexts" = 71492
GhcDiagnosticCode "TcRnRedundantRecordWildcard" = 15932
GhcDiagnosticCode "TcRnUnusedRecordWildcard" = 83475
GhcDiagnosticCode "TcRnUnusedName" = 40910
GhcDiagnosticCode "TcRnQualifiedBinder" = 28329
GhcDiagnosticCode "TcRnInvalidRecordField" = 53822
GhcDiagnosticCode "TcRnTupleTooLarge" = 94803
GhcDiagnosticCode "TcRnCTupleTooLarge" = 89347
GhcDiagnosticCode "TcRnIllegalInferredTyVars" = 54832
GhcDiagnosticCode "TcRnAmbiguousName" = 87543
GhcDiagnosticCode "TcRnBindingNameConflict" = 10498
GhcDiagnosticCode "NonCanonicalMonoid" = 50928
GhcDiagnosticCode "NonCanonicalMonad" = 22705
GhcDiagnosticCode "TcRnDefaultedExceptionContext" = 46235
GhcDiagnosticCode "TcRnImplicitImportOfPrelude" = 20540
GhcDiagnosticCode "TcRnMissingMain" = 67120
GhcDiagnosticCode "TcRnGhciUnliftedBind" = 17999
GhcDiagnosticCode "TcRnGhciMonadLookupFail" = 44990
GhcDiagnosticCode "TcRnArityMismatch" = 27346
GhcDiagnosticCode "TcRnSimplifiableConstraint" = 62412
GhcDiagnosticCode "TcRnIllegalQuasiQuotes" = 77343
GhcDiagnosticCode "TcRnImplicitRhsQuantification" = 16382
GhcDiagnosticCode "TcRnBadTyConTelescope" = 87279
GhcDiagnosticCode "TcRnPatersonCondFailure" = 22979
GhcDiagnosticCode "TcRnDeprecatedInvisTyArgInConPat" = 69797
GhcDiagnosticCode "TcRnInvalidDefaultedTyVar" = 45625
GhcDiagnosticCode "TcRnIllegalTermLevelUse" = 01928
GhcDiagnosticCode "TcRnNamespacedWarningPragmaWithoutFlag" = 14995
GhcDiagnosticCode "TcRnInvisPatWithNoForAll" = 14964
GhcDiagnosticCode "TcRnIllegalInvisibleTypePattern" = 78249
GhcDiagnosticCode "TcRnNamespacedFixitySigWithoutFlag" = 78534
GhcDiagnosticCode "TcRnOutOfArityTyVar" = 84925
GhcDiagnosticCode "TcRnMisplacedInvisPat" = 11983
GhcDiagnosticCode "TcRnIllformedTypePattern" = 88754
GhcDiagnosticCode "TcRnIllegalTypePattern" = 70206
GhcDiagnosticCode "TcRnIllformedTypeArgument" = 29092
GhcDiagnosticCode "TcRnIllegalTypeExpr" = 35499
GhcDiagnosticCode "TcRnUnexpectedTypeSyntaxInTerms" = 31244
GhcDiagnosticCode "TypeApplication" = 23482
GhcDiagnosticCode "TypeApplicationInPattern" = 17916
GhcDiagnosticCode "PatSynNotInvertible" = 69317
GhcDiagnosticCode "PatSynUnboundVar" = 28572
GhcDiagnosticCode "LazyFieldsDisabled" = 81601
GhcDiagnosticCode "UnpackWithoutStrictness" = 10107
GhcDiagnosticCode "BackpackUnpackAbstractType" = 40091
GhcDiagnosticCode "TyVarRoleMismatch" = 22221
GhcDiagnosticCode "TyVarMissingInEnv" = 99991
GhcDiagnosticCode "BadCoercionRole" = 92834
GhcDiagnosticCode "MultiParamDisabled" = 28349
GhcDiagnosticCode "FunDepsDisabled" = 15708
GhcDiagnosticCode "ConstrainedClassMethodsDisabled" = 25079
GhcDiagnosticCode "TyFamsDisabledFamily" = 39191
GhcDiagnosticCode "TyFamsDisabledInstance" = 06206
GhcDiagnosticCode "TcRnPrecedenceParsingError" = 88747
GhcDiagnosticCode "TcRnSectionPrecedenceError" = 46878
GhcDiagnosticCode "HsigShapeSortMismatch" = 93008
GhcDiagnosticCode "HsigShapeNotUnifiable" = 93009
GhcDiagnosticCode "TcRnIllegalInvisTyVarBndr" = 58589
GhcDiagnosticCode "TcRnIllegalWildcardTyVarBndr" = 12211
GhcDiagnosticCode "TcRnInvalidInvisTyVarBndr" = 57916
GhcDiagnosticCode "TcRnInvisBndrWithoutSig" = 92337
GhcDiagnosticCode "DoesNotHaveSingleField" = 23517
GhcDiagnosticCode "IsNonLinear" = 38291
GhcDiagnosticCode "IsGADT" = 89498
GhcDiagnosticCode "HasConstructorContext" = 17440
GhcDiagnosticCode "HasExistentialTyVar" = 07525
GhcDiagnosticCode "HasStrictnessAnnotation" = 04049
GhcDiagnosticCode "NoConstructorHasAllFields" = 14392
GhcDiagnosticCode "MultiplePossibleParents" = 99339
GhcDiagnosticCode "InvalidTyConParent" = 33238
GhcDiagnosticCode "BadImportNotExported" = 61689
GhcDiagnosticCode "BadImportAvailDataCon" = 35373
GhcDiagnosticCode "BadImportNotExportedSubordinates" = 10237
GhcDiagnosticCode "BadImportAvailTyCon" = 56449
GhcDiagnosticCode "BadImportAvailVar" = 12112
GhcDiagnosticCode "WarningTxt" = 63394
GhcDiagnosticCode "DeprecatedTxt" = 68441
GhcDiagnosticCode "IllegalOccName" = 55017
GhcDiagnosticCode "SumAltArityExceeded" = 68444
GhcDiagnosticCode "IllegalSumAlt" = 63966
GhcDiagnosticCode "IllegalSumArity" = 97721
GhcDiagnosticCode "MalformedType" = 28709
GhcDiagnosticCode "IllegalLastStatement" = 47373
GhcDiagnosticCode "KindSigsOnlyAllowedOnGADTs" = 40746
GhcDiagnosticCode "IllegalDeclaration" = 23882
GhcDiagnosticCode "CannotMixGADTConsWith98Cons" = 24104
GhcDiagnosticCode "EmptyStmtListInDoBlock" = 34949
GhcDiagnosticCode "NonVarInInfixExpr" = 99831
GhcDiagnosticCode "MultiWayIfWithoutAlts" = 63930
GhcDiagnosticCode "CasesExprWithoutAlts" = 91745
GhcDiagnosticCode "ImplicitParamsWithOtherBinds" = 42974
GhcDiagnosticCode "InvalidCCallImpent" = 60220
GhcDiagnosticCode "RecGadtNoCons" = 18816
GhcDiagnosticCode "GadtNoCons" = 38140
GhcDiagnosticCode "InvalidTypeInstanceHeader" = 37056
GhcDiagnosticCode "InvalidTyFamInstLHS" = 78486
GhcDiagnosticCode "InvalidImplicitParamBinding" = 51603
GhcDiagnosticCode "DefaultDataInstDecl" = 39639
GhcDiagnosticCode "FunBindLacksEquations" = 52078
GhcDiagnosticCode "DodgyImportsEmptyParent" = 99623
GhcDiagnosticCode "ImportLookupQualified" = 48795
GhcDiagnosticCode "ImportLookupIllegal" = 14752
GhcDiagnosticCode "ImportLookupAmbiguous" = 92057
GhcDiagnosticCode "UnusedImportNone" = 66111
GhcDiagnosticCode "UnusedImportSome" = 38856
GhcDiagnosticCode "IllegalFamilyApplicationInInstance" = 73138
GhcDiagnosticCode "IllegalSpecialClassInstance" = 97044
GhcDiagnosticCode "IllegalInstanceFailsCoverageCondition" = 21572
GhcDiagnosticCode "InstHeadAbstractClass" = 51758
GhcDiagnosticCode "InstHeadNonClass" = 53946
GhcDiagnosticCode "InstHeadTySynArgs" = 93557
GhcDiagnosticCode "InstHeadNonTyVarArgs" = 48406
GhcDiagnosticCode "InstHeadMultiParam" = 91901
GhcDiagnosticCode "IllegalHasFieldInstanceNotATyCon" = 88994
GhcDiagnosticCode "IllegalHasFieldInstanceFamilyTyCon" = 70743
GhcDiagnosticCode "IllegalHasFieldInstanceTyConHasFields" = 43406
GhcDiagnosticCode "IllegalHasFieldInstanceTyConHasField" = 30836
GhcDiagnosticCode "NotAFamilyTyCon" = 06204
GhcDiagnosticCode "NotAnOpenFamilyTyCon" = 06207
GhcDiagnosticCode "FamilyCategoryMismatch" = 52347
GhcDiagnosticCode "FamilyArityMismatch" = 12985
GhcDiagnosticCode "TyFamNameMismatch" = 88221
GhcDiagnosticCode "FamInstRHSOutOfScopeTyVars" = 53634
GhcDiagnosticCode "FamInstLHSUnusedBoundTyVars" = 30337
GhcDiagnosticCode "AssocInstanceMissing" = 08585
GhcDiagnosticCode "AssocInstanceNotInAClass" = 06205
GhcDiagnosticCode "AssocNotInThisClass" = 38351
GhcDiagnosticCode "AssocNoClassTyVar" = 55912
GhcDiagnosticCode "AssocTyVarsDontMatch" = 95424
GhcDiagnosticCode "AssocDefaultNotAssoc" = 78822
GhcDiagnosticCode "AssocMultipleDefaults" = 59128
GhcDiagnosticCode "AssocDefaultNonTyVarArg" = 41522
GhcDiagnosticCode "AssocDefaultDuplicateTyVars" = 48178
GhcDiagnosticCode "NotADataType" = 31136
GhcDiagnosticCode "NewtypeDataConNotInScope" = 72317
GhcDiagnosticCode "UnliftedFFITypesNeeded" = 10964
GhcDiagnosticCode "NotABoxedMarshalableTyCon" = 89401
GhcDiagnosticCode "ForeignLabelNotAPtr" = 26070
GhcDiagnosticCode "NotSimpleUnliftedType" = 43510
GhcDiagnosticCode "NotBoxedKindAny" = 64097
GhcDiagnosticCode "ForeignDynNotPtr" = 27555
GhcDiagnosticCode "SafeHaskellMustBeInIO" = 57638
GhcDiagnosticCode "IOResultExpected" = 41843
GhcDiagnosticCode "UnexpectedNestedForall" = 92994
GhcDiagnosticCode "LinearTypesNotAllowed" = 57396
GhcDiagnosticCode "OneArgExpected" = 91490
GhcDiagnosticCode "AtLeastOneArgExpected" = 07641
GhcDiagnosticCode "BadSourceImport" = 64852
GhcDiagnosticCode "HomeModError" = 58427
GhcDiagnosticCode "DynamicHashMismatchError" = 54709
GhcDiagnosticCode "CouldntFindInFiles" = 94559
GhcDiagnosticCode "GenericMissing" = 87110
GhcDiagnosticCode "MissingPackageFiles" = 22211
GhcDiagnosticCode "MissingPackageWayFiles" = 88719
GhcDiagnosticCode "ModuleSuggestion" = 61948
GhcDiagnosticCode "MultiplePackages" = 45102
GhcDiagnosticCode "NoUnitIdMatching" = 51294
GhcDiagnosticCode "NotAModule" = 35235
GhcDiagnosticCode "Can'tFindNameInInterface" = 83249
GhcDiagnosticCode "CircularImport" = 75429
GhcDiagnosticCode "HiModuleNameMismatchWarn" = 53693
GhcDiagnosticCode "ExceptionOccurred" = 47808
GhcDiagnosticCode "NotInScope" = 76037
GhcDiagnosticCode "NotARecordField" = 22385
GhcDiagnosticCode "NoExactName" = 97784
GhcDiagnosticCode "SameName" = 81573
GhcDiagnosticCode "MissingBinding" = 44432
GhcDiagnosticCode "NoTopLevelBinding" = 10173
GhcDiagnosticCode "UnknownSubordinate" = 54721
GhcDiagnosticCode "NotInScopeTc" = 76329
GhcDiagnosticCode "DerivErrNotWellKinded" = 62016
GhcDiagnosticCode "DerivErrSafeHaskellGenericInst" = 07214
GhcDiagnosticCode "DerivErrDerivingViaWrongKind" = 63174
GhcDiagnosticCode "DerivErrNoEtaReduce" = 38996
GhcDiagnosticCode "DerivErrBootFileFound" = 30903
GhcDiagnosticCode "DerivErrDataConsNotAllInScope" = 54540
GhcDiagnosticCode "DerivErrGNDUsedOnData" = 10333
GhcDiagnosticCode "DerivErrNullaryClasses" = 04956
GhcDiagnosticCode "DerivErrLastArgMustBeApp" = 28323
GhcDiagnosticCode "DerivErrNoFamilyInstance" = 82614
GhcDiagnosticCode "DerivErrNotStockDeriveable" = 00158
GhcDiagnosticCode "DerivErrHasAssociatedDatatypes" = 34611
GhcDiagnosticCode "DerivErrNewtypeNonDeriveableClass" = 82023
GhcDiagnosticCode "DerivErrCannotEtaReduceEnough" = 26557
GhcDiagnosticCode "DerivErrOnlyAnyClassDeriveable" = 23244
GhcDiagnosticCode "DerivErrNotDeriveable" = 38178
GhcDiagnosticCode "DerivErrNotAClass" = 63388
GhcDiagnosticCode "DerivErrNoConstructors" = 64560
GhcDiagnosticCode "DerivErrLangExtRequired" = 86639
GhcDiagnosticCode "DerivErrDunnoHowToDeriveForType" = 48959
GhcDiagnosticCode "DerivErrMustBeEnumType" = 30750
GhcDiagnosticCode "DerivErrMustHaveExactlyOneConstructor" = 37542
GhcDiagnosticCode "DerivErrMustHaveSomeParameters" = 45539
GhcDiagnosticCode "DerivErrMustNotHaveClassContext" = 16588
GhcDiagnosticCode "DerivErrBadConstructor" = 16437
GhcDiagnosticCode "DerivErrGenerics" = 30367
GhcDiagnosticCode "DerivErrEnumOrProduct" = 58291
GhcDiagnosticCode "LookupInstErrNotExact" = 10372
GhcDiagnosticCode "LookupInstErrFlexiVar" = 10373
GhcDiagnosticCode "LookupInstErrNotFound" = 10374
GhcDiagnosticCode "TcRnMultipleDefaultDeclarations" = 99565
GhcDiagnosticCode "TcRnIllegalDefaultClass" = 26555
GhcDiagnosticCode "TcRnIllegalNamedDefault" = 55756
GhcDiagnosticCode "TcRnBadDefaultType" = 88933
GhcDiagnosticCode "TcRnWarnDefaulting" = 18042
GhcDiagnosticCode "TcRnWarnClashingDefaultImports" = 77007
GhcDiagnosticCode "EmptyStmtsGroupInParallelComp" = 41242
GhcDiagnosticCode "EmptyStmtsGroupInTransformListComp" = 92693
GhcDiagnosticCode "EmptyStmtsGroupInDoNotation" = 82311
GhcDiagnosticCode "EmptyStmtsGroupInArrowNotation" = 19442
GhcDiagnosticCode "MissingBootDefinition" = 63610
GhcDiagnosticCode "MissingBootExport" = 91999
GhcDiagnosticCode "MissingBootInstance" = 79857
GhcDiagnosticCode "BadReexportedBootThing" = 12424
GhcDiagnosticCode "BootMismatchedIdTypes" = 11890
GhcDiagnosticCode "BootMismatchedTyCons" = 15843
GhcDiagnosticCode "TypedTHWithPolyType" = 94642
GhcDiagnosticCode "SplicePolymorphicLocalVar" = 06568
GhcDiagnosticCode "SpliceThrewException" = 87897
GhcDiagnosticCode "InvalidTopDecl" = 52886
GhcDiagnosticCode "NonExactName" = 77923
GhcDiagnosticCode "AddInvalidCorePlugin" = 86463
GhcDiagnosticCode "AddDocToNonLocalDefn" = 67760
GhcDiagnosticCode "FailedToLookupThInstName" = 49530
GhcDiagnosticCode "CannotReifyInstance" = 30384
GhcDiagnosticCode "CannotReifyOutOfScopeThing" = 24922
GhcDiagnosticCode "CannotReifyThingNotInTypeEnv" = 79890
GhcDiagnosticCode "NoRolesAssociatedWithThing" = 65923
GhcDiagnosticCode "CannotRepresentType" = 75721
GhcDiagnosticCode "ReportCustomQuasiError" = 39584
GhcDiagnosticCode "MismatchedSpliceType" = 45108
GhcDiagnosticCode "IllegalTHQuotes" = 62558
GhcDiagnosticCode "IllegalTHSplice" = 26759
GhcDiagnosticCode "NestedTHBrackets" = 59185
GhcDiagnosticCode "AddTopDeclsUnexpectedDeclarationSplice" = 17599
GhcDiagnosticCode "BadImplicitSplice" = 25277
GhcDiagnosticCode "QuotedNameWrongStage" = 57695
GhcDiagnosticCode "IllegalStaticFormInSplice" = 12219
GhcDiagnosticCode "ZonkerCannotDefaultConcrete" = 52083
GhcDiagnosticCode "ClassPE" = 86934
GhcDiagnosticCode "TyConPE" = 85413
GhcDiagnosticCode "PatSynPE" = 70349
GhcDiagnosticCode "FamDataConPE" = 64578
GhcDiagnosticCode "ConstrainedDataConPE" = 28374
GhcDiagnosticCode "RecDataConPE" = 56753
GhcDiagnosticCode "TermVariablePE" = 45510
GhcDiagnosticCode "TypeVariablePE" = 47557
GhcDiagnosticCode "TcRnIllegalInstanceHeadDecl" = Outdated 12222
GhcDiagnosticCode "TcRnNoClassInstHead" = Outdated 56538
GhcDiagnosticCode "TcRnNameByTemplateHaskellQuote" = Outdated 40027
GhcDiagnosticCode "TcRnIllegalBindingOfBuiltIn" = Outdated 69639
GhcDiagnosticCode "TcRnMixedSelectors" = Outdated 40887
GhcDiagnosticCode "TcRnBadBootFamInstDecl" = Outdated 06203
GhcDiagnosticCode "TcRnBindInBootFile" = Outdated 11247
GhcDiagnosticCode "TcRnUnexpectedTypeSplice" = Outdated 39180
GhcDiagnosticCode "PsErrUnexpectedTypeAppInDecl" = Outdated 45054
GhcDiagnosticCode "TcRnUnpromotableThing" = Outdated 88634
GhcDiagnosticCode "UntouchableVariable" = Outdated 34699
GhcDiagnosticCode "TcRnBindVarAlreadyInScope" = Outdated 69710
GhcDiagnosticCode "TcRnBindMultipleVariables" = Outdated 92957
GhcDiagnosticCode "TcRnHsigNoIface" = Outdated 93010
GhcDiagnosticCode "TcRnInterfaceLookupError" = Outdated 52243
GhcDiagnosticCode "TcRnForallIdentifier" = Outdated 64088
type Outdated a = a
type ConRecursInto :: Symbol -> Maybe Type
type family ConRecursInto con where
ConRecursInto "GhcDriverMessage" = 'Just DriverMessage
ConRecursInto "GhcPsMessage" = 'Just PsMessage
ConRecursInto "GhcTcRnMessage" = 'Just TcRnMessage
ConRecursInto "GhcDsMessage" = 'Just DsMessage
ConRecursInto "GhcUnknownMessage" = 'Just (UnknownDiagnostic GhcMessageOpts)
ConRecursInto "DriverUnknownMessage" = 'Just (UnknownDiagnostic DriverMessageOpts)
ConRecursInto "DriverPsHeaderMessage" = 'Just PsMessage
ConRecursInto "DriverInterfaceError" = 'Just IfaceMessage
ConRecursInto "CantFindErr" = 'Just CantFindInstalled
ConRecursInto "CantFindInstalledErr" = 'Just CantFindInstalled
ConRecursInto "CantFindInstalled" = 'Just CantFindInstalledReason
ConRecursInto "BadIfaceFile" = 'Just ReadInterfaceError
ConRecursInto "FailedToLoadDynamicInterface" = 'Just ReadInterfaceError
ConRecursInto "PsUnknownMessage" = 'Just (UnknownDiagnostic NoDiagnosticOpts)
ConRecursInto "PsHeaderMessage" = 'Just PsHeaderMessage
ConRecursInto "TcRnUnknownMessage" = 'Just (UnknownDiagnostic TcRnMessageOpts)
ConRecursInto "TcRnMessageWithInfo" = 'Just TcRnMessageDetailed
ConRecursInto "TcRnMessageDetailed" = 'Just TcRnMessage
ConRecursInto "TcRnWithHsDocContext" = 'Just TcRnMessage
ConRecursInto "TcRnCannotDeriveInstance" = 'Just DeriveInstanceErrReason
ConRecursInto "TcRnLookupInstance" = 'Just LookupInstanceErrReason
ConRecursInto "TcRnPragmaWarning" = 'Just (WarningTxt GhcRn)
ConRecursInto "TcRnNotInScope" = 'Just NotInScopeError
ConRecursInto "TcRnIllegalNewtype" = 'Just IllegalNewtypeReason
ConRecursInto "TcRnHsigShapeMismatch" = 'Just HsigShapeMismatchReason
ConRecursInto "TcRnPatSynInvalidRhs" = 'Just PatSynInvalidRhsReason
ConRecursInto "TcRnBadRecordUpdate" = 'Just BadRecordUpdateReason
ConRecursInto "TcRnBadFieldAnnotation" = 'Just BadFieldAnnotationReason
ConRecursInto "TcRnRoleValidationFailed" = 'Just RoleValidationFailedReason
ConRecursInto "TcRnClassExtensionDisabled" = 'Just DisabledClassExtension
ConRecursInto "TcRnTyFamsDisabled" = 'Just TyFamsDisabledReason
ConRecursInto "TcRnDodgyImports" = 'Just DodgyImportsReason
ConRecursInto "DodgyImportsHiding" = 'Just ImportLookupReason
ConRecursInto "TcRnImportLookup" = 'Just ImportLookupReason
ConRecursInto "TcRnUnusedImport" = 'Just UnusedImportReason
ConRecursInto "TcRnNonCanonicalDefinition" = 'Just NonCanonicalDefinition
ConRecursInto "TcRnIllegalInstance" = 'Just IllegalInstanceReason
ConRecursInto "TcRnTypeApplicationsDisabled" = 'Just TypeApplication
ConRecursInto "IllegalClassInstance" = 'Just IllegalClassInstanceReason
ConRecursInto "IllegalFamilyInstance" = 'Just IllegalFamilyInstanceReason
ConRecursInto "IllegalInstanceHead" = 'Just IllegalInstanceHeadReason
ConRecursInto "IllegalHasFieldInstance" = 'Just IllegalHasFieldInstance
ConRecursInto "InvalidAssoc" = 'Just InvalidAssoc
ConRecursInto "InvalidAssocInstance" = 'Just InvalidAssocInstance
ConRecursInto "InvalidAssocDefault" = 'Just InvalidAssocDefault
ConRecursInto "AssocDefaultBadArgs" = 'Just AssocDefaultBadArgs
ConRecursInto "TcRnTHError" = 'Just THError
ConRecursInto "THSyntaxError" = 'Just THSyntaxError
ConRecursInto "THNameError" = 'Just THNameError
ConRecursInto "THReifyError" = 'Just THReifyError
ConRecursInto "TypedTHError" = 'Just TypedTHError
ConRecursInto "THSpliceFailed" = 'Just SpliceFailReason
ConRecursInto "RunSpliceFailure" = 'Just RunSpliceFailReason
ConRecursInto "ConversionFail" = 'Just ConversionFailReason
ConRecursInto "AddTopDeclsError" = 'Just AddTopDeclsError
ConRecursInto "AddTopDeclsRunSpliceFailure" = 'Just RunSpliceFailReason
ConRecursInto "TcRnInterfaceError" = 'Just IfaceMessage
ConRecursInto "Can'tFindInterface" = 'Just MissingInterfaceError
ConRecursInto "TcRnBootMismatch" = 'Just BootMismatch
ConRecursInto "MissingBootThing" = 'Just MissingBootThing
ConRecursInto "BootMismatch" = 'Just BootMismatchWhat
ConRecursInto "TcRnZonkerMessage" = 'Just ZonkerMessage
ConRecursInto "TcRnIllegalForeignType" = 'Just IllegalForeignTypeReason
ConRecursInto "TypeCannotBeMarshaled" = 'Just TypeCannotBeMarshaledReason
ConRecursInto "TcRnSolverReport" = 'Just SolverReportWithCtxt
ConRecursInto "SolverReportWithCtxt" = 'Just TcSolverReportMsg
ConRecursInto "TcReportWithInfo" = 'Just TcSolverReportMsg
ConRecursInto "CannotUnifyVariable" = 'Just CannotUnifyVariableReason
ConRecursInto "Mismatch" = 'Just MismatchMsg
ConRecursInto "TcRnEmptyStmtsGroup" = 'Just EmptyStatementGroupErrReason
ConRecursInto "DsUnknownMessage" = 'Just (UnknownDiagnostic NoDiagnosticOpts)
ConRecursInto "ImportLookupBad" = 'Just BadImportKind
ConRecursInto "TcRnUnpromotableThing" = 'Just PromotionErr
ConRecursInto _ = 'Nothing
type GDiagnosticCode :: (Type -> Type) -> Constraint
class GDiagnosticCode f where
gdiagnosticCode :: f a -> Maybe DiagnosticCode
type GDiagnosticCodes :: [Type] -> (Type -> Type) -> Constraint
class GDiagnosticCodes seen f where
gdiagnosticCodes :: Map DiagnosticCode String
type ConstructorCode :: Symbol -> (Type -> Type) -> Maybe Type -> Constraint
class ConstructorCode con f recur where
gconstructorCode :: f a -> Maybe DiagnosticCode
type ConstructorCodes :: Symbol -> (Type -> Type) -> [Type] -> Maybe Type -> Constraint
class ConstructorCodes con f seen recur where
gconstructorCodes :: Map DiagnosticCode String
instance (KnownConstructor con, KnownSymbol con) => ConstructorCode con f 'Nothing where
gconstructorCode :: forall a. f a -> Maybe DiagnosticCode
gconstructorCode f a
_ = DiagnosticCode -> Maybe DiagnosticCode
forall a. a -> Maybe a
Just (DiagnosticCode -> Maybe DiagnosticCode)
-> DiagnosticCode -> Maybe DiagnosticCode
forall a b. (a -> b) -> a -> b
$ String -> Nat -> DiagnosticCode
DiagnosticCode String
"GHC" (Nat -> DiagnosticCode) -> Nat -> DiagnosticCode
forall a b. (a -> b) -> a -> b
$ forall (n :: Nat). KnownNat n => Proxy# n -> Nat
natVal' @(GhcDiagnosticCode con) Proxy# (GhcDiagnosticCode con)
forall {k} (a :: k). Proxy# a
proxy#
instance (KnownConstructor con, KnownSymbol con) => ConstructorCodes con f seen 'Nothing where
gconstructorCodes :: Map DiagnosticCode String
gconstructorCodes =
DiagnosticCode -> String -> Map DiagnosticCode String
forall k a. k -> a -> Map k a
Map.singleton
(String -> Nat -> DiagnosticCode
DiagnosticCode String
"GHC" (Nat -> DiagnosticCode) -> Nat -> DiagnosticCode
forall a b. (a -> b) -> a -> b
$ forall (n :: Nat). KnownNat n => Proxy# n -> Nat
natVal' @(GhcDiagnosticCode con) Proxy# (GhcDiagnosticCode con)
forall {k} (a :: k). Proxy# a
proxy#)
(forall (n :: Symbol). KnownSymbol n => Proxy# n -> String
symbolVal' @con Proxy# con
forall {k} (a :: k). Proxy# a
proxy#)
instance {-# OVERLAPPING #-}
( ConRecursInto con ~ 'Just (UnknownDiagnostic opts)
, HasType (UnknownDiagnostic opts) con f )
=> ConstructorCode con f ('Just (UnknownDiagnostic opts)) where
gconstructorCode :: forall a. f a -> Maybe DiagnosticCode
gconstructorCode f a
diag = case forall ty (orig :: Symbol) (f :: * -> *) a.
HasType ty orig f =>
f a -> ty
getType @(UnknownDiagnostic opts) @con @f f a
diag of
UnknownDiagnostic opts -> DiagnosticOpts a
_ a
diag -> a -> Maybe DiagnosticCode
forall a. Diagnostic a => a -> Maybe DiagnosticCode
diagnosticCode a
diag
instance {-# OVERLAPPING #-}
( ConRecursInto con ~ 'Just (UnknownDiagnostic opts) )
=> ConstructorCodes con f seen ('Just (UnknownDiagnostic opts)) where
gconstructorCodes :: Map DiagnosticCode String
gconstructorCodes = Map DiagnosticCode String
forall k a. Map k a
Map.empty
instance ( ConRecursInto con ~ 'Just ty, HasType ty con f
, Generic ty, GDiagnosticCode (Rep ty) )
=> ConstructorCode con f ('Just ty) where
gconstructorCode :: forall a. f a -> Maybe DiagnosticCode
gconstructorCode f a
diag = Rep ty (ZonkAny 1) -> Maybe DiagnosticCode
forall a. Rep ty a -> Maybe DiagnosticCode
forall (f :: * -> *) a.
GDiagnosticCode f =>
f a -> Maybe DiagnosticCode
gdiagnosticCode (ty -> Rep ty (ZonkAny 1)
forall x. ty -> Rep ty x
forall a x. Generic a => a -> Rep a x
from (ty -> Rep ty (ZonkAny 1)) -> ty -> Rep ty (ZonkAny 1)
forall a b. (a -> b) -> a -> b
$ forall ty (orig :: Symbol) (f :: * -> *) a.
HasType ty orig f =>
f a -> ty
getType @ty @con @f f a
diag)
instance ( ConRecursInto con ~ 'Just ty, HasType ty con f
, Generic ty, GDiagnosticCodes (Insert ty seen) (Rep ty)
, Seen seen ty )
=> ConstructorCodes con f seen ('Just ty) where
gconstructorCodes :: Map DiagnosticCode String
gconstructorCodes =
if forall (seen :: [*]) ty. Seen seen ty => Bool
wasSeen @seen @ty
then Map DiagnosticCode String
forall k a. Map k a
Map.empty
else forall (seen :: [*]) (f :: * -> *).
GDiagnosticCodes seen f =>
Map DiagnosticCode String
gdiagnosticCodes @(Insert ty seen) @(Rep ty)
instance (ConstructorCode con f recur, recur ~ ConRecursInto con, KnownSymbol con)
=> GDiagnosticCode (M1 i ('MetaCons con x y) f) where
gdiagnosticCode :: forall a. M1 i ('MetaCons con x y) f a -> Maybe DiagnosticCode
gdiagnosticCode (M1 f a
x) = forall (con :: Symbol) (f :: * -> *) (recur :: Maybe (*)) a.
ConstructorCode con f recur =>
f a -> Maybe DiagnosticCode
gconstructorCode @con @f @recur f a
x
instance (ConstructorCodes con f seen recur, recur ~ ConRecursInto con, KnownSymbol con)
=> GDiagnosticCodes seen (M1 i ('MetaCons con x y) f) where
gdiagnosticCodes :: Map DiagnosticCode String
gdiagnosticCodes = forall (con :: Symbol) (f :: * -> *) (seen :: [*])
(recur :: Maybe (*)).
ConstructorCodes con f seen recur =>
Map DiagnosticCode String
gconstructorCodes @con @f @seen @recur
instance (GDiagnosticCode f, GDiagnosticCode g) => GDiagnosticCode (f :+: g) where
gdiagnosticCode :: forall a. (:+:) f g a -> Maybe DiagnosticCode
gdiagnosticCode (L1 f a
x) = forall (f :: * -> *) a.
GDiagnosticCode f =>
f a -> Maybe DiagnosticCode
gdiagnosticCode @f f a
x
gdiagnosticCode (R1 g a
y) = forall (f :: * -> *) a.
GDiagnosticCode f =>
f a -> Maybe DiagnosticCode
gdiagnosticCode @g g a
y
instance (GDiagnosticCodes seen f, GDiagnosticCodes seen g) => GDiagnosticCodes seen (f :+: g) where
gdiagnosticCodes :: Map DiagnosticCode String
gdiagnosticCodes = Map DiagnosticCode String
-> Map DiagnosticCode String -> Map DiagnosticCode String
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (forall (seen :: [*]) (f :: * -> *).
GDiagnosticCodes seen f =>
Map DiagnosticCode String
gdiagnosticCodes @seen @f) (forall (seen :: [*]) (f :: * -> *).
GDiagnosticCodes seen f =>
Map DiagnosticCode String
gdiagnosticCodes @seen @g)
instance GDiagnosticCode f
=> GDiagnosticCode (M1 i ('MetaData nm mod pkg nt) f) where
gdiagnosticCode :: forall a.
M1 i ('MetaData nm mod pkg nt) f a -> Maybe DiagnosticCode
gdiagnosticCode (M1 f a
x) = forall (f :: * -> *) a.
GDiagnosticCode f =>
f a -> Maybe DiagnosticCode
gdiagnosticCode @f f a
x
instance GDiagnosticCodes seen f
=> GDiagnosticCodes seen (M1 i ('MetaData nm mod pkg nt) f) where
gdiagnosticCodes :: Map DiagnosticCode String
gdiagnosticCodes = forall (seen :: [*]) (f :: * -> *).
GDiagnosticCodes seen f =>
Map DiagnosticCode String
gdiagnosticCodes @seen @f
type family HasTypeQ (ty :: Type) f :: Maybe Type where
HasTypeQ typ (M1 _ _ (K1 _ typ))
= 'Just typ
HasTypeQ typ (M1 _ _ x)
= HasTypeQ typ x
HasTypeQ typ (l :*: r)
= Alt (HasTypeQ typ l) (HasTypeQ typ r)
HasTypeQ typ (l :+: r)
= Both (HasTypeQ typ l) (HasTypeQ typ r)
HasTypeQ typ (K1 _ _)
= 'Nothing
HasTypeQ typ U1
= 'Nothing
HasTypeQ typ V1
= 'Nothing
type family Both (m1 :: Maybe a) (m2 :: Maybe a) :: Maybe a where
Both ('Just a) ('Just a) = 'Just a
type family Alt (m1 :: Maybe a) (m2 :: Maybe a) :: Maybe a where
Alt ('Just a) _ = 'Just a
Alt _ b = b
type HasType :: Type -> Symbol -> (Type -> Type) -> Constraint
class HasType ty orig f where
getType :: f a -> ty
instance HasType ty orig (M1 i s (K1 x ty)) where
getType :: forall a. M1 i s (K1 x ty) a -> ty
getType (M1 (K1 ty
x)) = ty
x
instance HasTypeProd ty (HasTypeQ ty f) orig f g => HasType ty orig (f :*: g) where
getType :: forall a. (:*:) f g a -> ty
getType = forall ty (lr :: Maybe (*)) (orig :: Symbol) (f :: * -> *)
(g :: * -> *) a.
HasTypeProd ty lr orig f g =>
(:*:) f g a -> ty
forall {k} {k} {k} ty (lr :: k) (orig :: k) (f :: k -> *)
(g :: k -> *) (a :: k).
HasTypeProd ty lr orig f g =>
(:*:) f g a -> ty
getTypeProd @ty @(HasTypeQ ty f) @orig
class HasTypeProd ty lr orig f g where
getTypeProd :: (f :*: g) a -> ty
instance HasType ty orig f => HasTypeProd ty ('Just l) orig f g where
getTypeProd :: forall a. (:*:) f g a -> ty
getTypeProd (f a
x :*: g a
_) = forall ty (orig :: Symbol) (f :: * -> *) a.
HasType ty orig f =>
f a -> ty
getType @ty @orig @f f a
x
instance HasType ty orig g => HasTypeProd ty 'Nothing orig f g where
getTypeProd :: forall a. (:*:) f g a -> ty
getTypeProd (f a
_ :*: g a
y) = forall ty (orig :: Symbol) (f :: * -> *) a.
HasType ty orig f =>
f a -> ty
getType @ty @orig @g g a
y
type Seen :: [Type] -> Type -> Constraint
class Seen seen ty where
wasSeen :: Bool
instance Seen '[] ty where
wasSeen :: Bool
wasSeen = Bool
False
instance {-# OVERLAPPING #-} Seen (ty ': tys) ty where
wasSeen :: Bool
wasSeen = Bool
True
instance Seen tys ty => Seen (ty' ': tys) ty where
wasSeen :: Bool
wasSeen = forall (seen :: [*]) ty. Seen seen ty => Bool
wasSeen @tys @ty
type Insert :: Type -> [Type] -> [Type]
type family Insert ty tys where
Insert ty '[] = '[ty]
Insert ty (ty ': tys) = ty ': tys
Insert ty (ty' ': tys) = ty' ': Insert ty tys
instance {-# OVERLAPPABLE #-}
TypeError
( 'Text "The constructor '" ':<>: 'Text orig ':<>: 'Text "'"
':$$: 'Text "does not have any argument of type '" ':<>: 'ShowType ty ':<>: 'Text "'."
':$$: 'Text ""
':$$: 'Text "This is likely due to an incorrect type family equation:"
':$$: 'Text " ConRecursInto \"" ':<>: 'Text orig ':<>: 'Text "\" = " ':<>: 'ShowType ty )
=> HasType ty orig f where
getType :: forall a. f a -> ty
getType = String -> f a -> ty
forall a. HasCallStack => String -> a
panic String
"getType: unreachable"
type KnownConstructor :: Symbol -> Constraint
type family KnownConstructor con where
KnownConstructor con =
KnownNatOrErr
( TypeError
( 'Text "Missing diagnostic code for constructor "
':<>: 'Text "'" ':<>: 'Text con ':<>: 'Text "'."
':$$: 'Text ""
':$$: 'Text "Note [Diagnostic codes] in GHC.Types.Error.Codes"
':$$: 'Text "contains instructions for adding a new diagnostic code."
)
)
(GhcDiagnosticCode con)
type KnownNatOrErr :: Constraint -> Nat -> Constraint
type KnownNatOrErr err n = (Assert err n, KnownNat n)
type Assert :: Constraint -> k -> Constraint
type family Assert err n where
Assert _ Dummy = Dummy
Assert _ n = ()
data family Dummy :: k