{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

{-# OPTIONS_GHC -fno-warn-orphans #-} -- instance Diagnostic TcRnMessage

module GHC.Tc.Errors.Ppr
  ( pprTypeDoesNotHaveFixedRuntimeRep
  , pprScopeError
  --
  , tidySkolemInfo
  , tidySkolemInfoAnon
  --
  , pprHsDocContext
  , inHsDocContext
  , TcRnMessageOpts(..)
  )
  where

import GHC.Prelude

import GHC.Builtin.Names
import GHC.Builtin.Types ( boxedRepDataConTyCon, tYPETyCon )

import GHC.Core.Coercion
import GHC.Core.Unify     ( tcMatchTys )
import GHC.Core.TyCon
import GHC.Core.Class
import GHC.Core.DataCon
import GHC.Core.Coercion.Axiom (coAxiomTyCon, coAxiomSingleBranch)
import GHC.Core.ConLike
import GHC.Core.FamInstEnv ( famInstAxiom )
import GHC.Core.InstEnv
import GHC.Core.TyCo.Rep (Type(..))
import GHC.Core.TyCo.Ppr (pprWithExplicitKindsWhen,
                          pprSourceTyCon, pprTyVars, pprWithTYPE)
import GHC.Core.PatSyn ( patSynName, pprPatSynType )
import GHC.Core.Predicate
import GHC.Core.Type

import GHC.Driver.Flags
import GHC.Driver.Backend
import GHC.Hs

import GHC.Tc.Errors.Types
import GHC.Tc.Types.Constraint
import {-# SOURCE #-} GHC.Tc.Types( getLclEnvLoc, lclEnvInGeneratedCode )
import GHC.Tc.Types.Origin
import GHC.Tc.Types.Rank (Rank(..))
import GHC.Tc.Utils.TcType

import GHC.Types.Error
import GHC.Types.FieldLabel (flIsOverloaded)
import GHC.Types.Hint (UntickedPromotedThing(..), pprUntickedConstructor, isBareSymbol)
import GHC.Types.Hint.Ppr () -- Outputable GhcHint
import GHC.Types.Basic
import GHC.Types.Error.Codes ( constructorCode )
import GHC.Types.Id
import GHC.Types.Name
import GHC.Types.Name.Reader ( GreName(..), pprNameProvenance
                             , RdrName, rdrNameOcc, greMangledName )
import GHC.Types.Name.Set
import GHC.Types.SrcLoc
import GHC.Types.TyThing
import GHC.Types.Unique.Set ( nonDetEltsUniqSet )
import GHC.Types.Var
import GHC.Types.Var.Set
import GHC.Types.Var.Env

import GHC.Unit.State (pprWithUnitState, UnitState)
import GHC.Unit.Module
import GHC.Unit.Module.Warnings  ( pprWarningTxtForMsg )

import GHC.Data.Bag
import GHC.Data.FastString
import GHC.Data.List.SetOps ( nubOrdBy )
import GHC.Data.Maybe
import GHC.Utils.Misc
import GHC.Utils.Outputable
import GHC.Utils.Panic

import qualified GHC.LanguageExtensions as LangExt

import GHC.Data.BooleanFormula (pprBooleanFormulaNice)

import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NE
import Data.Function (on)
import Data.List ( groupBy, sortBy, tails
                 , partition, unfoldr )
import Data.Ord ( comparing )
import Data.Bifunctor
import GHC.Types.Name.Env
import qualified Language.Haskell.TH as TH

data TcRnMessageOpts = TcRnMessageOpts { TcRnMessageOpts -> Bool
tcOptsShowContext :: !Bool -- ^ Whether we show the error context or not
                                       }

defaultTcRnMessageOpts :: TcRnMessageOpts
defaultTcRnMessageOpts :: TcRnMessageOpts
defaultTcRnMessageOpts = TcRnMessageOpts { tcOptsShowContext :: Bool
tcOptsShowContext = Bool
True }


instance Diagnostic TcRnMessage where
  type DiagnosticOpts TcRnMessage = TcRnMessageOpts
  defaultDiagnosticOpts :: DiagnosticOpts TcRnMessage
defaultDiagnosticOpts = DiagnosticOpts TcRnMessage
TcRnMessageOpts
defaultTcRnMessageOpts
  diagnosticMessage :: DiagnosticOpts TcRnMessage -> TcRnMessage -> DecoratedSDoc
diagnosticMessage DiagnosticOpts TcRnMessage
opts = \case
    TcRnUnknownMessage (UnknownDiagnostic @e a
m)
      -> DiagnosticOpts a -> a -> DecoratedSDoc
forall a. Diagnostic a => DiagnosticOpts a -> a -> DecoratedSDoc
diagnosticMessage (forall a. Diagnostic a => DiagnosticOpts a
defaultDiagnosticOpts @e) a
m
    TcRnMessageWithInfo UnitState
unit_state TcRnMessageDetailed
msg_with_info
      -> case TcRnMessageDetailed
msg_with_info of
           TcRnMessageDetailed ErrInfo
err_info TcRnMessage
msg
             -> UnitState -> ErrInfo -> Bool -> DecoratedSDoc -> DecoratedSDoc
messageWithInfoDiagnosticMessage UnitState
unit_state ErrInfo
err_info
                  (TcRnMessageOpts -> Bool
tcOptsShowContext DiagnosticOpts TcRnMessage
TcRnMessageOpts
opts)
                  (DiagnosticOpts TcRnMessage -> TcRnMessage -> DecoratedSDoc
forall a. Diagnostic a => DiagnosticOpts a -> a -> DecoratedSDoc
diagnosticMessage DiagnosticOpts TcRnMessage
opts TcRnMessage
msg)
    TcRnWithHsDocContext HsDocContext
ctxt TcRnMessage
msg
      -> if TcRnMessageOpts -> Bool
tcOptsShowContext DiagnosticOpts TcRnMessage
TcRnMessageOpts
opts
         then DecoratedSDoc
main_msg DecoratedSDoc -> DecoratedSDoc -> DecoratedSDoc
`unionDecoratedSDoc` DecoratedSDoc
ctxt_msg
         else DecoratedSDoc
main_msg
      where
        main_msg :: DecoratedSDoc
main_msg = DiagnosticOpts TcRnMessage -> TcRnMessage -> DecoratedSDoc
forall a. Diagnostic a => DiagnosticOpts a -> a -> DecoratedSDoc
diagnosticMessage DiagnosticOpts TcRnMessage
opts TcRnMessage
msg
        ctxt_msg :: DecoratedSDoc
ctxt_msg = SDoc -> DecoratedSDoc
mkSimpleDecorated (HsDocContext -> SDoc
inHsDocContext HsDocContext
ctxt)
    TcRnSolverReport SolverReportWithCtxt
msg DiagnosticReason
_ [GhcHint]
_
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SolverReportWithCtxt -> SDoc
pprSolverReportWithCtxt SolverReportWithCtxt
msg
    TcRnRedundantConstraints [TcTyVar]
redundants (SkolemInfoAnon
info, Bool
show_info)
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Redundant constraint" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [TcTyVar] -> SDoc
forall a. [a] -> SDoc
plural [TcTyVar]
redundants SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon
           SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TcTyVar] -> SDoc
pprEvVarTheta [TcTyVar]
redundants
         SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ if Bool
show_info then String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"In" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SkolemInfoAnon -> SDoc
forall a. Outputable a => a -> SDoc
ppr SkolemInfoAnon
info else SDoc
forall doc. IsOutput doc => doc
empty
    TcRnInaccessibleCode Implication
implic SolverReportWithCtxt
contra
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Inaccessible code in")
           Int
2 (SkolemInfoAnon -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Implication -> SkolemInfoAnon
ic_info Implication
implic))
         SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SolverReportWithCtxt -> SDoc
pprSolverReportWithCtxt SolverReportWithCtxt
contra
    TcRnTypeDoesNotHaveFixedRuntimeRep Type
ty FixedRuntimeRepProvenance
prov (ErrInfo SDoc
extra SDoc
supplementary)
      -> [SDoc] -> DecoratedSDoc
mkDecorated [Type -> FixedRuntimeRepProvenance -> SDoc
pprTypeDoesNotHaveFixedRuntimeRep Type
ty FixedRuntimeRepProvenance
prov, SDoc
extra, SDoc
supplementary]
    TcRnImplicitLift Name
id_or_name ErrInfo{SDoc
errInfoContext :: SDoc
errInfoSupplementary :: SDoc
errInfoContext :: ErrInfo -> SDoc
errInfoSupplementary :: ErrInfo -> SDoc
..}
      -> [SDoc] -> DecoratedSDoc
mkDecorated ([SDoc] -> DecoratedSDoc) -> [SDoc] -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           ( String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
id_or_name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
             String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is implicitly lifted in the TH quotation"
           ) SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: [SDoc
errInfoContext, SDoc
errInfoSupplementary]
    TcRnUnusedPatternBinds HsBind GhcRn
bind
      -> [SDoc] -> DecoratedSDoc
mkDecorated [SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"This pattern-binding binds no variables:") Int
2 (HsBind GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsBind GhcRn
bind)]
    TcRnDodgyImports RdrName
name
      -> [SDoc] -> DecoratedSDoc
mkDecorated [SDoc -> RdrName -> IE GhcPs -> SDoc
forall a b. (Outputable a, Outputable b) => SDoc -> a -> b -> SDoc
dodgy_msg (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"import") RdrName
name (IdP GhcPs -> IE GhcPs
forall (p :: Pass).
(Anno (IdP (GhcPass p)) ~ SrcSpanAnnN) =>
IdP (GhcPass p) -> IE (GhcPass p)
dodgy_msg_insert IdP GhcPs
RdrName
name :: IE GhcPs)]
    TcRnDodgyExports Name
name
      -> [SDoc] -> DecoratedSDoc
mkDecorated [SDoc -> Name -> IE GhcRn -> SDoc
forall a b. (Outputable a, Outputable b) => SDoc -> a -> b -> SDoc
dodgy_msg (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"export") Name
name (IdP GhcRn -> IE GhcRn
forall (p :: Pass).
(Anno (IdP (GhcPass p)) ~ SrcSpanAnnN) =>
IdP (GhcPass p) -> IE (GhcPass p)
dodgy_msg_insert IdP GhcRn
Name
name :: IE GhcRn)]
    TcRnMissingImportList IE GhcPs
ie
      -> [SDoc] -> DecoratedSDoc
mkDecorated [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The import item" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (IE GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr IE GhcPs
ie) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                       String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not have an explicit import list"
                     ]
    TcRnMessage
TcRnUnsafeDueToPlugin
      -> [SDoc] -> DecoratedSDoc
mkDecorated [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Use of plugins makes the module unsafe"]
    TcRnModMissingRealSrcSpan Module
mod
      -> [SDoc] -> DecoratedSDoc
mkDecorated [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Module does not have a RealSrcSpan:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod]
    TcRnIdNotExportedFromModuleSig Name
name Module
mod
      -> [SDoc] -> DecoratedSDoc
mkDecorated [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The identifier" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                       String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not exist in the signature for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod
                     ]
    TcRnIdNotExportedFromLocalSig Name
name
      -> [SDoc] -> DecoratedSDoc
mkDecorated [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The identifier" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> OccName
forall name. HasOccName name => name -> OccName
occName Name
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                       String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not exist in the local signature."
                     ]
    TcRnShadowedName OccName
occ ShadowedNameProvenance
provenance
      -> let shadowed_locs :: [SDoc]
shadowed_locs = case ShadowedNameProvenance
provenance of
               ShadowedNameProvenanceLocal SrcLoc
n     -> [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcLoc -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcLoc
n]
               ShadowedNameProvenanceGlobal [GlobalRdrElt]
gres -> (GlobalRdrElt -> SDoc) -> [GlobalRdrElt] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> SDoc
pprNameProvenance [GlobalRdrElt]
gres
         in SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"This binding for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ)
             SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"shadows the existing binding" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [SDoc] -> SDoc
forall a. [a] -> SDoc
plural [SDoc]
shadowed_locs,
                   Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [SDoc]
shadowed_locs)]
    TcRnDuplicateWarningDecls LocatedN RdrName
d RdrName
rdr_name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Multiple warning declarations for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name),
                 String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"also at " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (LocatedN RdrName -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedN RdrName
d)]
    TcRnSimplifierTooManyIterations Cts
simples IntWithInf
limit WantedConstraints
wc
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"solveWanteds: too many iterations"
                   SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"limit =" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IntWithInf -> SDoc
forall a. Outputable a => a -> SDoc
ppr IntWithInf
limit))
                Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unsolved:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> WantedConstraints -> SDoc
forall a. Outputable a => a -> SDoc
ppr WantedConstraints
wc
                        , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Simples:"  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Cts -> SDoc
forall a. Outputable a => a -> SDoc
ppr Cts
simples
                        ])
    TcRnIllegalPatSynDecl LIdP GhcPs
rdrname
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal pattern synonym declaration for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (LocatedN RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr LIdP GhcPs
LocatedN RdrName
rdrname))
              Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Pattern synonym declarations are only valid at top level")
    TcRnLinearPatSyn Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Pattern synonyms do not support linear fields (GHC #18806):") Int
2 (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty)
    TcRnMessage
TcRnEmptyRecordUpdate
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Empty record update"
    TcRnIllegalFieldPunning Located RdrName
fld
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal use of punning for field" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Located RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr Located RdrName
fld)
    TcRnIllegalWildcardsInRecord RecordFieldPart
fld_part
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal `..' in record" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RecordFieldPart -> SDoc
pprRecordFieldPart RecordFieldPart
fld_part
    TcRnIllegalWildcardInType Maybe Name
mb_name BadAnonWildcardContext
bad
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ case BadAnonWildcardContext
bad of
          BadAnonWildcardContext
WildcardNotLastInConstraint ->
            SDoc -> Int -> SDoc -> SDoc
hang SDoc
notAllowed Int
2 SDoc
constraint_hint_msg
          ExtraConstraintWildcardNotAllowed SoleExtraConstraintWildcardAllowed
allow_sole ->
            case SoleExtraConstraintWildcardAllowed
allow_sole of
              SoleExtraConstraintWildcardAllowed
SoleExtraConstraintWildcardNotAllowed ->
                SDoc
notAllowed
              SoleExtraConstraintWildcardAllowed
SoleExtraConstraintWildcardAllowed ->
                SDoc -> Int -> SDoc -> SDoc
hang SDoc
notAllowed Int
2 SDoc
sole_msg
          BadAnonWildcardContext
WildcardsNotAllowedAtAll ->
            SDoc
notAllowed
      where
        notAllowed, what, wildcard, how :: SDoc
        notAllowed :: SDoc
notAllowed = SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
wildcard SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
how
        wildcard :: SDoc
wildcard = case Maybe Name
mb_name of
          Maybe Name
Nothing   -> SDoc
pprAnonWildCard
          Just Name
name -> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name
        what :: SDoc
what
          | Just Name
_ <- Maybe Name
mb_name
          = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Named wildcard"
          | ExtraConstraintWildcardNotAllowed {} <- BadAnonWildcardContext
bad
          = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Extra-constraint wildcard"
          | Bool
otherwise
          = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Wildcard"
        how :: SDoc
how = case BadAnonWildcardContext
bad of
          BadAnonWildcardContext
WildcardNotLastInConstraint
            -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"not allowed in a constraint"
          BadAnonWildcardContext
_ -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"not allowed"
        constraint_hint_msg :: SDoc
        constraint_hint_msg :: SDoc
constraint_hint_msg
          | Just Name
_ <- Maybe Name
mb_name
          = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Extra-constraint wildcards must be anonymous"
                 , Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"e.g  f :: (Eq a, _) => blah") ]
          | Bool
otherwise
          = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"except as the last top-level constraint of a type signature"
                 , Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"e.g  f :: (Eq a, _) => blah") ]
        sole_msg :: SDoc
        sole_msg :: SDoc
sole_msg =
          [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"except as the sole constraint"
               , Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"e.g., deriving instance _ => Eq (Foo a)") ]
    TcRnDuplicateFieldName RecordFieldPart
fld_part NonEmpty RdrName
dups
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"duplicate field name",
                 SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (NonEmpty RdrName -> RdrName
forall a. NonEmpty a -> a
NE.head NonEmpty RdrName
dups)),
                 String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in record", RecordFieldPart -> SDoc
pprRecordFieldPart RecordFieldPart
fld_part]
    TcRnIllegalViewPattern Pat GhcPs
pat
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal view pattern: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Pat GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr Pat GhcPs
pat]
    TcRnCharLiteralOutOfRange Char
c
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"character literal out of range: '\\" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
c  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'\''
    TcRnIllegalWildcardsInConstructor Name
con
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal `..' notation for constructor" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
con)
                , Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The constructor has no labelled fields") ]
    TcRnIgnoringAnnotations [LAnnDecl GhcRn]
anns
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Ignoring ANN annotation" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [GenLocated SrcSpanAnnA (AnnDecl GhcRn)] -> SDoc
forall a. [a] -> SDoc
plural [LAnnDecl GhcRn]
[GenLocated SrcSpanAnnA (AnnDecl GhcRn)]
anns SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma
           SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"because this is a stage-1 compiler without -fexternal-interpreter or doesn't support GHCi"
    TcRnMessage
TcRnAnnotationInSafeHaskell
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Annotations are not compatible with Safe Haskell."
                , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"See https://gitlab.haskell.org/ghc/ghc/issues/10826" ]
    TcRnInvalidTypeApplication Type
fun_ty LHsWcType GhcRn
hs_ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cannot apply expression of type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
fun_ty) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"to a visible type argument" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
-> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsWcType GhcRn
HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
hs_ty)
    TcRnMessage
TcRnTagToEnumMissingValArg
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"tagToEnum# must appear applied to one value argument"
    TcRnTagToEnumUnspecifiedResTy Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Bad call to tagToEnum# at type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty)
              Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Specify the type by giving a type signature"
                      , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"e.g. (tagToEnum# x) :: Bool" ])
    TcRnTagToEnumResTyNotAnEnum Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Bad call to tagToEnum# at type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty)
              Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Result type must be an enumeration type")
    TcRnMessage
TcRnArrowIfThenElsePredDependsOnResultTy
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Predicate type of `ifThenElse' depends on result type"
    TcRnMessage
TcRnIllegalHsBootFileDecl
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal declarations in an hs-boot file"
    TcRnRecursivePatternSynonym LHsBinds GhcRn
binds
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Recursive pattern synonym definition with following bindings:")
               Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsBind GhcRn) -> SDoc)
-> [GenLocated SrcSpanAnnA (HsBind GhcRn)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (HsBind GhcRn) -> SDoc
forall a idR.
CollectPass GhcRn =>
GenLocated (SrcSpanAnn' a) (HsBindLR GhcRn idR) -> SDoc
pprLBind ([GenLocated SrcSpanAnnA (HsBind GhcRn)] -> [SDoc])
-> (LHsBinds GhcRn -> [GenLocated SrcSpanAnnA (HsBind GhcRn)])
-> LHsBinds GhcRn
-> [SDoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsBinds GhcRn -> [GenLocated SrcSpanAnnA (HsBind GhcRn)]
Bag (GenLocated SrcSpanAnnA (HsBind GhcRn))
-> [GenLocated SrcSpanAnnA (HsBind GhcRn)]
forall a. Bag a -> [a]
bagToList (LHsBinds GhcRn -> [SDoc]) -> LHsBinds GhcRn -> [SDoc]
forall a b. (a -> b) -> a -> b
$ LHsBinds GhcRn
binds)
          where
            pprLoc :: a -> SDoc
pprLoc a
loc = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"defined at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
loc)
            pprLBind :: CollectPass GhcRn => GenLocated (SrcSpanAnn' a) (HsBindLR GhcRn idR) -> SDoc
            pprLBind :: forall a idR.
CollectPass GhcRn =>
GenLocated (SrcSpanAnn' a) (HsBindLR GhcRn idR) -> SDoc
pprLBind (L SrcSpanAnn' a
loc HsBindLR GhcRn idR
bind) = (Name -> SDoc) -> [Name] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CollectFlag GhcRn -> HsBindLR GhcRn idR -> [IdP GhcRn]
forall p idR.
CollectPass p =>
CollectFlag p -> HsBindLR p idR -> [IdP p]
collectHsBindBinders CollectFlag GhcRn
forall p. CollectFlag p
CollNoDictBinders HsBindLR GhcRn idR
bind)
                                        SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
pprLoc (SrcSpanAnn' a -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' a
loc)
    TcRnPartialTypeSigTyVarMismatch Name
n1 Name
n2 Name
fn_name LHsSigWcType GhcRn
hs_ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Couldn't match" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n1)
                   SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"with" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n2))
                Int
2 (SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"both bound by the partial type signature:")
                        Int
2 (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
fn_name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
-> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsSigWcType GhcRn
HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
hs_ty))
    TcRnPartialTypeSigBadQuantifier Name
n Name
fn_name Maybe Type
m_unif_ty LHsSigWcType GhcRn
hs_ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Can't quantify over" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n))
                Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound by the partial type signature:")
                             Int
2 (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
fn_name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
-> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsSigWcType GhcRn
HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
hs_ty)
                        , SDoc
extra ])
      where
        extra :: SDoc
extra | Just Type
rhs_ty <- Maybe Type
m_unif_ty
              = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n), String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"should really be", SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
rhs_ty) ]
              | Bool
otherwise
              = SDoc
forall doc. IsOutput doc => doc
empty
    TcRnMissingSignature MissingSignature
what Exported
_ Bool
_ ->
      SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      case MissingSignature
what of
        MissingPatSynSig PatSyn
p ->
          SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Pattern synonym with no type signature:")
            Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"pattern" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. NamedThing a => a -> SDoc
pprPrefixName (PatSyn -> Name
patSynName PatSyn
p) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> PatSyn -> SDoc
pprPatSynType PatSyn
p)
        MissingTopLevelBindingSig Name
name Type
ty ->
          SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Top-level binding with no type signature:")
            Int
2 (Name -> SDoc
forall a. NamedThing a => a -> SDoc
pprPrefixName Name
name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprSigmaType Type
ty)
        MissingTyConKindSig TyCon
tc Bool
cusks_enabled ->
          SDoc -> Int -> SDoc -> SDoc
hang SDoc
msg
            Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. NamedThing a => a -> SDoc
pprPrefixName (TyCon -> Name
tyConName TyCon
tc) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprKind (TyCon -> Type
tyConKind TyCon
tc))
          where
            msg :: SDoc
msg | Bool
cusks_enabled
                = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Top-level type constructor with no standalone kind signature or CUSK:"
                | Bool
otherwise
                = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Top-level type constructor with no standalone kind signature:"

    TcRnPolymorphicBinderMissingSig Name
n Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Polymorphic local binding with no type signature:"
               , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Name -> SDoc
forall a. NamedThing a => a -> SDoc
pprPrefixName Name
n SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty ]
    TcRnOverloadedSig TcIdSigInfo
sig
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Overloaded signature conflicts with monomorphism restriction")
              Int
2 (TcIdSigInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcIdSigInfo
sig)
    TcRnTupleConstraintInst Class
_
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"You can't specify an instance for a tuple constraint"
    TcRnAbstractClassInst Class
clas
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cannot define instance for abstract class" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
           SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Class -> Name
className Class
clas))
    TcRnNoClassInstHead Type
tau
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Instance head is not headed by a class:") Int
2 (Type -> SDoc
pprType Type
tau)
    TcRnUserTypeError Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (Type -> SDoc
pprUserTypeErrorTy Type
ty)
    TcRnConstraintInKind Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal constraint in a kind:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprType Type
ty
    TcRnUnboxedTupleOrSumTypeFuncArg UnboxedTupleOrSum
tuple_or_sum Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal unboxed" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type as function argument:"
               , Type -> SDoc
pprType Type
ty ]
        where
          what :: SDoc
what = case UnboxedTupleOrSum
tuple_or_sum of
            UnboxedTupleOrSum
UnboxedTupleType -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"tuple"
            UnboxedTupleOrSum
UnboxedSumType   -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"sum"
    TcRnLinearFuncInKind Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal linear function in a kind:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprType Type
ty
    TcRnForAllEscapeError Type
ty Type
kind
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
           [ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Quantified type's kind mentions quantified type variable")
                Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty))
           , SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"where the body of the forall has this kind:")
                Int
2 (SDoc -> SDoc
quotes (Type -> SDoc
pprKind Type
kind)) ]
    TcRnVDQInTermType Maybe Type
mb_ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
           [ case Maybe Type
mb_ty of
               Maybe Type
Nothing -> SDoc
main_msg
               Just Type
ty -> SDoc -> Int -> SDoc -> SDoc
hang (SDoc
main_msg SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
':') Int
2 (Type -> SDoc
pprType Type
ty)
           , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(GHC does not yet support this)" ]
      where
        main_msg :: SDoc
main_msg =
          String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal visible, dependent quantification" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
          String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in the type of a term"
    TcRnBadQuantPredHead Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Quantified predicate must have a class or type variable head:")
              Int
2 (Type -> SDoc
pprType Type
ty)
    TcRnIllegalTupleConstraint Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal tuple constraint:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprType Type
ty
    TcRnNonTypeVarArgInConstraint Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Non type-variable argument")
              Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in the constraint:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprType Type
ty)
    TcRnIllegalImplicitParam Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal implicit parameter" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
pprType Type
ty)
    TcRnIllegalConstraintSynonymOfKind Type
kind
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal constraint synonym of kind:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
pprKind Type
kind)
    TcRnIllegalClassInst TyConFlavour
tcf
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal instance for a" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TyConFlavour -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyConFlavour
tcf
                , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"A class instance must be for a class" ]
    TcRnOversaturatedVisibleKindArg Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal oversaturated visible kind argument:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
           SDoc -> SDoc
quotes (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'@' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Type -> SDoc
pprParendType Type
ty)
    TcRnBadAssociatedType Name
clas Name
tc
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Class", SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
clas)
                , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not have an associated type", SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
tc) ]
    TcRnForAllRankErr Rank
rank Type
ty
      -> let herald :: SDoc
herald = case Type -> ([TcTyVar], Type)
tcSplitForAllTyVars Type
ty of
               ([], Type
_) -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal qualified type:"
               ([TcTyVar], Type)
_       -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal polymorphic type:"
             extra :: SDoc
extra = case Rank
rank of
               Rank
MonoTypeConstraint -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"A constraint must be a monotype"
               Rank
_                  -> SDoc
forall doc. IsOutput doc => doc
empty
         in SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [SDoc -> Int -> SDoc -> SDoc
hang SDoc
herald Int
2 (Type -> SDoc
pprType Type
ty), SDoc
extra]
    TcRnMonomorphicBindings [Name]
bindings
      -> let pp_bndrs :: SDoc
pp_bndrs = [Name] -> SDoc
pprBindings [Name]
bindings
         in SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
              [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The Monomorphism Restriction applies to the binding"
                  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Name] -> SDoc
forall a. [a] -> SDoc
plural [Name]
bindings
                  , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pp_bndrs ]
    TcRnOrphanInstance ClsInst
inst
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Orphan instance:"
                , ClsInst -> SDoc
pprInstanceHdr ClsInst
inst
                ]
    TcRnFunDepConflict UnitState
unit_state NonEmpty ClsInst
sorted
      -> let herald :: SDoc
herald = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Functional dependencies conflict between instance declarations:"
         in SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
              UnitState -> SDoc -> SDoc
pprWithUnitState UnitState
unit_state (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ (SDoc -> Int -> SDoc -> SDoc
hang SDoc
herald Int
2 ([ClsInst] -> SDoc
pprInstances ([ClsInst] -> SDoc) -> [ClsInst] -> SDoc
forall a b. (a -> b) -> a -> b
$ NonEmpty ClsInst -> [ClsInst]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty ClsInst
sorted))
    TcRnDupInstanceDecls UnitState
unit_state NonEmpty ClsInst
sorted
      -> let herald :: SDoc
herald = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Duplicate instance declarations:"
         in SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
              UnitState -> SDoc -> SDoc
pprWithUnitState UnitState
unit_state (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ (SDoc -> Int -> SDoc -> SDoc
hang SDoc
herald Int
2 ([ClsInst] -> SDoc
pprInstances ([ClsInst] -> SDoc) -> [ClsInst] -> SDoc
forall a b. (a -> b) -> a -> b
$ NonEmpty ClsInst -> [ClsInst]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty ClsInst
sorted))
    TcRnConflictingFamInstDecls NonEmpty FamInst
sortedNE
      -> let sorted :: [FamInst]
sorted = NonEmpty FamInst -> [FamInst]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty FamInst
sortedNE
         in SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
              SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Conflicting family instance declarations:")
                 Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ TyCon -> CoAxBranch -> SDoc
pprCoAxBranchUser (CoAxiom Unbranched -> TyCon
forall (br :: BranchFlag). CoAxiom br -> TyCon
coAxiomTyCon CoAxiom Unbranched
ax) (CoAxiom Unbranched -> CoAxBranch
coAxiomSingleBranch CoAxiom Unbranched
ax)
                         | FamInst
fi <- [FamInst]
sorted
                         , let ax :: CoAxiom Unbranched
ax = FamInst -> CoAxiom Unbranched
famInstAxiom FamInst
fi ])
    TcRnFamInstNotInjective InjectivityErrReason
rea TyCon
fam_tc (CoAxBranch
eqn1 NE.:| [CoAxBranch]
rest_eqns)
      -> let (SDoc
herald, Bool
show_kinds) = case InjectivityErrReason
rea of
               InjErrRhsBareTyVar [Type]
tys ->
                 (SDoc
injectivityErrorHerald SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
                  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RHS of injective type family equation is a bare" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type variable" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
                  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but these LHS type and kind patterns are not bare" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"variables:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Type] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList [Type]
tys, Bool
False)
               InjectivityErrReason
InjErrRhsCannotBeATypeFam ->
                 (SDoc
injectivityErrorHerald SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
                   String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RHS of injective type family equation cannot" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                   String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"be a type family:", Bool
False)
               InjectivityErrReason
InjErrRhsOverlap ->
                  (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Type family equation right-hand sides overlap; this violates" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
                   String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the family's injectivity annotation:", Bool
False)
               InjErrCannotInferFromRhs TyVarSet
tvs HasKinds
has_kinds SuggestUndecidableInstances
_ ->
                 let show_kinds :: Bool
show_kinds = HasKinds
has_kinds HasKinds -> HasKinds -> Bool
forall a. Eq a => a -> a -> Bool
== HasKinds
YesHasKinds
                     what :: SDoc
what = if Bool
show_kinds then String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Type/kind" else String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Type"
                     body :: SDoc
body = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
                                  TyVarSet -> SDoc
pluralVarSet TyVarSet
tvs SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TyVarSet -> ([TcTyVar] -> SDoc) -> SDoc
pprVarSet TyVarSet
tvs ([TcTyVar] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList ([TcTyVar] -> SDoc)
-> ([TcTyVar] -> [TcTyVar]) -> [TcTyVar] -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TcTyVar] -> [TcTyVar]
scopedSort)
                                , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"cannot be inferred from the right-hand side." ]
                     in (SDoc
injectivityErrorHerald SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc
body SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"In the type family equation:", Bool
show_kinds)

         in SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ Bool -> SDoc -> SDoc
pprWithExplicitKindsWhen Bool
show_kinds (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
              SDoc -> Int -> SDoc -> SDoc
hang SDoc
herald
                Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((CoAxBranch -> SDoc) -> [CoAxBranch] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (TyCon -> CoAxBranch -> SDoc
pprCoAxBranchUser TyCon
fam_tc) (CoAxBranch
eqn1 CoAxBranch -> [CoAxBranch] -> [CoAxBranch]
forall a. a -> [a] -> [a]
: [CoAxBranch]
rest_eqns)))
    TcRnBangOnUnliftedType Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Strictness flag has no effect on unlifted type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty)
    TcRnLazyBangOnUnliftedType Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Lazy flag has no effect on unlifted type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty)
    TcRnMultipleDefaultDeclarations [LDefaultDecl GhcRn]
dup_things
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Multiple default declarations")
              Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((GenLocated SrcSpanAnnA (DefaultDecl GhcRn) -> SDoc)
-> [GenLocated SrcSpanAnnA (DefaultDecl GhcRn)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map LDefaultDecl GhcRn -> SDoc
GenLocated SrcSpanAnnA (DefaultDecl GhcRn) -> SDoc
pp [LDefaultDecl GhcRn]
[GenLocated SrcSpanAnnA (DefaultDecl GhcRn)]
dup_things))
         where
           pp :: LDefaultDecl GhcRn -> SDoc
           pp :: LDefaultDecl GhcRn -> SDoc
pp (L SrcSpanAnnA
locn (DefaultDecl XCDefaultDecl GhcRn
_ [LHsType GhcRn]
_))
             = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"here was another default declaration" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
locn)
    TcRnBadDefaultType Type
ty [Class]
deflt_clss
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The default type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not an instance of")
              Int
2 ((SDoc -> SDoc -> SDoc) -> [SDoc] -> SDoc
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\SDoc
a SDoc
b -> SDoc
a SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"or" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
b) ((Class -> SDoc) -> [Class] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SDoc -> SDoc
quotes(SDoc -> SDoc) -> (Class -> SDoc) -> Class -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr) [Class]
deflt_clss))
    TcRnMessage
TcRnPatSynBundledWithNonDataCon
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Pattern synonyms can be bundled only with datatypes."
    TcRnPatSynBundledWithWrongType Type
expected_res_ty Type
res_ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Pattern synonyms can only be bundled with matching type constructors"
               SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Couldn't match expected type of"
               SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
expected_res_ty)
               SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"with actual type of"
               SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
res_ty)
    TcRnDupeModuleExport ModuleName
mod
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Duplicate"
                , SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod)
                , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in export list" ]
    TcRnExportedModNotImported ModuleName
mod
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated
       (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> String -> SDoc
formatExportItemError
           (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod)
           String
"is not imported"
    TcRnNullExportedModule ModuleName
mod
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated
       (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> String -> SDoc
formatExportItemError
           (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod)
           String
"exports nothing"
    TcRnMissingExportList ModuleName
mod
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated
       (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> String -> SDoc
formatExportItemError
           (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"module" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod)
           String
"is missing an export list"
    TcRnExportHiddenComponents IE GhcPs
export_item
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated
       (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> String -> SDoc
formatExportItemError
           (IE GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr IE GhcPs
export_item)
           String
"attempts to export constructors or class methods that are not visible here"
    TcRnDuplicateExport GreName
child IE GhcPs
ie1 IE GhcPs
ie2
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ SDoc -> SDoc
quotes (GreName -> SDoc
forall a. Outputable a => a -> SDoc
ppr GreName
child)
                , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is exported by", SDoc -> SDoc
quotes (IE GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr IE GhcPs
ie1)
                , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"and",            SDoc -> SDoc
quotes (IE GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr IE GhcPs
ie2) ]
    TcRnExportedParentChildMismatch Name
parent_name TyThing
ty_thing GreName
child [Name]
parent_names
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The type constructor" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
parent_name)
                 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not the parent of the" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
what_is
                 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
thing SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'.'
                 SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> String
capitalise String
what_is)
                    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"s can only be exported with their parent type constructor."
                 SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ (case [SDoc]
parents of
                       [] -> SDoc
forall doc. IsOutput doc => doc
empty
                       [SDoc
_] -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Parent:"
                       [SDoc]
_  -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Parents:") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep (SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma [SDoc]
parents)
      where
        pp_category :: TyThing -> String
        pp_category :: TyThing -> String
pp_category (AnId TcTyVar
i)
          | TcTyVar -> Bool
isRecordSelector TcTyVar
i = String
"record selector"
        pp_category TyThing
i = TyThing -> String
tyThingCategory TyThing
i
        what_is :: String
what_is = TyThing -> String
pp_category TyThing
ty_thing
        thing :: SDoc
thing = GreName -> SDoc
forall a. Outputable a => a -> SDoc
ppr GreName
child
        parents :: [SDoc]
parents = (Name -> SDoc) -> [Name] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Name]
parent_names
    TcRnConflictingExports OccName
occ GreName
child1 GlobalRdrElt
gre1 IE GhcPs
ie1 GreName
child2 GlobalRdrElt
gre2 IE GhcPs
ie2
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Conflicting exports for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon
                , GreName -> GlobalRdrElt -> IE GhcPs -> SDoc
forall {a}. Outputable a => GreName -> GlobalRdrElt -> a -> SDoc
ppr_export GreName
child1 GlobalRdrElt
gre1 IE GhcPs
ie1
                , GreName -> GlobalRdrElt -> IE GhcPs -> SDoc
forall {a}. Outputable a => GreName -> GlobalRdrElt -> a -> SDoc
ppr_export GreName
child2 GlobalRdrElt
gre2 IE GhcPs
ie2
                ]
      where
        ppr_export :: GreName -> GlobalRdrElt -> a -> SDoc
ppr_export GreName
child GlobalRdrElt
gre a
ie = Int -> SDoc -> SDoc
nest Int
3 (SDoc -> Int -> SDoc -> SDoc
hang (SDoc -> SDoc
quotes (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
ie) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"exports" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                                                SDoc -> SDoc
quotes (GreName -> SDoc
ppr_name GreName
child))
                                            Int
2 (GlobalRdrElt -> SDoc
pprNameProvenance GlobalRdrElt
gre))

        -- DuplicateRecordFields means that nameOccName might be a
        -- mangled $sel-prefixed thing, in which case show the correct OccName
        -- alone (but otherwise show the Name so it will have a module
        -- qualifier)
        ppr_name :: GreName -> SDoc
ppr_name (FieldGreName FieldLabel
fl) | FieldLabel -> Bool
flIsOverloaded FieldLabel
fl = FieldLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr FieldLabel
fl
                                   | Bool
otherwise         = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (FieldLabel -> Name
flSelector FieldLabel
fl)
        ppr_name (NormalGreName Name
name) = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name
    TcRnAmbiguousField HsExpr GhcRn
rupd TyCon
parent_type
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
          [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The record update" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
rupd
                   SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"with type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
parent_type
                   SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is ambiguous."
               , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"This will not be supported by -XDuplicateRecordFields in future releases of GHC."
               ]
    TcRnMissingFields ConLike
con [(FieldLabelString, Type)]
fields
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [SDoc
header, Int -> SDoc -> SDoc
nest Int
2 SDoc
rest]
         where
           rest :: SDoc
rest | [(FieldLabelString, Type)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FieldLabelString, Type)]
fields = SDoc
forall doc. IsOutput doc => doc
empty
                | Bool
otherwise   = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (((FieldLabelString, Type) -> SDoc)
-> [(FieldLabelString, Type)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FieldLabelString, Type) -> SDoc
pprField [(FieldLabelString, Type)]
fields)
           header :: SDoc
header = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Fields of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (ConLike -> SDoc
forall a. Outputable a => a -> SDoc
ppr ConLike
con) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"not initialised" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
                    if [(FieldLabelString, Type)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FieldLabelString, Type)]
fields then SDoc
forall doc. IsOutput doc => doc
empty else SDoc
forall doc. IsLine doc => doc
colon
    TcRnFieldUpdateInvalidType [(FieldLabelString, Type)]
prs
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Record update for insufficiently polymorphic field"
                   SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [(FieldLabelString, Type)] -> SDoc
forall a. [a] -> SDoc
plural [(FieldLabelString, Type)]
prs SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon)
              Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ FieldLabelString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FieldLabelString
f SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty | (FieldLabelString
f,Type
ty) <- [(FieldLabelString, Type)]
prs ])
    TcRnNoConstructorHasAllFields [FieldLabelString]
conflictingFields
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"No constructor has all these fields:")
              Int
2 ([FieldLabelString] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList [FieldLabelString]
conflictingFields)
    TcRnMixedSelectors Name
data_name [TcTyVar]
data_sels Name
pat_name [TcTyVar]
pat_syn_sels
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cannot use a mixture of pattern synonym and record selectors" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Record selectors defined by"
             SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
data_name)
             SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon
             SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (TcTyVar -> SDoc) -> [TcTyVar] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr [TcTyVar]
data_sels SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Pattern synonym selectors defined by"
             SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
pat_name)
             SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon
             SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (TcTyVar -> SDoc) -> [TcTyVar] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr [TcTyVar]
pat_syn_sels
    TcRnMissingStrictFields ConLike
con [(FieldLabelString, Type)]
fields
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [SDoc
header, Int -> SDoc -> SDoc
nest Int
2 SDoc
rest]
         where
           rest :: SDoc
rest | [(FieldLabelString, Type)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FieldLabelString, Type)]
fields = SDoc
forall doc. IsOutput doc => doc
empty  -- Happens for non-record constructors
                                       -- with strict fields
                | Bool
otherwise   = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (((FieldLabelString, Type) -> SDoc)
-> [(FieldLabelString, Type)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FieldLabelString, Type) -> SDoc
pprField [(FieldLabelString, Type)]
fields)

           header :: SDoc
header = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Constructor" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (ConLike -> SDoc
forall a. Outputable a => a -> SDoc
ppr ConLike
con) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not have the required strict field(s)" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
                    if [(FieldLabelString, Type)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FieldLabelString, Type)]
fields then SDoc
forall doc. IsOutput doc => doc
empty else SDoc
forall doc. IsLine doc => doc
colon
    TcRnNoPossibleParentForFields [LHsRecUpdField GhcRn]
rbinds
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"No type has all these fields:")
              Int
2 ([GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn)] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList [GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn)]
fields)
         where fields :: [GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn)]
fields = (GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
      (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
 -> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
         (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> [GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map (HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
  (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn)
forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbLHS (HsFieldBind
   (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
   (GenLocated SrcSpanAnnA (HsExpr GhcRn))
 -> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
-> (GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
         (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
         (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
        (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
     (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
     (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall l e. GenLocated l e -> e
unLoc) [LHsRecUpdField GhcRn]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcRn))
      (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
rbinds
    TcRnBadOverloadedRecordUpdate [LHsRecUpdField GhcRn]
_rbinds
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Record update is ambiguous, and requires a type signature"
    TcRnStaticFormNotClosed Name
name NotClosedReason
reason
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
             SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is used in a static form but it is not closed"
             SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"because it"
             SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep (NotClosedReason -> [SDoc]
causes NotClosedReason
reason)
         where
          causes :: NotClosedReason -> [SDoc]
          causes :: NotClosedReason -> [SDoc]
causes NotClosedReason
NotLetBoundReason = [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not let-bound."]
          causes (NotTypeClosed TyVarSet
vs) =
            [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has a non-closed type because it contains the"
            , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type variables:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
              TyVarSet -> ([TcTyVar] -> SDoc) -> SDoc
pprVarSet TyVarSet
vs ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep ([SDoc] -> SDoc) -> ([TcTyVar] -> [SDoc]) -> [TcTyVar] -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma ([SDoc] -> [SDoc]) -> ([TcTyVar] -> [SDoc]) -> [TcTyVar] -> [SDoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TcTyVar -> SDoc) -> [TcTyVar] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SDoc -> SDoc
quotes (SDoc -> SDoc) -> (TcTyVar -> SDoc) -> TcTyVar -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr))
            ]
          causes (NotClosed Name
n NotClosedReason
reason) =
            let msg :: SDoc
msg = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"uses" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"which"
             in case NotClosedReason
reason of
                  NotClosed Name
_ NotClosedReason
_ -> SDoc
msg SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: NotClosedReason -> [SDoc]
causes NotClosedReason
reason
                  NotClosedReason
_   -> let ([SDoc]
xs0, [SDoc]
xs1) = Int -> [SDoc] -> ([SDoc], [SDoc])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 ([SDoc] -> ([SDoc], [SDoc])) -> [SDoc] -> ([SDoc], [SDoc])
forall a b. (a -> b) -> a -> b
$ NotClosedReason -> [SDoc]
causes NotClosedReason
reason
                          in (SDoc -> SDoc) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SDoc
msg SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>) [SDoc]
xs0 [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [SDoc]
xs1
    TcRnMessage
TcRnUselessTypeable
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Deriving" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
typeableClassName) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has no effect: all types now auto-derive Typeable"
    TcRnDerivingDefaults Class
cls
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep
                     [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Both DeriveAnyClass and"
                       SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"GeneralizedNewtypeDeriving are enabled"
                     , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Defaulting to the DeriveAnyClass strategy"
                       SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"for instantiating" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
cls
                     ]
    TcRnNonUnaryTypeclassConstraint LHsSigType GhcRn
ct
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> SDoc
quotes (GenLocated SrcSpanAnnA (HsSigType GhcRn) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsSigType GhcRn
GenLocated SrcSpanAnnA (HsSigType GhcRn)
ct)
           SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not a unary constraint, as expected by a deriving clause"
    TcRnPartialTypeSignatures SuggestPartialTypeSignatures
_ [Type]
theta
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Found type wildcard" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'_')
                       SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"standing for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes ([Type] -> SDoc
pprTheta [Type]
theta)
    TcRnCannotDeriveInstance Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving DeriveInstanceErrReason
reason
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> DeriveInstanceErrReason
-> SDoc
derivErrDiagnosticMessage Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
True DeriveInstanceErrReason
reason
    TcRnMessage
TcRnLazyGADTPattern
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"An existential or GADT data constructor cannot be used")
              Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"inside a lazy (~) pattern")
    TcRnMessage
TcRnArrowProcGADTPattern
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Proc patterns cannot use existential or GADT data constructors"

    TcRnSpecialClassInst Class
cls Bool
because_safeHaskell
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Class" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SDoc) -> Name -> SDoc
forall a b. (a -> b) -> a -> b
$ Class -> Name
className Class
cls)
                   SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not support user-specified instances"
                   SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
safeHaskell_msg
          where
            safeHaskell_msg :: SDoc
safeHaskell_msg
              | Bool
because_safeHaskell
              = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
" when Safe Haskell is enabled."
              | Bool
otherwise
              = SDoc
forall doc. IsLine doc => doc
dot
    TcRnForallIdentifier RdrName
rdr_name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The use of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name)
                                     SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"as an identifier",
                   String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"will become an error in a future GHC release." ]
    TcRnMessage
TcRnTypeEqualityOutOfScope
      -> [SDoc] -> DecoratedSDoc
mkDecorated
           [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"~") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"operator is out of scope." SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
             String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Assuming it to stand for an equality constraint."
           , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NB:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"~") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"used to be built-in syntax but now is a regular type operator" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
                             String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"exported from Data.Type.Equality and Prelude.") SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
             String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"If you are using a custom Prelude, consider re-exporting it."
           , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"This will become an error in a future GHC release." ]
    TcRnMessage
TcRnTypeEqualityRequiresOperators
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The use of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"~")
                                     SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"without TypeOperators",
                   String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"will become an error in a future GHC release." ]
    TcRnIllegalTypeOperator SDoc
overall_ty RdrName
op
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal operator" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
op) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (SDoc -> SDoc
forall a. Outputable a => a -> SDoc
ppr SDoc
overall_ty)
    TcRnIllegalTypeOperatorDecl RdrName
name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal declaration of a type or class operator" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
name)
    TcRnMessage
TcRnGADTMonoLocalBinds
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Pattern matching on GADTs without MonoLocalBinds"
                 , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is fragile." ]
    TcRnIncorrectNameSpace Name
name Bool
_
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc
msg
        where
          msg :: SDoc
msg
            -- We are in a type-level namespace,
            -- and the name is incorrectly at the term-level.
            | NameSpace -> Bool
isValNameSpace NameSpace
ns
            = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not live in the type-level namespace"

            -- We are in a term-level namespace,
            -- and the name is incorrectly at the type-level.
            | Bool
otherwise
            = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal term-level use of the" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what
          ns :: NameSpace
ns = Name -> NameSpace
nameNameSpace Name
name
          what :: SDoc
what = NameSpace -> SDoc
pprNameSpace NameSpace
ns SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
    TcRnNotInScope NotInScopeError
err RdrName
name [ImportError]
imp_errs [GhcHint]
_
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           RdrName -> NotInScopeError -> SDoc
pprScopeError RdrName
name NotInScopeError
err SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((ImportError -> SDoc) -> [ImportError] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ImportError -> SDoc
forall a. Outputable a => a -> SDoc
ppr [ImportError]
imp_errs)
    TcRnUntickedPromotedThing UntickedPromotedThing
thing
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unticked promoted" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what
           where
             what :: SDoc
             what :: SDoc
what = case UntickedPromotedThing
thing of
               UntickedPromotedThing
UntickedExplicitList -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"list" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot
               UntickedConstructor LexicalFixity
fixity Name
nm ->
                 let con :: SDoc
con      = LexicalFixity -> Name -> SDoc
pprUntickedConstructor LexicalFixity
fixity Name
nm
                     bare_sym :: Bool
bare_sym = LexicalFixity -> Name -> Bool
isBareSymbol LexicalFixity
fixity Name
nm
                 in String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"constructor:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
con SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> if Bool
bare_sym then SDoc
forall doc. IsOutput doc => doc
empty else SDoc
forall doc. IsLine doc => doc
dot
    TcRnIllegalBuiltinSyntax SDoc
what RdrName
rdr_name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal", SDoc
what, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"of built-in syntax:", RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name]
    TcRnWarnDefaulting [Ct]
tidy_wanteds Maybe TcTyVar
tidy_tv Type
default_ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Defaulting" ]
                     [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++
                     (case Maybe TcTyVar
tidy_tv of
                         Maybe TcTyVar
Nothing -> []
                         Just TcTyVar
tv -> [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the type variable"
                                    , SDoc -> SDoc
quotes (TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcTyVar
tv)])
                     [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++
                     [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"to type"
                     , SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
default_ty)
                     , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in the following constraint" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Ct] -> SDoc
forall a. [a] -> SDoc
plural [Ct]
tidy_wanteds ])
             Int
2
             ([Ct] -> SDoc
pprWithArising [Ct]
tidy_wanteds)


    TcRnForeignImportPrimExtNotSet ForeignImport GhcRn
_decl
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"`foreign import prim' requires GHCForeignImportPrim."

    TcRnForeignImportPrimSafeAnn ForeignImport GhcRn
_decl
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The safe/unsafe annotation should not be used with `foreign import prim'."

    TcRnForeignFunctionImportAsValue ForeignImport GhcRn
_decl
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"`value' imports cannot have function types"

    TcRnFunPtrImportWithoutAmpersand ForeignImport GhcRn
_decl
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"possible missing & in foreign import of FunPtr"

    TcRnIllegalForeignDeclBackend Either (ForeignExport GhcRn) (ForeignImport GhcRn)
_decl Backend
_backend ExpectedBackends
expectedBknds
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal foreign declaration: requires one of these back ends:" SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
:
               SDoc -> [SDoc] -> [SDoc]
commafyWith (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"or") ((Backend -> SDoc) -> ExpectedBackends -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc) -> (Backend -> String) -> Backend -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Backend -> String
backendDescription) ExpectedBackends
expectedBknds))

    TcRnUnsupportedCallConv Either (ForeignExport GhcRn) (ForeignImport GhcRn)
_decl UnsupportedCallConvention
unsupportedCC
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           case UnsupportedCallConvention
unsupportedCC of
             UnsupportedCallConvention
StdCallConvUnsupported ->
               String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the 'stdcall' calling convention is unsupported on this platform,"
               SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"treating as ccall"
             UnsupportedCallConvention
PrimCallConvUnsupported ->
               String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The `prim' calling convention can only be used with `foreign import'"
             UnsupportedCallConvention
JavaScriptCallConvUnsupported ->
               String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The `javascript' calling convention is unsupported on this platform"

    TcRnIllegalForeignType Maybe ArgOrResult
mArgOrResult IllegalForeignTypeReason
reason
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> Int -> SDoc -> SDoc
hang SDoc
msg Int
2 SDoc
extra
      where
        arg_or_res :: SDoc
arg_or_res = case Maybe ArgOrResult
mArgOrResult of
          Maybe ArgOrResult
Nothing -> SDoc
forall doc. IsOutput doc => doc
empty
          Just ArgOrResult
Arg -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"argument"
          Just ArgOrResult
Result -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"result"
        msg :: SDoc
msg = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unacceptable", SDoc
arg_or_res
                   , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type in foreign declaration:"]
        extra :: SDoc
extra =
          case IllegalForeignTypeReason
reason of
            TypeCannotBeMarshaled Type
ty TypeCannotBeMarshaledReason
why ->
              let innerMsg :: SDoc
innerMsg = SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"cannot be marshalled in a foreign call"
               in case TypeCannotBeMarshaledReason
why of
                TypeCannotBeMarshaledReason
NotADataType ->
                  SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not a data type"
                NewtypeDataConNotInScope Maybe TyCon
Nothing ->
                  SDoc -> Int -> SDoc -> SDoc
hang SDoc
innerMsg Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"because its data constructor is not in scope"
                NewtypeDataConNotInScope (Just TyCon
tc) ->
                  SDoc -> Int -> SDoc -> SDoc
hang SDoc
innerMsg Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"because the data constructor for"
                    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not in scope"
                TypeCannotBeMarshaledReason
UnliftedFFITypesNeeded ->
                  SDoc
innerMsg SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"UnliftedFFITypes is required to marshal unlifted types"
                TypeCannotBeMarshaledReason
NotABoxedMarshalableTyCon -> SDoc
innerMsg
                TypeCannotBeMarshaledReason
ForeignLabelNotAPtr ->
                  SDoc
innerMsg SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"A foreign-imported address (via &foo) must have type (Ptr a) or (FunPtr a)"
                TypeCannotBeMarshaledReason
NotSimpleUnliftedType ->
                  SDoc
innerMsg SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"foreign import prim only accepts simple unlifted types"
                TypeCannotBeMarshaledReason
NotBoxedKindAny ->
                  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Expected kind" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Type") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"or" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"UnliftedType") SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
                  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has kind" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((() :: Constraint) => Type -> Type
Type -> Type
typeKind Type
ty))
            ForeignDynNotPtr Type
expected Type
ty ->
              [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Expected: Ptr/FunPtr" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprParendType Type
expected SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"  Actual:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty ]
            IllegalForeignTypeReason
SafeHaskellMustBeInIO ->
              String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Safe Haskell is on, all FFI imports must be in the IO monad"
            IllegalForeignTypeReason
IOResultExpected ->
              String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"IO result type expected"
            IllegalForeignTypeReason
UnexpectedNestedForall ->
              String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unexpected nested forall"
            IllegalForeignTypeReason
LinearTypesNotAllowed ->
              String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Linear types are not supported in FFI declarations, see #18472"
            IllegalForeignTypeReason
OneArgExpected ->
              String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"One argument expected"
            IllegalForeignTypeReason
AtLeastOneArgExpected ->
              String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"At least one argument expected"
    TcRnInvalidCIdentifier CLabelString
target
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [SDoc -> SDoc
quotes (CLabelString -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabelString
target) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not a valid C identifier"]
    TcRnExpectedValueId TcTyThing
thing
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           TcTyThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcTyThing
thing SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"used where a value identifier was expected"
    TcRnNotARecordSelector Name
field
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
field), String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not a record selector"]
    TcRnRecSelectorEscapedTyVar OccName
lbl
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cannot use record selector" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
lbl) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"as a function due to escaped type variables"
    TcRnPatSynNotBidirectional Name
name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"non-bidirectional pattern synonym"
           SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"used in an expression"
    TcRnSplicePolymorphicLocalVar TcTyVar
ident
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Can't splice the polymorphic local variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcTyVar
ident)
    TcRnIllegalDerivingItem LHsSigType GhcRn
hs_ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal deriving item" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (GenLocated SrcSpanAnnA (HsSigType GhcRn) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsSigType GhcRn
GenLocated SrcSpanAnnA (HsSigType GhcRn)
hs_ty)
    TcRnUnexpectedAnnotation HsType GhcRn
ty HsSrcBang
bang
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           let err :: String
err = case HsSrcBang
bang of
                 HsSrcBang SourceText
_ SrcUnpackedness
SrcUnpack SrcStrictness
_           -> String
"UNPACK"
                 HsSrcBang SourceText
_ SrcUnpackedness
SrcNoUnpack SrcStrictness
_         -> String
"NOUNPACK"
                 HsSrcBang SourceText
_ SrcUnpackedness
NoSrcUnpack SrcStrictness
SrcLazy   -> String
"laziness"
                 HsSrcBang SourceText
_ SrcUnpackedness
_ SrcStrictness
_                   -> String
"strictness"
            in String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unexpected" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
err SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"annotation:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsType GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsType GhcRn
ty SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
               String -> SDoc
forall doc. IsLine doc => String -> doc
text String
err SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"annotation cannot appear nested inside a type"
    TcRnIllegalRecordSyntax HsType GhcRn
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Record syntax is illegal here:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsType GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsType GhcRn
ty
    TcRnUnexpectedTypeSplice HsType GhcRn
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unexpected type splice:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsType GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsType GhcRn
ty
    TcRnInvalidVisibleKindArgument LHsType GhcRn
arg Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cannot apply function of kind" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty)
             SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"to visible kind argument" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (GenLocated SrcSpanAnnA (HsType GhcRn) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsType GhcRn
GenLocated SrcSpanAnnA (HsType GhcRn)
arg)
    TcRnTooManyBinders Type
ki [LHsTyVarBndr () GhcRn]
bndrs
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Not a function kind:")
              Int
4 (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ki) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
           SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but extra binders found:")
              Int
4 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep ((GenLocated SrcSpanAnnA (HsTyVarBndr () GhcRn) -> SDoc)
-> [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcRn)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (HsTyVarBndr () GhcRn) -> SDoc
forall a. Outputable a => a -> SDoc
ppr [LHsTyVarBndr () GhcRn]
[GenLocated SrcSpanAnnA (HsTyVarBndr () GhcRn)]
bndrs))
    TcRnDifferentNamesForTyVar Name
n1 Name
n2
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Different names for the same type variable:") Int
2 SDoc
info
         where
           info :: SDoc
info | Name -> OccName
nameOccName Name
n1 OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
/= Name -> OccName
nameOccName Name
n2
                = SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n1) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"and" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n2)
                | Bool
otherwise -- Same OccNames! See C2 in
                            -- Note [Swizzling the tyvars before generaliseTcTyCon]
                = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n1) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcLoc -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SrcLoc
forall a. NamedThing a => a -> SrcLoc
getSrcLoc Name
n1)
                       , SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n2) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcLoc -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SrcLoc
forall a. NamedThing a => a -> SrcLoc
getSrcLoc Name
n2) ]
    TcRnInvalidReturnKind DataSort
data_sort AllowedDataResKind
allowed_kind Type
kind Maybe SuggestUnliftedTypes
_suggested_ext
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ DataSort -> SDoc
ppDataSort DataSort
data_sort SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                 String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has non-" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
                 SDoc
allowed_kind_tycon
               , (if Bool
is_data_family then String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"and non-variable" else SDoc
forall doc. IsOutput doc => doc
empty) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                 String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"return kind" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
kind)
               ]
         where
          is_data_family :: Bool
is_data_family =
            case DataSort
data_sort of
              DataDeclSort{}     -> Bool
False
              DataInstanceSort{} -> Bool
False
              DataSort
DataFamilySort     -> Bool
True
          allowed_kind_tycon :: SDoc
allowed_kind_tycon =
            case AllowedDataResKind
allowed_kind of
              AllowedDataResKind
AnyTYPEKind  -> TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tYPETyCon
              AllowedDataResKind
AnyBoxedKind -> TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
boxedRepDataConTyCon
              AllowedDataResKind
LiftedKind   -> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
liftedTypeKind
    TcRnClassKindNotConstraint Type
_kind
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Kind signature on a class must end with" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
constraintKind SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"unobscured by type families"
    TcRnUnpromotableThing Name
name PromotionErr
err
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           (SDoc -> Int -> SDoc -> SDoc
hang (PromotionErr -> SDoc
pprPECategory PromotionErr
err SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"cannot be used here")
                        Int
2 (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens SDoc
reason))
        where
          reason :: SDoc
reason = case PromotionErr
err of
                     ConstrainedDataConPE Type
pred
                                    -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"it has an unpromotable context"
                                       SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
pred)
                     PromotionErr
FamDataConPE   -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"it comes from a data family instance"
                     PromotionErr
NoDataKindsDC  -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"perhaps you intended to use DataKinds"
                     PromotionErr
PatSynPE       -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"pattern synonyms cannot be promoted"
                     PromotionErr
RecDataConPE   -> SDoc
same_rec_group_msg
                     PromotionErr
ClassPE        -> SDoc
same_rec_group_msg
                     PromotionErr
TyConPE        -> SDoc
same_rec_group_msg
                     PromotionErr
TermVariablePE -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"term variables cannot be promoted"
          same_rec_group_msg :: SDoc
same_rec_group_msg = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"it is defined and used in the same recursive group"
    TcRnMatchesHaveDiffNumArgs HsMatchContext GhcTc
argsContext (MatchArgMatches LocatedA (Match GhcRn body)
match1 NonEmpty (LocatedA (Match GhcRn body))
bad_matches)
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ HsMatchContext GhcTc -> SDoc
forall p.
(Outputable (IdP (NoGhcTc p)), UnXRec (NoGhcTc p)) =>
HsMatchContext p -> SDoc
pprMatchContextNouns HsMatchContext GhcTc
argsContext SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                   String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"have different numbers of arguments"
                 , Int -> SDoc -> SDoc
nest Int
2 (SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (LocatedA (Match GhcRn body) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedA (Match GhcRn body)
match1))
                 , Int -> SDoc -> SDoc
nest Int
2 (SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (LocatedA (Match GhcRn body) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (NonEmpty (LocatedA (Match GhcRn body))
-> LocatedA (Match GhcRn body)
forall a. NonEmpty a -> a
NE.head NonEmpty (LocatedA (Match GhcRn body))
bad_matches)))])
    TcRnCannotBindScopedTyVarInPatSig NonEmpty (Name, TcTyVar)
sig_tvs
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"You cannot bind scoped type variable"
                  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [(Name, TcTyVar)] -> SDoc
forall a. [a] -> SDoc
plural (NonEmpty (Name, TcTyVar) -> [(Name, TcTyVar)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Name, TcTyVar)
sig_tvs)
                 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Name] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList (((Name, TcTyVar) -> Name) -> [(Name, TcTyVar)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, TcTyVar) -> Name
forall a b. (a, b) -> a
fst ([(Name, TcTyVar)] -> [Name]) -> [(Name, TcTyVar)] -> [Name]
forall a b. (a -> b) -> a -> b
$ NonEmpty (Name, TcTyVar) -> [(Name, TcTyVar)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Name, TcTyVar)
sig_tvs))
              Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in a pattern binding signature")
    TcRnCannotBindTyVarsInPatBind NonEmpty (Name, TcTyVar)
_offenders
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Binding type variables is not allowed in pattern bindings"
    TcRnTooManyTyArgsInConPattern ConLike
con_like Int
expected_number Int
actual_number
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Too many type arguments in constructor pattern for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (ConLike -> SDoc
forall a. Outputable a => a -> SDoc
ppr ConLike
con_like) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Expected no more than" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
expected_number SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
semi SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"got" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
actual_number
    TcRnMultipleInlinePragmas TcTyVar
poly_id LocatedA InlinePragma
fst_inl_prag NonEmpty (LocatedA InlinePragma)
inl_prags
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Multiple INLINE pragmas for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcTyVar
poly_id)
             Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Ignoring all but the first"
                      SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: (LocatedA InlinePragma -> SDoc)
-> [LocatedA InlinePragma] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map LocatedA InlinePragma -> SDoc
forall {a} {a}.
(Outputable a, Outputable a) =>
GenLocated a a -> SDoc
pp_inl (LocatedA InlinePragma
fst_inl_prag LocatedA InlinePragma
-> [LocatedA InlinePragma] -> [LocatedA InlinePragma]
forall a. a -> [a] -> [a]
: NonEmpty (LocatedA InlinePragma) -> [LocatedA InlinePragma]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LocatedA InlinePragma)
inl_prags)))
         where
           pp_inl :: GenLocated a a -> SDoc
pp_inl (L a
loc a
prag) = a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
prag SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
loc)
    TcRnUnexpectedPragmas TcTyVar
poly_id NonEmpty (LSig GhcRn)
bad_sigs
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Discarding unexpected pragmas for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcTyVar
poly_id)
              Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((GenLocated SrcSpanAnnA (Sig GhcRn) -> SDoc)
-> [GenLocated SrcSpanAnnA (Sig GhcRn)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpanAnnA -> SDoc
forall a. Outputable a => a -> SDoc
ppr (SrcSpanAnnA -> SDoc)
-> (GenLocated SrcSpanAnnA (Sig GhcRn) -> SrcSpanAnnA)
-> GenLocated SrcSpanAnnA (Sig GhcRn)
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (Sig GhcRn) -> SrcSpanAnnA
forall l e. GenLocated l e -> l
getLoc) ([GenLocated SrcSpanAnnA (Sig GhcRn)] -> [SDoc])
-> [GenLocated SrcSpanAnnA (Sig GhcRn)] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ NonEmpty (GenLocated SrcSpanAnnA (Sig GhcRn))
-> [GenLocated SrcSpanAnnA (Sig GhcRn)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LSig GhcRn)
NonEmpty (GenLocated SrcSpanAnnA (Sig GhcRn))
bad_sigs))
    TcRnNonOverloadedSpecialisePragma LIdP GhcRn
fun_name
       -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
            String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"SPECIALISE pragma for non-overloaded function"
              SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (LocatedN Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr LIdP GhcRn
LocatedN Name
fun_name)
    TcRnSpecialiseNotVisible Name
name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"You cannot SPECIALISE" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
           SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"because its definition is not visible in this module"
    TcRnNameByTemplateHaskellQuote RdrName
name -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cannot redefine a Name retrieved by a Template Haskell quote:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
name
    TcRnIllegalBindingOfBuiltIn OccName
name -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
       String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal binding of built-in syntax:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
name
    TcRnPragmaWarning {OccName
pragma_warning_occ :: OccName
pragma_warning_occ :: TcRnMessage -> OccName
pragma_warning_occ, WarningTxt GhcRn
pragma_warning_msg :: WarningTxt GhcRn
pragma_warning_msg :: TcRnMessage -> WarningTxt GhcRn
pragma_warning_msg, ModuleName
pragma_warning_import_mod :: ModuleName
pragma_warning_import_mod :: TcRnMessage -> ModuleName
pragma_warning_import_mod, ModuleName
pragma_warning_defined_mod :: ModuleName
pragma_warning_defined_mod :: TcRnMessage -> ModuleName
pragma_warning_defined_mod}
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"In the use of"
                SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> NameSpace -> SDoc
pprNonVarNameSpace (OccName -> NameSpace
occNameSpace OccName
pragma_warning_occ)
                SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
pragma_warning_occ)
                , SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens SDoc
impMsg SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon ]
          , WarningTxt GhcRn -> SDoc
forall p. WarningTxt p -> SDoc
pprWarningTxtForMsg WarningTxt GhcRn
pragma_warning_msg ]
          where
            impMsg :: SDoc
impMsg  = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"imported from" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
pragma_warning_import_mod SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
extra
            extra :: SDoc
extra | ModuleName
pragma_warning_import_mod ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName
pragma_warning_defined_mod = SDoc
forall doc. IsOutput doc => doc
empty
                  | Bool
otherwise = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
", but defined in" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
pragma_warning_defined_mod
    TcRnIllegalHsigDefaultMethods Name
name NonEmpty (LHsBind GhcRn)
meths
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal default method" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [GenLocated SrcSpanAnnA (HsBind GhcRn)] -> SDoc
forall a. [a] -> SDoc
plural (NonEmpty (GenLocated SrcSpanAnnA (HsBind GhcRn))
-> [GenLocated SrcSpanAnnA (HsBind GhcRn)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LHsBind GhcRn)
NonEmpty (GenLocated SrcSpanAnnA (HsBind GhcRn))
meths) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in class definition of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in hsig file"
    TcRnBadGenericMethod Name
clas Name
op
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Class", SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
clas),
          String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has a generic-default signature without a binding", SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
op)]
    TcRnWarningMinimalDefIncomplete ClassMinimalDef
mindef
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The MINIMAL pragma does not require:"
          , Int -> SDoc -> SDoc
nest Int
2 (ClassMinimalDef -> SDoc
forall a. Outputable a => BooleanFormula a -> SDoc
pprBooleanFormulaNice ClassMinimalDef
mindef)
          , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but there is no default implementation." ]
    TcRnDefaultMethodForPragmaLacksBinding TcTyVar
sel_id Sig GhcRn
prag
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Sig GhcRn -> SDoc
forall (p :: Pass). IsPass p => Sig (GhcPass p) -> SDoc
hsSigDoc Sig GhcRn
prag SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"for default method"
          SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcTyVar
sel_id)
          SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"lacks an accompanying binding"
    TcRnIgnoreSpecialisePragmaOnDefMethod Name
sel_name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Ignoring SPECIALISE pragmas on default method"
          SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
sel_name)
    TcRnBadMethodErr{Name
badMethodErrClassName :: Name
badMethodErrClassName :: TcRnMessage -> Name
badMethodErrClassName, Name
badMethodErrMethodName :: Name
badMethodErrMethodName :: TcRnMessage -> Name
badMethodErrMethodName}
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Class", SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
badMethodErrClassName),
          String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not have a method", SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
badMethodErrMethodName)]
    TcRnNoExplicitAssocTypeOrDefaultDeclaration Name
name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"No explicit" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"associated type"
          SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"or default declaration for"
          SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
    TcRnMessage
TcRnIllegalTypeData
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal type-level data declaration"
    TcRnTypeDataForbids TypeDataForbids
feature
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        TypeDataForbids -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypeDataForbids
feature SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"are not allowed in type data declarations."

    TcRnIllegalNewtype DataCon
con Bool
show_linear_types IllegalNewtypeReason
reason
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [SDoc
msg, SDoc
additional]
        where
          (SDoc
msg,SDoc
additional) =
            case IllegalNewtypeReason
reason of
              DoesNotHaveSingleField Int
n_flds ->
                ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [
                  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"A newtype constructor must have exactly one field",
                  Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
speakN Int
n_flds
                ],
                DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Bool -> DataCon -> Type
dataConDisplayType Bool
show_linear_types DataCon
con))
              IllegalNewtypeReason
IsNonLinear ->
                (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"A newtype constructor must be linear",
                DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Bool -> DataCon -> Type
dataConDisplayType Bool
True DataCon
con))
              IllegalNewtypeReason
IsGADT ->
                (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"A newtype must not be a GADT",
                DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Bool -> SDoc -> SDoc
pprWithExplicitKindsWhen Bool
sneaky_eq_spec
                                       (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Type -> SDoc) -> Type -> SDoc
forall a b. (a -> b) -> a -> b
$ Bool -> DataCon -> Type
dataConDisplayType Bool
show_linear_types DataCon
con))
              IllegalNewtypeReason
HasConstructorContext ->
                (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"A newtype constructor must not have a context in its type",
                DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Bool -> DataCon -> Type
dataConDisplayType Bool
show_linear_types DataCon
con))
              IllegalNewtypeReason
HasExistentialTyVar ->
                (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"A newtype constructor must not have existential type variables",
                DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Bool -> DataCon -> Type
dataConDisplayType Bool
show_linear_types DataCon
con))
              IllegalNewtypeReason
HasStrictnessAnnotation ->
                (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"A newtype constructor must not have a strictness annotation", SDoc
forall doc. IsOutput doc => doc
empty)

          -- Is the data con a "covert" GADT?  See Note [isCovertGadtDataCon]
          -- in GHC.Core.DataCon
          sneaky_eq_spec :: Bool
sneaky_eq_spec = DataCon -> Bool
isCovertGadtDataCon DataCon
con

    TcRnTypedTHWithPolyType Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal polytype:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty
             , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The type of a Typed Template Haskell expression must" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
               String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"not have any quantification." ]
    TcRnSpliceThrewException SplicePhase
phase SomeException
_exn String
exn_msg LHsExpr GhcTc
expr Bool
show_code
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
           [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Exception when trying to" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
phaseStr SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"compile-time code:"
                , Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
exn_msg)
                , if Bool
show_code then String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Code:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GenLocated SrcSpanAnnA (HsExpr GhcTc) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsExpr GhcTc
GenLocated SrcSpanAnnA (HsExpr GhcTc)
expr else SDoc
forall doc. IsOutput doc => doc
empty]
         where phaseStr :: String
phaseStr =
                 case SplicePhase
phase of
                   SplicePhase
SplicePhase_Run -> String
"run"
                   SplicePhase
SplicePhase_CompileAndLink -> String
"compile and link"
    TcRnInvalidTopDecl HsDecl GhcPs
_decl
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Only function, value, annotation, and foreign import declarations may be added with addTopDecls"
    TcRnNonExactName RdrName
name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The binder" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not a NameU.")
            Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Probable cause: you used mkName instead of newName to generate a binding.")
    TcRnAddInvalidCorePlugin String
plugin
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         SDoc -> Int -> SDoc -> SDoc
hang
           (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"addCorePlugin: invalid plugin module "
              SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> String
forall a. Show a => a -> String
show String
plugin)
           )
           Int
2
           (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Plugins in the current package can't be specified.")
    TcRnAddDocToNonLocalDefn DocLoc
doc_loc
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Can't add documentation to" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> DocLoc -> SDoc
forall {doc}. IsLine doc => DocLoc -> doc
ppr_loc DocLoc
doc_loc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
         String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"as it isn't inside the current module"
      where
        ppr_loc :: DocLoc -> doc
ppr_loc (TH.DeclDoc Name
n) = String -> doc
forall doc. IsLine doc => String -> doc
text (String -> doc) -> String -> doc
forall a b. (a -> b) -> a -> b
$ Name -> String
forall a. Ppr a => a -> String
TH.pprint Name
n
        ppr_loc (TH.ArgDoc Name
n Int
_) = String -> doc
forall doc. IsLine doc => String -> doc
text (String -> doc) -> String -> doc
forall a b. (a -> b) -> a -> b
$ Name -> String
forall a. Ppr a => a -> String
TH.pprint Name
n
        ppr_loc (TH.InstDoc Type
t) = String -> doc
forall doc. IsLine doc => String -> doc
text (String -> doc) -> String -> doc
forall a b. (a -> b) -> a -> b
$ Type -> String
forall a. Ppr a => a -> String
TH.pprint Type
t
        ppr_loc DocLoc
TH.ModuleDoc = String -> doc
forall doc. IsLine doc => String -> doc
text String
"the module header"

    TcRnFailedToLookupThInstName Type
th_type LookupTHInstNameErrReason
reason
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         case LookupTHInstNameErrReason
reason of
           LookupTHInstNameErrReason
NoMatchesFound ->
             String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Couldn't find any instances of"
               SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text (Type -> String
forall a. Ppr a => a -> String
TH.pprint Type
th_type)
               SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"to add documentation to"
           LookupTHInstNameErrReason
CouldNotDetermineInstance ->
             String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Couldn't work out what instance"
               SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text (Type -> String
forall a. Ppr a => a -> String
TH.pprint Type
th_type)
               SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is supposed to be"
    TcRnCannotReifyInstance Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"reifyInstances:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty))
            Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not a class constraint or type family application")
    TcRnCannotReifyOutOfScopeThing Name
th_name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text (Name -> String
forall a. Ppr a => a -> String
TH.pprint Name
th_name)) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                 String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not in scope at a reify"
               -- Ugh! Rather an indirect way to display the name
    TcRnCannotReifyThingNotInTypeEnv Name
name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not in the type environment at a reify"
    TcRnNoRolesAssociatedWithThing TcTyThing
thing
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"No roles associated with" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (TcTyThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcTyThing
thing)
    TcRnCannotRepresentType UnrepresentableTypeDescr
sort Type
ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
         [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Can't represent" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
sort_doc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
               String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in Template Haskell:",
                 Int -> SDoc -> SDoc
nest Int
2 (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty)]
       where
         sort_doc :: SDoc
sort_doc = String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$
           case UnrepresentableTypeDescr
sort of
             UnrepresentableTypeDescr
LinearInvisibleArgument -> String
"linear invisible argument"
             UnrepresentableTypeDescr
CoercionsInTypes -> String
"coercions in types"
    TcRnRunSpliceFailure Maybe String
mCallingFnName (ConversionFail ThingBeingConverted
what ConversionFailReason
reason)
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated
           (SDoc -> DecoratedSDoc) -> (SDoc -> SDoc) -> SDoc -> DecoratedSDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> SDoc
addCallingFn
           (SDoc -> SDoc) -> (SDoc -> SDoc) -> SDoc -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> SDoc
addSpliceInfo
           (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ ConversionFailReason -> SDoc
pprConversionFailReason ConversionFailReason
reason
      where
        addCallingFn :: SDoc -> SDoc
addCallingFn SDoc
rest =
          case Maybe String
mCallingFnName of
            Maybe String
Nothing -> SDoc
rest
            Just String
callingFn ->
              SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text (String
"Error in a declaration passed to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
callingFn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"))
                 Int
2 SDoc
rest
        addSpliceInfo :: SDoc -> SDoc
addSpliceInfo = case ThingBeingConverted
what of
          ConvDec Dec
d -> String -> Dec -> SDoc -> SDoc
forall {a}. (Show a, Ppr a) => String -> a -> SDoc -> SDoc
addSliceInfo' String
"declaration" Dec
d
          ConvExp Exp
e -> String -> Exp -> SDoc -> SDoc
forall {a}. (Show a, Ppr a) => String -> a -> SDoc -> SDoc
addSliceInfo' String
"expression" Exp
e
          ConvPat Pat
p -> String -> Pat -> SDoc -> SDoc
forall {a}. (Show a, Ppr a) => String -> a -> SDoc -> SDoc
addSliceInfo' String
"pattern" Pat
p
          ConvType Type
t -> String -> Type -> SDoc -> SDoc
forall {a}. (Show a, Ppr a) => String -> a -> SDoc -> SDoc
addSliceInfo' String
"type" Type
t
        addSliceInfo' :: String -> a -> SDoc -> SDoc
addSliceInfo' String
what a
item SDoc
reasonErr = SDoc
reasonErr SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc
descr
          where
                -- Show the item in pretty syntax normally,
                -- but with all its constructors if you say -dppr-debug
            descr :: SDoc
descr = SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"When splicing a TH" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon)
                       Int
2 ((Bool -> SDoc) -> SDoc
forall doc. IsOutput doc => (Bool -> doc) -> doc
getPprDebug ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
                           Bool
True  -> String -> SDoc
forall doc. IsLine doc => String -> doc
text (a -> String
forall a. Show a => a -> String
show a
item)
                           Bool
False -> String -> SDoc
forall doc. IsLine doc => String -> doc
text (a -> String
forall a. Ppr a => a -> String
TH.pprint a
item))
    TcRnReportCustomQuasiError Bool
_ String
msg -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
msg
    TcRnInterfaceLookupError Name
_ SDoc
sdoc -> SDoc -> DecoratedSDoc
mkSimpleDecorated SDoc
sdoc
    TcRnUnsatisfiedMinimalDef ClassMinimalDef
mindef
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"No explicit implementation for"
              ,Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ ClassMinimalDef -> SDoc
forall a. Outputable a => BooleanFormula a -> SDoc
pprBooleanFormulaNice ClassMinimalDef
mindef
             ]
    TcRnMisplacedInstSig Name
name LHsSigType GhcRn
hs_ty
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal type signature in instance declaration:")
                  Int
2 (SDoc -> Int -> SDoc -> SDoc
hang (Name -> SDoc
forall a. NamedThing a => a -> SDoc
pprPrefixName Name
name)
                        Int
2 (SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GenLocated SrcSpanAnnA (HsSigType GhcRn) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsSigType GhcRn
GenLocated SrcSpanAnnA (HsSigType GhcRn)
hs_ty))
             ]
    TcRnBadBootFamInstDecl {}
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal family instance in hs-boot file"
    TcRnIllegalFamilyInstance TyCon
tycon
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal family instance for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tycon)
             , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tycon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not an indexed type family")]
    TcRnMissingClassAssoc TyCon
name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Associated type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"must be inside a class instance"
    TcRnBadFamInstDecl TyCon
tc_name
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal family instance for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc_name)
    TcRnNotOpenFamily TyCon
tc
      -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal instance for closed family" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc)
    TcRnMessage
TcRnNoRebindableSyntaxRecordDot -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RebindableSyntax is required if OverloadedRecordUpdate is enabled."
    TcRnMessage
TcRnNoFieldPunsRecordDot -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"For this to work enable NamedFieldPuns"
    TcRnIllegalStaticExpression HsExpr GhcPs
e -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal static expression:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsExpr GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
e
    TcRnIllegalStaticFormInSplice HsExpr GhcPs
e -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"static forms cannot be used in splices:"
          , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
e
          ]
    TcRnListComprehensionDuplicateBinding Name
n -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Duplicate binding in parallel list comprehension for:"
          SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n))
    TcRnEmptyStmtsGroup EmptyStatementGroupErrReason
cause -> SDoc -> DecoratedSDoc
mkSimpleDecorated  (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ case EmptyStatementGroupErrReason
cause of
      EmptyStatementGroupErrReason
EmptyStmtsGroupInParallelComp ->
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Empty statement group in parallel comprehension"
      EmptyStatementGroupErrReason
EmptyStmtsGroupInTransformListComp ->
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Empty statement group preceding 'group' or 'then'"
      EmptyStmtsGroupInDoNotation HsDoFlavour
ctxt ->
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Empty" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsDoFlavour -> SDoc
pprHsDoFlavour HsDoFlavour
ctxt
      EmptyStatementGroupErrReason
EmptyStmtsGroupInArrowNotation ->
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Empty 'do' block in an arrow command"
    TcRnLastStmtNotExpr HsStmtContext GhcRn
ctxt (UnexpectedStatement StmtLR GhcPs GhcPs body
stmt) ->
      SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> Int -> SDoc -> SDoc
hang SDoc
last_error Int
2 (StmtLR GhcPs GhcPs body -> SDoc
forall a. Outputable a => a -> SDoc
ppr StmtLR GhcPs GhcPs body
stmt)
      where
        last_error :: SDoc
last_error =
          String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The last statement in" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsStmtContext GhcRn -> SDoc
forall p.
(Outputable (IdP (NoGhcTc p)), UnXRec (NoGhcTc p)) =>
HsStmtContext p -> SDoc
pprAStmtContext HsStmtContext GhcRn
ctxt
          SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"must be an expression"
    TcRnUnexpectedStatementInContext HsStmtContext GhcRn
ctxt (UnexpectedStatement StmtLR GhcPs GhcPs body
stmt) Maybe Extension
_ -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
       [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unexpected" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> StmtLR GhcPs GhcPs body -> SDoc
forall (p :: Pass) body. Stmt (GhcPass p) body -> SDoc
pprStmtCat StmtLR GhcPs GhcPs body
stmt SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"statement"
                       , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsStmtContext GhcRn -> SDoc
forall p.
(Outputable (IdP (NoGhcTc p)), UnXRec (NoGhcTc p)) =>
HsStmtContext p -> SDoc
pprAStmtContext HsStmtContext GhcRn
ctxt ]
    TcRnMessage
TcRnIllegalTupleSection -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal tuple section"
    TcRnIllegalImplicitParameterBindings Either (HsLocalBindsLR GhcPs GhcPs) (HsLocalBindsLR GhcRn GhcPs)
eBinds -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
        (HsLocalBindsLR GhcPs GhcPs -> SDoc)
-> (HsLocalBindsLR GhcRn GhcPs -> SDoc)
-> Either (HsLocalBindsLR GhcPs GhcPs) (HsLocalBindsLR GhcRn GhcPs)
-> SDoc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HsLocalBindsLR GhcPs GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
msg HsLocalBindsLR GhcRn GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
msg Either (HsLocalBindsLR GhcPs GhcPs) (HsLocalBindsLR GhcRn GhcPs)
eBinds
      where
        msg :: a -> SDoc
msg a
binds = SDoc -> Int -> SDoc -> SDoc
hang
          (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Implicit-parameter bindings illegal in an mdo expression")
          Int
2 (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
binds)
    TcRnSectionWithoutParentheses HsExpr GhcPs
expr -> SDoc -> DecoratedSDoc
mkSimpleDecorated (SDoc -> DecoratedSDoc) -> SDoc -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$
      SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"A section must be enclosed in parentheses")
         Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"thus:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (HsExpr GhcPs -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcPs
expr)))


  diagnosticReason :: TcRnMessage -> DiagnosticReason
diagnosticReason = \case
    TcRnUnknownMessage UnknownDiagnostic
m
      -> UnknownDiagnostic -> DiagnosticReason
forall a. Diagnostic a => a -> DiagnosticReason
diagnosticReason UnknownDiagnostic
m
    TcRnMessageWithInfo UnitState
_ TcRnMessageDetailed
msg_with_info
      -> case TcRnMessageDetailed
msg_with_info of
           TcRnMessageDetailed ErrInfo
_ TcRnMessage
m -> TcRnMessage -> DiagnosticReason
forall a. Diagnostic a => a -> DiagnosticReason
diagnosticReason TcRnMessage
m
    TcRnWithHsDocContext HsDocContext
_ TcRnMessage
msg
      -> TcRnMessage -> DiagnosticReason
forall a. Diagnostic a => a -> DiagnosticReason
diagnosticReason TcRnMessage
msg
    TcRnSolverReport SolverReportWithCtxt
_ DiagnosticReason
reason [GhcHint]
_
      -> DiagnosticReason
reason -- Error, or a Warning if we are deferring type errors
    TcRnRedundantConstraints {}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnRedundantConstraints
    TcRnInaccessibleCode {}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnInaccessibleCode
    TcRnTypeDoesNotHaveFixedRuntimeRep{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnImplicitLift{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnImplicitLift
    TcRnUnusedPatternBinds{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnUnusedPatternBinds
    TcRnDodgyImports{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnDodgyImports
    TcRnDodgyExports{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnDodgyExports
    TcRnMissingImportList{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnMissingImportList
    TcRnUnsafeDueToPlugin{}
      -> DiagnosticReason
WarningWithoutFlag
    TcRnModMissingRealSrcSpan{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIdNotExportedFromModuleSig{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIdNotExportedFromLocalSig{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnShadowedName{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnNameShadowing
    TcRnDuplicateWarningDecls{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnSimplifierTooManyIterations{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalPatSynDecl{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnLinearPatSyn{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnMessage
TcRnEmptyRecordUpdate
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalFieldPunning{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalWildcardsInRecord{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalWildcardInType{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnDuplicateFieldName{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalViewPattern{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnCharLiteralOutOfRange{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalWildcardsInConstructor{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIgnoringAnnotations{}
      -> DiagnosticReason
WarningWithoutFlag
    TcRnMessage
TcRnAnnotationInSafeHaskell
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnInvalidTypeApplication{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnMessage
TcRnTagToEnumMissingValArg
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnTagToEnumUnspecifiedResTy{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnTagToEnumResTyNotAnEnum{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnMessage
TcRnArrowIfThenElsePredDependsOnResultTy
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnMessage
TcRnIllegalHsBootFileDecl
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnRecursivePatternSynonym{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnPartialTypeSigTyVarMismatch{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnPartialTypeSigBadQuantifier{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnMissingSignature MissingSignature
what Exported
exported Bool
overridden
      -> WarningFlag -> DiagnosticReason
WarningWithFlag (WarningFlag -> DiagnosticReason)
-> WarningFlag -> DiagnosticReason
forall a b. (a -> b) -> a -> b
$ MissingSignature -> Exported -> Bool -> WarningFlag
missingSignatureWarningFlag MissingSignature
what Exported
exported Bool
overridden
    TcRnPolymorphicBinderMissingSig{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnMissingLocalSignatures
    TcRnOverloadedSig{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnTupleConstraintInst{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnAbstractClassInst{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNoClassInstHead{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnUserTypeError{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnConstraintInKind{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnUnboxedTupleOrSumTypeFuncArg{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnLinearFuncInKind{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnForAllEscapeError{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnVDQInTermType{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnBadQuantPredHead{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalTupleConstraint{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNonTypeVarArgInConstraint{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalImplicitParam{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalConstraintSynonymOfKind{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalClassInst{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnOversaturatedVisibleKindArg{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnBadAssociatedType{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnForAllRankErr{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnMonomorphicBindings{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnMonomorphism
    TcRnOrphanInstance{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnOrphans
    TcRnFunDepConflict{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnDupInstanceDecls{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnConflictingFamInstDecls{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnFamInstNotInjective{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnBangOnUnliftedType{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnRedundantStrictnessFlags
    TcRnLazyBangOnUnliftedType{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnRedundantStrictnessFlags
    TcRnMultipleDefaultDeclarations{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnBadDefaultType{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnPatSynBundledWithNonDataCon{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnPatSynBundledWithWrongType{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnDupeModuleExport{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnDuplicateExports
    TcRnExportedModNotImported{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNullExportedModule{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnDodgyExports
    TcRnMissingExportList{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnMissingExportList
    TcRnExportHiddenComponents{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnDuplicateExport{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnDuplicateExports
    TcRnExportedParentChildMismatch{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnConflictingExports{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnAmbiguousField{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnAmbiguousFields
    TcRnMissingFields{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnMissingFields
    TcRnFieldUpdateInvalidType{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNoConstructorHasAllFields{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnMixedSelectors{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnMissingStrictFields{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNoPossibleParentForFields{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnBadOverloadedRecordUpdate{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnStaticFormNotClosed{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnMessage
TcRnUselessTypeable
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnDerivingTypeable
    TcRnDerivingDefaults{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnDerivingDefaults
    TcRnNonUnaryTypeclassConstraint{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnPartialTypeSignatures{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnPartialTypeSignatures
    TcRnCannotDeriveInstance Class
_ [Type]
_ Maybe (DerivStrategy GhcTc)
_ UsingGeneralizedNewtypeDeriving
_ DeriveInstanceErrReason
rea
      -> case DeriveInstanceErrReason
rea of
           DerivErrNotWellKinded{}                 -> DiagnosticReason
ErrorWithoutFlag
           DeriveInstanceErrReason
DerivErrSafeHaskellGenericInst          -> DiagnosticReason
ErrorWithoutFlag
           DerivErrDerivingViaWrongKind{}          -> DiagnosticReason
ErrorWithoutFlag
           DerivErrNoEtaReduce{}                   -> DiagnosticReason
ErrorWithoutFlag
           DeriveInstanceErrReason
DerivErrBootFileFound                   -> DiagnosticReason
ErrorWithoutFlag
           DerivErrDataConsNotAllInScope{}         -> DiagnosticReason
ErrorWithoutFlag
           DeriveInstanceErrReason
DerivErrGNDUsedOnData                   -> DiagnosticReason
ErrorWithoutFlag
           DeriveInstanceErrReason
DerivErrNullaryClasses                  -> DiagnosticReason
ErrorWithoutFlag
           DeriveInstanceErrReason
DerivErrLastArgMustBeApp                -> DiagnosticReason
ErrorWithoutFlag
           DerivErrNoFamilyInstance{}              -> DiagnosticReason
ErrorWithoutFlag
           DerivErrNotStockDeriveable{}            -> DiagnosticReason
ErrorWithoutFlag
           DerivErrHasAssociatedDatatypes{}        -> DiagnosticReason
ErrorWithoutFlag
           DeriveInstanceErrReason
DerivErrNewtypeNonDeriveableClass       -> DiagnosticReason
ErrorWithoutFlag
           DerivErrCannotEtaReduceEnough{}         -> DiagnosticReason
ErrorWithoutFlag
           DerivErrOnlyAnyClassDeriveable{}        -> DiagnosticReason
ErrorWithoutFlag
           DerivErrNotDeriveable{}                 -> DiagnosticReason
ErrorWithoutFlag
           DerivErrNotAClass{}                     -> DiagnosticReason
ErrorWithoutFlag
           DerivErrNoConstructors{}                -> DiagnosticReason
ErrorWithoutFlag
           DerivErrLangExtRequired{}               -> DiagnosticReason
ErrorWithoutFlag
           DerivErrDunnoHowToDeriveForType{}       -> DiagnosticReason
ErrorWithoutFlag
           DerivErrMustBeEnumType{}                -> DiagnosticReason
ErrorWithoutFlag
           DerivErrMustHaveExactlyOneConstructor{} -> DiagnosticReason
ErrorWithoutFlag
           DerivErrMustHaveSomeParameters{}        -> DiagnosticReason
ErrorWithoutFlag
           DerivErrMustNotHaveClassContext{}       -> DiagnosticReason
ErrorWithoutFlag
           DerivErrBadConstructor{}                -> DiagnosticReason
ErrorWithoutFlag
           DerivErrGenerics{}                      -> DiagnosticReason
ErrorWithoutFlag
           DerivErrEnumOrProduct{}                 -> DiagnosticReason
ErrorWithoutFlag
    TcRnMessage
TcRnLazyGADTPattern
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnMessage
TcRnArrowProcGADTPattern
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnSpecialClassInst {}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnForallIdentifier {}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnForallIdentifier
    TcRnMessage
TcRnTypeEqualityOutOfScope
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnTypeEqualityOutOfScope
    TcRnMessage
TcRnTypeEqualityRequiresOperators
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnTypeEqualityRequiresOperators
    TcRnIllegalTypeOperator {}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalTypeOperatorDecl {}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnGADTMonoLocalBinds {}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnGADTMonoLocalBinds
    TcRnIncorrectNameSpace {}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNotInScope {}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnUntickedPromotedThing {}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnUntickedPromotedConstructors
    TcRnIllegalBuiltinSyntax {}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnWarnDefaulting {}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnTypeDefaults
    TcRnForeignImportPrimExtNotSet{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnForeignImportPrimSafeAnn{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnForeignFunctionImportAsValue{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnFunPtrImportWithoutAmpersand{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnDodgyForeignImports
    TcRnIllegalForeignDeclBackend{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnUnsupportedCallConv Either (ForeignExport GhcRn) (ForeignImport GhcRn)
_ UnsupportedCallConvention
unsupportedCC
      -> case UnsupportedCallConvention
unsupportedCC of
           UnsupportedCallConvention
StdCallConvUnsupported -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnUnsupportedCallingConventions
           UnsupportedCallConvention
_ -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalForeignType{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnInvalidCIdentifier{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnExpectedValueId{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNotARecordSelector{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnRecSelectorEscapedTyVar{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnPatSynNotBidirectional{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnSplicePolymorphicLocalVar{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalDerivingItem{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnUnexpectedAnnotation{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalRecordSyntax{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnUnexpectedTypeSplice{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnInvalidVisibleKindArgument{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnTooManyBinders{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnDifferentNamesForTyVar{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnInvalidReturnKind{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnClassKindNotConstraint{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnUnpromotableThing{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnMatchesHaveDiffNumArgs{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnCannotBindScopedTyVarInPatSig{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnCannotBindTyVarsInPatBind{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnTooManyTyArgsInConPattern{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnMultipleInlinePragmas{}
      -> DiagnosticReason
WarningWithoutFlag
    TcRnUnexpectedPragmas{}
      -> DiagnosticReason
WarningWithoutFlag
    TcRnNonOverloadedSpecialisePragma{}
      -> DiagnosticReason
WarningWithoutFlag
    TcRnSpecialiseNotVisible{}
      -> DiagnosticReason
WarningWithoutFlag
    TcRnNameByTemplateHaskellQuote{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalBindingOfBuiltIn{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnPragmaWarning{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnWarningsDeprecations
    TcRnIllegalHsigDefaultMethods{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnBadGenericMethod{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnWarningMinimalDefIncomplete{}
      -> DiagnosticReason
WarningWithoutFlag
    TcRnDefaultMethodForPragmaLacksBinding{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIgnoreSpecialisePragmaOnDefMethod{}
      -> DiagnosticReason
WarningWithoutFlag
    TcRnBadMethodErr{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNoExplicitAssocTypeOrDefaultDeclaration{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag (WarningFlag
Opt_WarnMissingMethods)
    TcRnMessage
TcRnIllegalTypeData
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnTypeDataForbids{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalNewtype{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnTypedTHWithPolyType{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnSpliceThrewException{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnInvalidTopDecl{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNonExactName{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnAddInvalidCorePlugin{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnAddDocToNonLocalDefn{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnFailedToLookupThInstName{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnCannotReifyInstance{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnCannotReifyOutOfScopeThing{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnCannotReifyThingNotInTypeEnv{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNoRolesAssociatedWithThing{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnCannotRepresentType{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnRunSpliceFailure{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnReportCustomQuasiError Bool
isError String
_
      -> if Bool
isError then DiagnosticReason
ErrorWithoutFlag else DiagnosticReason
WarningWithoutFlag
    TcRnInterfaceLookupError{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnUnsatisfiedMinimalDef{}
      -> WarningFlag -> DiagnosticReason
WarningWithFlag (WarningFlag
Opt_WarnMissingMethods)
    TcRnMisplacedInstSig{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnBadBootFamInstDecl{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalFamilyInstance{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnMissingClassAssoc{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnBadFamInstDecl{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNotOpenFamily{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNoRebindableSyntaxRecordDot{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnNoFieldPunsRecordDot{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalStaticExpression{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalStaticFormInSplice{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnListComprehensionDuplicateBinding{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnEmptyStmtsGroup{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnLastStmtNotExpr{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnUnexpectedStatementInContext{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnSectionWithoutParentheses{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalImplicitParameterBindings{}
      -> DiagnosticReason
ErrorWithoutFlag
    TcRnIllegalTupleSection{}
      -> DiagnosticReason
ErrorWithoutFlag

  diagnosticHints :: TcRnMessage -> [GhcHint]
diagnosticHints = \case
    TcRnUnknownMessage UnknownDiagnostic
m
      -> UnknownDiagnostic -> [GhcHint]
forall a. Diagnostic a => a -> [GhcHint]
diagnosticHints UnknownDiagnostic
m
    TcRnMessageWithInfo UnitState
_ TcRnMessageDetailed
msg_with_info
      -> case TcRnMessageDetailed
msg_with_info of
           TcRnMessageDetailed ErrInfo
_ TcRnMessage
m -> TcRnMessage -> [GhcHint]
forall a. Diagnostic a => a -> [GhcHint]
diagnosticHints TcRnMessage
m
    TcRnWithHsDocContext HsDocContext
_ TcRnMessage
msg
      -> TcRnMessage -> [GhcHint]
forall a. Diagnostic a => a -> [GhcHint]
diagnosticHints TcRnMessage
msg
    TcRnSolverReport SolverReportWithCtxt
_ DiagnosticReason
_ [GhcHint]
hints
      -> [GhcHint]
hints
    TcRnRedundantConstraints{}
      -> [GhcHint]
noHints
    TcRnInaccessibleCode{}
      -> [GhcHint]
noHints
    TcRnTypeDoesNotHaveFixedRuntimeRep{}
      -> [GhcHint]
noHints
    TcRnImplicitLift{}
      -> [GhcHint]
noHints
    TcRnUnusedPatternBinds{}
      -> [GhcHint]
noHints
    TcRnDodgyImports{}
      -> [GhcHint]
noHints
    TcRnDodgyExports{}
      -> [GhcHint]
noHints
    TcRnMissingImportList{}
      -> [GhcHint]
noHints
    TcRnUnsafeDueToPlugin{}
      -> [GhcHint]
noHints
    TcRnModMissingRealSrcSpan{}
      -> [GhcHint]
noHints
    TcRnIdNotExportedFromModuleSig Name
name Module
mod
      -> [Name -> Maybe Module -> GhcHint
SuggestAddToHSigExportList Name
name (Maybe Module -> GhcHint) -> Maybe Module -> GhcHint
forall a b. (a -> b) -> a -> b
$ Module -> Maybe Module
forall a. a -> Maybe a
Just Module
mod]
    TcRnIdNotExportedFromLocalSig Name
name
      -> [Name -> Maybe Module -> GhcHint
SuggestAddToHSigExportList Name
name Maybe Module
forall a. Maybe a
Nothing]
    TcRnShadowedName{}
      -> [GhcHint]
noHints
    TcRnDuplicateWarningDecls{}
      -> [GhcHint]
noHints
    TcRnSimplifierTooManyIterations{}
      -> [GhcHint
SuggestIncreaseSimplifierIterations]
    TcRnIllegalPatSynDecl{}
      -> [GhcHint]
noHints
    TcRnLinearPatSyn{}
      -> [GhcHint]
noHints
    TcRnEmptyRecordUpdate{}
      -> [GhcHint]
noHints
    TcRnIllegalFieldPunning{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.NamedFieldPuns]
    TcRnIllegalWildcardsInRecord{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.RecordWildCards]
    TcRnIllegalWildcardInType{}
      -> [GhcHint]
noHints
    TcRnDuplicateFieldName{}
      -> [GhcHint]
noHints
    TcRnIllegalViewPattern{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.ViewPatterns]
    TcRnCharLiteralOutOfRange{}
      -> [GhcHint]
noHints
    TcRnIllegalWildcardsInConstructor{}
      -> [GhcHint]
noHints
    TcRnIgnoringAnnotations{}
      -> [GhcHint]
noHints
    TcRnMessage
TcRnAnnotationInSafeHaskell
      -> [GhcHint]
noHints
    TcRnInvalidTypeApplication{}
      -> [GhcHint]
noHints
    TcRnMessage
TcRnTagToEnumMissingValArg
      -> [GhcHint]
noHints
    TcRnTagToEnumUnspecifiedResTy{}
      -> [GhcHint]
noHints
    TcRnTagToEnumResTyNotAnEnum{}
      -> [GhcHint]
noHints
    TcRnMessage
TcRnArrowIfThenElsePredDependsOnResultTy
      -> [GhcHint]
noHints
    TcRnMessage
TcRnIllegalHsBootFileDecl
      -> [GhcHint]
noHints
    TcRnRecursivePatternSynonym{}
      -> [GhcHint]
noHints
    TcRnPartialTypeSigTyVarMismatch{}
      -> [GhcHint]
noHints
    TcRnPartialTypeSigBadQuantifier{}
      -> [GhcHint]
noHints
    TcRnMissingSignature {}
      -> [GhcHint]
noHints
    TcRnPolymorphicBinderMissingSig{}
      -> [GhcHint]
noHints
    TcRnOverloadedSig{}
      -> [GhcHint]
noHints
    TcRnTupleConstraintInst{}
      -> [GhcHint]
noHints
    TcRnAbstractClassInst{}
      -> [GhcHint]
noHints
    TcRnNoClassInstHead{}
      -> [GhcHint]
noHints
    TcRnUserTypeError{}
      -> [GhcHint]
noHints
    TcRnConstraintInKind{}
      -> [GhcHint]
noHints
    TcRnUnboxedTupleOrSumTypeFuncArg UnboxedTupleOrSum
tuple_or_sum Type
_
      -> [Extension -> GhcHint
suggestExtension (Extension -> GhcHint) -> Extension -> GhcHint
forall a b. (a -> b) -> a -> b
$ UnboxedTupleOrSum -> Extension
unboxedTupleOrSumExtension UnboxedTupleOrSum
tuple_or_sum]
    TcRnLinearFuncInKind{}
      -> [GhcHint]
noHints
    TcRnForAllEscapeError{}
      -> [GhcHint]
noHints
    TcRnVDQInTermType{}
      -> [GhcHint]
noHints
    TcRnBadQuantPredHead{}
      -> [GhcHint]
noHints
    TcRnIllegalTupleConstraint{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.ConstraintKinds]
    TcRnNonTypeVarArgInConstraint{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.FlexibleContexts]
    TcRnIllegalImplicitParam{}
      -> [GhcHint]
noHints
    TcRnIllegalConstraintSynonymOfKind{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.ConstraintKinds]
    TcRnIllegalClassInst{}
      -> [GhcHint]
noHints
    TcRnOversaturatedVisibleKindArg{}
      -> [GhcHint]
noHints
    TcRnBadAssociatedType{}
      -> [GhcHint]
noHints
    TcRnForAllRankErr Rank
rank Type
_
      -> case Rank
rank of
           LimitedRank{}      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.RankNTypes]
           Rank
MonoTypeRankZero   -> [Extension -> GhcHint
suggestExtension Extension
LangExt.RankNTypes]
           Rank
MonoTypeTyConArg   -> [Extension -> GhcHint
suggestExtension Extension
LangExt.ImpredicativeTypes]
           Rank
MonoTypeSynArg     -> [Extension -> GhcHint
suggestExtension Extension
LangExt.LiberalTypeSynonyms]
           Rank
MonoTypeConstraint -> [Extension -> GhcHint
suggestExtension Extension
LangExt.QuantifiedConstraints]
           Rank
_                  -> [GhcHint]
noHints
    TcRnMonomorphicBindings [Name]
bindings
      -> case [Name]
bindings of
          []     -> [GhcHint]
noHints
          (Name
x:[Name]
xs) -> [AvailableBindings -> GhcHint
SuggestAddTypeSignatures (AvailableBindings -> GhcHint) -> AvailableBindings -> GhcHint
forall a b. (a -> b) -> a -> b
$ NonEmpty Name -> AvailableBindings
NamedBindings (Name
x Name -> [Name] -> NonEmpty Name
forall a. a -> [a] -> NonEmpty a
NE.:| [Name]
xs)]
    TcRnOrphanInstance{}
      -> [GhcHint
SuggestFixOrphanInstance]
    TcRnFunDepConflict{}
      -> [GhcHint]
noHints
    TcRnDupInstanceDecls{}
      -> [GhcHint]
noHints
    TcRnConflictingFamInstDecls{}
      -> [GhcHint]
noHints
    TcRnFamInstNotInjective InjectivityErrReason
rea TyCon
_ NonEmpty CoAxBranch
_
      -> case InjectivityErrReason
rea of
           InjErrRhsBareTyVar{}      -> [GhcHint]
noHints
           InjectivityErrReason
InjErrRhsCannotBeATypeFam -> [GhcHint]
noHints
           InjectivityErrReason
InjErrRhsOverlap          -> [GhcHint]
noHints
           InjErrCannotInferFromRhs TyVarSet
_ HasKinds
_ SuggestUndecidableInstances
suggestUndInst
             | SuggestUndecidableInstances
YesSuggestUndecidableInstaces <- SuggestUndecidableInstances
suggestUndInst
             -> [Extension -> GhcHint
suggestExtension Extension
LangExt.UndecidableInstances]
             | Bool
otherwise
             -> [GhcHint]
noHints
    TcRnBangOnUnliftedType{}
      -> [GhcHint]
noHints
    TcRnLazyBangOnUnliftedType{}
      -> [GhcHint]
noHints
    TcRnMultipleDefaultDeclarations{}
      -> [GhcHint]
noHints
    TcRnBadDefaultType{}
      -> [GhcHint]
noHints
    TcRnPatSynBundledWithNonDataCon{}
      -> [GhcHint]
noHints
    TcRnPatSynBundledWithWrongType{}
      -> [GhcHint]
noHints
    TcRnDupeModuleExport{}
      -> [GhcHint]
noHints
    TcRnExportedModNotImported{}
      -> [GhcHint]
noHints
    TcRnNullExportedModule{}
      -> [GhcHint]
noHints
    TcRnMissingExportList{}
      -> [GhcHint]
noHints
    TcRnExportHiddenComponents{}
      -> [GhcHint]
noHints
    TcRnDuplicateExport{}
      -> [GhcHint]
noHints
    TcRnExportedParentChildMismatch{}
      -> [GhcHint]
noHints
    TcRnConflictingExports{}
      -> [GhcHint]
noHints
    TcRnAmbiguousField{}
      -> [GhcHint]
noHints
    TcRnMissingFields{}
      -> [GhcHint]
noHints
    TcRnFieldUpdateInvalidType{}
      -> [GhcHint]
noHints
    TcRnNoConstructorHasAllFields{}
      -> [GhcHint]
noHints
    TcRnMixedSelectors{}
      -> [GhcHint]
noHints
    TcRnMissingStrictFields{}
      -> [GhcHint]
noHints
    TcRnNoPossibleParentForFields{}
      -> [GhcHint]
noHints
    TcRnBadOverloadedRecordUpdate{}
      -> [GhcHint]
noHints
    TcRnStaticFormNotClosed{}
      -> [GhcHint]
noHints
    TcRnMessage
TcRnUselessTypeable
      -> [GhcHint]
noHints
    TcRnDerivingDefaults{}
      -> [GhcHint
useDerivingStrategies]
    TcRnNonUnaryTypeclassConstraint{}
      -> [GhcHint]
noHints
    TcRnPartialTypeSignatures SuggestPartialTypeSignatures
suggestParSig [Type]
_
      -> case SuggestPartialTypeSignatures
suggestParSig of
           SuggestPartialTypeSignatures
YesSuggestPartialTypeSignatures
             -> let info :: SDoc
info = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"to use the inferred type"
                in [SDoc -> Extension -> GhcHint
suggestExtensionWithInfo SDoc
info Extension
LangExt.PartialTypeSignatures]
           SuggestPartialTypeSignatures
NoSuggestPartialTypeSignatures
             -> [GhcHint]
noHints
    TcRnCannotDeriveInstance Class
cls [Type]
_ Maybe (DerivStrategy GhcTc)
_ UsingGeneralizedNewtypeDeriving
newtype_deriving DeriveInstanceErrReason
rea
      -> Class
-> UsingGeneralizedNewtypeDeriving
-> DeriveInstanceErrReason
-> [GhcHint]
deriveInstanceErrReasonHints Class
cls UsingGeneralizedNewtypeDeriving
newtype_deriving DeriveInstanceErrReason
rea
    TcRnMessage
TcRnLazyGADTPattern
      -> [GhcHint]
noHints
    TcRnMessage
TcRnArrowProcGADTPattern
      -> [GhcHint]
noHints
    TcRnSpecialClassInst {}
      -> [GhcHint]
noHints
    TcRnForallIdentifier {}
      -> [GhcHint
SuggestRenameForall]
    TcRnMessage
TcRnTypeEqualityOutOfScope
      -> [GhcHint]
noHints
    TcRnMessage
TcRnTypeEqualityRequiresOperators
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.TypeOperators]
    TcRnIllegalTypeOperator {}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.TypeOperators]
    TcRnIllegalTypeOperatorDecl {}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.TypeOperators]
    TcRnGADTMonoLocalBinds {}
      -> [[Extension] -> GhcHint
suggestAnyExtension [Extension
LangExt.GADTs, Extension
LangExt.TypeFamilies]]
    TcRnIncorrectNameSpace Name
nm Bool
is_th_use
      | Bool
is_th_use
      -> [NameSpace -> GhcHint
SuggestAppropriateTHTick (NameSpace -> GhcHint) -> NameSpace -> GhcHint
forall a b. (a -> b) -> a -> b
$ Name -> NameSpace
nameNameSpace Name
nm]
      | Bool
otherwise
      -> [GhcHint]
noHints
    TcRnNotInScope NotInScopeError
err RdrName
_ [ImportError]
_ [GhcHint]
hints
      -> NotInScopeError -> [GhcHint]
scopeErrorHints NotInScopeError
err [GhcHint] -> [GhcHint] -> [GhcHint]
forall a. [a] -> [a] -> [a]
++ [GhcHint]
hints
    TcRnUntickedPromotedThing UntickedPromotedThing
thing
      -> [UntickedPromotedThing -> GhcHint
SuggestAddTick UntickedPromotedThing
thing]
    TcRnIllegalBuiltinSyntax {}
      -> [GhcHint]
noHints
    TcRnWarnDefaulting {}
      -> [GhcHint]
noHints
    TcRnForeignImportPrimExtNotSet{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.GHCForeignImportPrim]
    TcRnForeignImportPrimSafeAnn{}
      -> [GhcHint]
noHints
    TcRnForeignFunctionImportAsValue{}
      -> [GhcHint]
noHints
    TcRnFunPtrImportWithoutAmpersand{}
      -> [GhcHint]
noHints
    TcRnIllegalForeignDeclBackend{}
      -> [GhcHint]
noHints
    TcRnUnsupportedCallConv{}
      -> [GhcHint]
noHints
    TcRnIllegalForeignType Maybe ArgOrResult
_ IllegalForeignTypeReason
reason
      -> case IllegalForeignTypeReason
reason of
           TypeCannotBeMarshaled Type
_ TypeCannotBeMarshaledReason
why
             | NewtypeDataConNotInScope{} <- TypeCannotBeMarshaledReason
why -> [GhcHint
SuggestImportingDataCon]
             | TypeCannotBeMarshaledReason
UnliftedFFITypesNeeded <- TypeCannotBeMarshaledReason
why -> [Extension -> GhcHint
suggestExtension Extension
LangExt.UnliftedFFITypes]
           IllegalForeignTypeReason
_ -> [GhcHint]
noHints
    TcRnInvalidCIdentifier{}
      -> [GhcHint]
noHints
    TcRnExpectedValueId{}
      -> [GhcHint]
noHints
    TcRnNotARecordSelector{}
      -> [GhcHint]
noHints
    TcRnRecSelectorEscapedTyVar{}
      -> [GhcHint
SuggestPatternMatchingSyntax]
    TcRnPatSynNotBidirectional{}
      -> [GhcHint]
noHints
    TcRnSplicePolymorphicLocalVar{}
      -> [GhcHint]
noHints
    TcRnIllegalDerivingItem{}
      -> [GhcHint]
noHints
    TcRnUnexpectedAnnotation{}
      -> [GhcHint]
noHints
    TcRnIllegalRecordSyntax{}
      -> [GhcHint]
noHints
    TcRnUnexpectedTypeSplice{}
      -> [GhcHint]
noHints
    TcRnInvalidVisibleKindArgument{}
      -> [GhcHint]
noHints
    TcRnTooManyBinders{}
      -> [GhcHint]
noHints
    TcRnDifferentNamesForTyVar{}
      -> [GhcHint]
noHints
    TcRnInvalidReturnKind DataSort
_ AllowedDataResKind
_ Type
_ Maybe SuggestUnliftedTypes
mb_suggest_unlifted_ext
      -> case Maybe SuggestUnliftedTypes
mb_suggest_unlifted_ext of
           Maybe SuggestUnliftedTypes
Nothing -> [GhcHint]
noHints
           Just SuggestUnliftedTypes
SuggestUnliftedNewtypes -> [Extension -> GhcHint
suggestExtension Extension
LangExt.UnliftedNewtypes]
           Just SuggestUnliftedTypes
SuggestUnliftedDatatypes -> [Extension -> GhcHint
suggestExtension Extension
LangExt.UnliftedDatatypes]
    TcRnClassKindNotConstraint{}
      -> [GhcHint]
noHints
    TcRnUnpromotableThing{}
      -> [GhcHint]
noHints
    TcRnMatchesHaveDiffNumArgs{}
      -> [GhcHint]
noHints
    TcRnCannotBindScopedTyVarInPatSig{}
      -> [GhcHint]
noHints
    TcRnCannotBindTyVarsInPatBind{}
      -> [GhcHint]
noHints
    TcRnTooManyTyArgsInConPattern{}
      -> [GhcHint]
noHints
    TcRnMultipleInlinePragmas{}
      -> [GhcHint]
noHints
    TcRnUnexpectedPragmas{}
      -> [GhcHint]
noHints
    TcRnNonOverloadedSpecialisePragma{}
      -> [GhcHint]
noHints
    TcRnSpecialiseNotVisible Name
name
      -> [Name -> GhcHint
SuggestSpecialiseVisibilityHints Name
name]
    TcRnNameByTemplateHaskellQuote{}
      -> [GhcHint]
noHints
    TcRnIllegalBindingOfBuiltIn{}
      -> [GhcHint]
noHints
    TcRnPragmaWarning{}
      -> [GhcHint]
noHints
    TcRnIllegalHsigDefaultMethods{}
      -> [GhcHint]
noHints
    TcRnBadGenericMethod{}
      -> [GhcHint]
noHints
    TcRnWarningMinimalDefIncomplete{}
      -> [GhcHint]
noHints
    TcRnDefaultMethodForPragmaLacksBinding{}
      -> [GhcHint]
noHints
    TcRnIgnoreSpecialisePragmaOnDefMethod{}
      -> [GhcHint]
noHints
    TcRnBadMethodErr{}
      -> [GhcHint]
noHints
    TcRnNoExplicitAssocTypeOrDefaultDeclaration{}
      -> [GhcHint]
noHints
    TcRnMessage
TcRnIllegalTypeData
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.TypeData]
    TcRnTypeDataForbids{}
      -> [GhcHint]
noHints
    TcRnIllegalNewtype{}
      -> [GhcHint]
noHints
    TcRnTypedTHWithPolyType{}
      -> [GhcHint]
noHints
    TcRnSpliceThrewException{}
      -> [GhcHint]
noHints
    TcRnInvalidTopDecl{}
      -> [GhcHint]
noHints
    TcRnNonExactName{}
      -> [GhcHint]
noHints
    TcRnAddInvalidCorePlugin{}
      -> [GhcHint]
noHints
    TcRnAddDocToNonLocalDefn{}
      -> [GhcHint]
noHints
    TcRnFailedToLookupThInstName{}
      -> [GhcHint]
noHints
    TcRnCannotReifyInstance{}
      -> [GhcHint]
noHints
    TcRnCannotReifyOutOfScopeThing{}
      -> [GhcHint]
noHints
    TcRnCannotReifyThingNotInTypeEnv{}
      -> [GhcHint]
noHints
    TcRnNoRolesAssociatedWithThing{}
      -> [GhcHint]
noHints
    TcRnCannotRepresentType{}
      -> [GhcHint]
noHints
    TcRnRunSpliceFailure{}
      -> [GhcHint]
noHints
    TcRnReportCustomQuasiError{}
      -> [GhcHint]
noHints
    TcRnInterfaceLookupError{}
      -> [GhcHint]
noHints
    TcRnUnsatisfiedMinimalDef{}
      -> [GhcHint]
noHints
    TcRnMisplacedInstSig{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.InstanceSigs]
    TcRnBadBootFamInstDecl{}
      -> [GhcHint]
noHints
    TcRnIllegalFamilyInstance{}
      -> [GhcHint]
noHints
    TcRnMissingClassAssoc{}
      -> [GhcHint]
noHints
    TcRnBadFamInstDecl{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.TypeFamilies]
    TcRnNotOpenFamily{}
      -> [GhcHint]
noHints
    TcRnNoRebindableSyntaxRecordDot{}
      -> [GhcHint]
noHints
    TcRnNoFieldPunsRecordDot{}
      -> [GhcHint]
noHints
    TcRnIllegalStaticExpression{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.StaticPointers]
    TcRnIllegalStaticFormInSplice{}
      -> [GhcHint]
noHints
    TcRnListComprehensionDuplicateBinding{}
      -> [GhcHint]
noHints
    TcRnEmptyStmtsGroup EmptyStmtsGroupInDoNotation{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.NondecreasingIndentation]
    TcRnEmptyStmtsGroup{}
      -> [GhcHint]
noHints
    TcRnLastStmtNotExpr{}
      -> [GhcHint]
noHints
    TcRnUnexpectedStatementInContext HsStmtContext GhcRn
_ UnexpectedStatement
_ Maybe Extension
mExt
      | Maybe Extension
Nothing <- Maybe Extension
mExt -> [GhcHint]
noHints
      | Just Extension
ext <- Maybe Extension
mExt -> [Extension -> GhcHint
suggestExtension Extension
ext]
    TcRnSectionWithoutParentheses{}
      -> [GhcHint]
noHints
    TcRnIllegalImplicitParameterBindings{}
      -> [GhcHint]
noHints
    TcRnIllegalTupleSection{}
      -> [Extension -> GhcHint
suggestExtension Extension
LangExt.TupleSections]


  diagnosticCode :: TcRnMessage -> Maybe DiagnosticCode
diagnosticCode = TcRnMessage -> Maybe DiagnosticCode
forall diag.
(Generic diag, GDiagnosticCode (Rep diag)) =>
diag -> Maybe DiagnosticCode
constructorCode

-- | Change [x] to "x", [x, y] to "x and y", [x, y, z] to "x, y, and z",
-- and so on.  The `and` stands for any `conjunction`, which is passed in.
commafyWith :: SDoc -> [SDoc] -> [SDoc]
commafyWith :: SDoc -> [SDoc] -> [SDoc]
commafyWith SDoc
_ [] = []
commafyWith SDoc
_ [SDoc
x] = [SDoc
x]
commafyWith SDoc
conjunction [SDoc
x, SDoc
y] = [SDoc
x SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
conjunction SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
y]
commafyWith SDoc
conjunction [SDoc]
xs = [SDoc] -> [SDoc]
addConjunction ([SDoc] -> [SDoc]) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma [SDoc]
xs
    where addConjunction :: [SDoc] -> [SDoc]
addConjunction [SDoc
x, SDoc
y] = [SDoc
x, SDoc
conjunction, SDoc
y]
          addConjunction (SDoc
x : [SDoc]
xs) = SDoc
x SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: [SDoc] -> [SDoc]
addConjunction [SDoc]
xs
          addConjunction [SDoc]
_ = String -> [SDoc]
forall a. HasCallStack => String -> a
panic String
"commafyWith expected 2 or more elements"

deriveInstanceErrReasonHints :: Class
                             -> UsingGeneralizedNewtypeDeriving
                             -> DeriveInstanceErrReason
                             -> [GhcHint]
deriveInstanceErrReasonHints :: Class
-> UsingGeneralizedNewtypeDeriving
-> DeriveInstanceErrReason
-> [GhcHint]
deriveInstanceErrReasonHints Class
cls UsingGeneralizedNewtypeDeriving
newtype_deriving = \case
  DerivErrNotWellKinded TyCon
_ Type
_ Int
n_args_to_keep
    | Class
cls Class -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
gen1ClassKey Bool -> Bool -> Bool
&& Int
n_args_to_keep Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
    -> [Extension -> GhcHint
suggestExtension Extension
LangExt.PolyKinds]
    | Bool
otherwise
    -> [GhcHint]
noHints
  DeriveInstanceErrReason
DerivErrSafeHaskellGenericInst  -> [GhcHint]
noHints
  DerivErrDerivingViaWrongKind{}  -> [GhcHint]
noHints
  DerivErrNoEtaReduce{}           -> [GhcHint]
noHints
  DeriveInstanceErrReason
DerivErrBootFileFound           -> [GhcHint]
noHints
  DerivErrDataConsNotAllInScope{} -> [GhcHint]
noHints
  DeriveInstanceErrReason
DerivErrGNDUsedOnData           -> [GhcHint]
noHints
  DeriveInstanceErrReason
DerivErrNullaryClasses          -> [GhcHint]
noHints
  DeriveInstanceErrReason
DerivErrLastArgMustBeApp        -> [GhcHint]
noHints
  DerivErrNoFamilyInstance{}      -> [GhcHint]
noHints
  DerivErrNotStockDeriveable DeriveAnyClassEnabled
deriveAnyClassEnabled
    | DeriveAnyClassEnabled
deriveAnyClassEnabled DeriveAnyClassEnabled -> DeriveAnyClassEnabled -> Bool
forall a. Eq a => a -> a -> Bool
== DeriveAnyClassEnabled
NoDeriveAnyClassEnabled
    -> [Extension -> GhcHint
suggestExtension Extension
LangExt.DeriveAnyClass]
    | Bool
otherwise
    -> [GhcHint]
noHints
  DerivErrHasAssociatedDatatypes{}
    -> [GhcHint]
noHints
  DeriveInstanceErrReason
DerivErrNewtypeNonDeriveableClass
    | UsingGeneralizedNewtypeDeriving
newtype_deriving UsingGeneralizedNewtypeDeriving
-> UsingGeneralizedNewtypeDeriving -> Bool
forall a. Eq a => a -> a -> Bool
== UsingGeneralizedNewtypeDeriving
NoGeneralizedNewtypeDeriving
    -> [GhcHint
useGND]
    | Bool
otherwise
    -> [GhcHint]
noHints
  DerivErrCannotEtaReduceEnough{}
    | UsingGeneralizedNewtypeDeriving
newtype_deriving UsingGeneralizedNewtypeDeriving
-> UsingGeneralizedNewtypeDeriving -> Bool
forall a. Eq a => a -> a -> Bool
== UsingGeneralizedNewtypeDeriving
NoGeneralizedNewtypeDeriving
    -> [GhcHint
useGND]
    | Bool
otherwise
    -> [GhcHint]
noHints
  DerivErrOnlyAnyClassDeriveable TyCon
_ DeriveAnyClassEnabled
deriveAnyClassEnabled
    | DeriveAnyClassEnabled
deriveAnyClassEnabled DeriveAnyClassEnabled -> DeriveAnyClassEnabled -> Bool
forall a. Eq a => a -> a -> Bool
== DeriveAnyClassEnabled
NoDeriveAnyClassEnabled
    -> [Extension -> GhcHint
suggestExtension Extension
LangExt.DeriveAnyClass]
    | Bool
otherwise
    -> [GhcHint]
noHints
  DerivErrNotDeriveable DeriveAnyClassEnabled
deriveAnyClassEnabled
    | DeriveAnyClassEnabled
deriveAnyClassEnabled DeriveAnyClassEnabled -> DeriveAnyClassEnabled -> Bool
forall a. Eq a => a -> a -> Bool
== DeriveAnyClassEnabled
NoDeriveAnyClassEnabled
    -> [Extension -> GhcHint
suggestExtension Extension
LangExt.DeriveAnyClass]
    | Bool
otherwise
    -> [GhcHint]
noHints
  DerivErrNotAClass{}
    -> [GhcHint]
noHints
  DerivErrNoConstructors{}
    -> let info :: SDoc
info = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"to enable deriving for empty data types"
       in [SDoc -> Extension -> GhcHint
useExtensionInOrderTo SDoc
info Extension
LangExt.EmptyDataDeriving]
  DerivErrLangExtRequired{}
    -- This is a slightly weird corner case of GHC: we are failing
    -- to derive a typeclass instance because a particular 'Extension'
    -- is not enabled (and so we report in the main error), but here
    -- we don't want to /repeat/ to enable the extension in the hint.
    -> [GhcHint]
noHints
  DerivErrDunnoHowToDeriveForType{}
    -> [GhcHint]
noHints
  DerivErrMustBeEnumType TyCon
rep_tc
    -- We want to suggest GND only if this /is/ a newtype.
    | UsingGeneralizedNewtypeDeriving
newtype_deriving UsingGeneralizedNewtypeDeriving
-> UsingGeneralizedNewtypeDeriving -> Bool
forall a. Eq a => a -> a -> Bool
== UsingGeneralizedNewtypeDeriving
NoGeneralizedNewtypeDeriving Bool -> Bool -> Bool
&& TyCon -> Bool
isNewTyCon TyCon
rep_tc
    -> [GhcHint
useGND]
    | Bool
otherwise
    -> [GhcHint]
noHints
  DerivErrMustHaveExactlyOneConstructor{}
    -> [GhcHint]
noHints
  DerivErrMustHaveSomeParameters{}
    -> [GhcHint]
noHints
  DerivErrMustNotHaveClassContext{}
    -> [GhcHint]
noHints
  DerivErrBadConstructor Maybe HasWildcard
wcard [DeriveInstanceBadConstructor]
_
    -> case Maybe HasWildcard
wcard of
         Maybe HasWildcard
Nothing        -> [GhcHint]
noHints
         Just HasWildcard
YesHasWildcard -> [GhcHint
SuggestFillInWildcardConstraint]
         Just HasWildcard
NoHasWildcard  -> [GhcHint
SuggestAddStandaloneDerivation]
  DerivErrGenerics{}
    -> [GhcHint]
noHints
  DerivErrEnumOrProduct{}
    -> [GhcHint]
noHints

messageWithInfoDiagnosticMessage :: UnitState
                                 -> ErrInfo
                                 -> Bool
                                 -> DecoratedSDoc
                                 -> DecoratedSDoc
messageWithInfoDiagnosticMessage :: UnitState -> ErrInfo -> Bool -> DecoratedSDoc -> DecoratedSDoc
messageWithInfoDiagnosticMessage UnitState
unit_state ErrInfo{SDoc
errInfoContext :: ErrInfo -> SDoc
errInfoSupplementary :: ErrInfo -> SDoc
errInfoContext :: SDoc
errInfoSupplementary :: SDoc
..} Bool
show_ctxt DecoratedSDoc
important =
  let err_info' :: [SDoc]
err_info' = (SDoc -> SDoc) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (UnitState -> SDoc -> SDoc
pprWithUnitState UnitState
unit_state) ([SDoc
errInfoContext | Bool
show_ctxt] [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [SDoc
errInfoSupplementary])
      in ((SDoc -> SDoc) -> DecoratedSDoc -> DecoratedSDoc
mapDecoratedSDoc (UnitState -> SDoc -> SDoc
pprWithUnitState UnitState
unit_state) DecoratedSDoc
important) DecoratedSDoc -> DecoratedSDoc -> DecoratedSDoc
`unionDecoratedSDoc`
         [SDoc] -> DecoratedSDoc
mkDecorated [SDoc]
err_info'

dodgy_msg :: (Outputable a, Outputable b) => SDoc -> a -> b -> SDoc
dodgy_msg :: forall a b. (Outputable a, Outputable b) => SDoc -> a -> b -> SDoc
dodgy_msg SDoc
kind a
tc b
ie
  = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
kind SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"item"
                     SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (b -> SDoc
forall a. Outputable a => a -> SDoc
ppr b
ie)
                SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"suggests that",
          SDoc -> SDoc
quotes (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
tc) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has (in-scope) constructors or class methods,",
          String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but it has none" ]

dodgy_msg_insert :: forall p . (Anno (IdP (GhcPass p)) ~ SrcSpanAnnN) => IdP (GhcPass p) -> IE (GhcPass p)
dodgy_msg_insert :: forall (p :: Pass).
(Anno (IdP (GhcPass p)) ~ SrcSpanAnnN) =>
IdP (GhcPass p) -> IE (GhcPass p)
dodgy_msg_insert IdP (GhcPass p)
tc = XIEThingAll (GhcPass p)
-> LIEWrappedName (GhcPass p) -> IE (GhcPass p)
forall pass. XIEThingAll pass -> LIEWrappedName pass -> IE pass
IEThingAll XIEThingAll (GhcPass p)
EpAnn [AddEpAnn]
forall a. EpAnn a
noAnn LIEWrappedName (GhcPass p)
ii
  where
    ii :: LIEWrappedName (GhcPass p)
    ii :: LIEWrappedName (GhcPass p)
ii = IEWrappedName (GhcPass p)
-> LocatedAn AnnListItem (IEWrappedName (GhcPass p))
forall a an. a -> LocatedAn an a
noLocA (XIEName (GhcPass p)
-> LIdP (GhcPass p) -> IEWrappedName (GhcPass p)
forall p. XIEName p -> LIdP p -> IEWrappedName p
IEName XIEName (GhcPass p)
NoExtField
noExtField (LIdP (GhcPass p) -> IEWrappedName (GhcPass p))
-> LIdP (GhcPass p) -> IEWrappedName (GhcPass p)
forall a b. (a -> b) -> a -> b
$ IdGhcP p -> LocatedAn NameAnn (IdGhcP p)
forall a an. a -> LocatedAn an a
noLocA IdP (GhcPass p)
IdGhcP p
tc)

pprTypeDoesNotHaveFixedRuntimeRep :: Type -> FixedRuntimeRepProvenance -> SDoc
pprTypeDoesNotHaveFixedRuntimeRep :: Type -> FixedRuntimeRepProvenance -> SDoc
pprTypeDoesNotHaveFixedRuntimeRep Type
ty FixedRuntimeRepProvenance
prov =
  let what :: SDoc
what = FixedRuntimeRepProvenance -> SDoc
pprFixedRuntimeRepProvenance FixedRuntimeRepProvenance
prov
  in String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not have a fixed runtime representation:"
  SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Type -> SDoc
format_frr_err Type
ty

format_frr_err :: Type  -- ^ the type which doesn't have a fixed runtime representation
                -> SDoc
format_frr_err :: Type -> SDoc
format_frr_err Type
ty
  = (SDoc
bullet SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
tidy_ty SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
tidy_ki)
  where
    (TidyEnv
tidy_env, Type
tidy_ty) = TidyEnv -> Type -> (TidyEnv, Type)
tidyOpenType TidyEnv
emptyTidyEnv Type
ty
    tidy_ki :: Type
tidy_ki             = TidyEnv -> Type -> Type
tidyType TidyEnv
tidy_env ((() :: Constraint) => Type -> Type
Type -> Type
typeKind Type
ty)

pprField :: (FieldLabelString, TcType) -> SDoc
pprField :: (FieldLabelString, Type) -> SDoc
pprField (FieldLabelString
f,Type
ty) = FieldLabelString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FieldLabelString
f SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty

pprRecordFieldPart :: RecordFieldPart -> SDoc
pprRecordFieldPart :: RecordFieldPart -> SDoc
pprRecordFieldPart = \case
  RecordFieldConstructor{} -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"construction"
  RecordFieldPattern{}     -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"pattern"
  RecordFieldPart
RecordFieldUpdate        -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"update"

pprBindings :: [Name] -> SDoc
pprBindings :: [Name] -> SDoc
pprBindings = (Name -> SDoc) -> [Name] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas (SDoc -> SDoc
quotes (SDoc -> SDoc) -> (Name -> SDoc) -> Name -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr)

injectivityErrorHerald :: SDoc
injectivityErrorHerald :: SDoc
injectivityErrorHerald =
  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Type family equation violates the family's injectivity annotation."

formatExportItemError :: SDoc -> String -> SDoc
formatExportItemError :: SDoc -> String -> SDoc
formatExportItemError SDoc
exportedThing String
reason =
  [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The export item"
       , SDoc -> SDoc
quotes SDoc
exportedThing
       , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
reason ]

-- | What warning flag is associated with the given missing signature?
missingSignatureWarningFlag :: MissingSignature -> Exported -> Bool -> WarningFlag
missingSignatureWarningFlag :: MissingSignature -> Exported -> Bool -> WarningFlag
missingSignatureWarningFlag (MissingTopLevelBindingSig {}) Exported
exported Bool
overridden
  | Exported
IsExported <- Exported
exported
  , Bool -> Bool
not Bool
overridden
  = WarningFlag
Opt_WarnMissingExportedSignatures
  | Bool
otherwise
  = WarningFlag
Opt_WarnMissingSignatures
missingSignatureWarningFlag (MissingPatSynSig {}) Exported
exported Bool
overridden
  | Exported
IsExported <- Exported
exported
  , Bool -> Bool
not Bool
overridden
  = WarningFlag
Opt_WarnMissingExportedPatternSynonymSignatures
  | Bool
otherwise
  = WarningFlag
Opt_WarnMissingPatternSynonymSignatures
missingSignatureWarningFlag (MissingTyConKindSig {}) Exported
_ Bool
_
  = WarningFlag
Opt_WarnMissingKindSignatures

useDerivingStrategies :: GhcHint
useDerivingStrategies :: GhcHint
useDerivingStrategies =
  SDoc -> Extension -> GhcHint
useExtensionInOrderTo (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"to pick a different strategy") Extension
LangExt.DerivingStrategies

useGND :: GhcHint
useGND :: GhcHint
useGND = let info :: SDoc
info = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"for GHC's" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"newtype-deriving extension"
         in SDoc -> Extension -> GhcHint
suggestExtensionWithInfo SDoc
info Extension
LangExt.GeneralizedNewtypeDeriving

cannotMakeDerivedInstanceHerald :: Class
                                -> [Type]
                                -> Maybe (DerivStrategy GhcTc)
                                -> UsingGeneralizedNewtypeDeriving
                                -> Bool -- ^ If False, only prints the why.
                                -> SDoc
                                -> SDoc
cannotMakeDerivedInstanceHerald :: Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_args Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald SDoc
why =
  if Bool
pprHerald
     then [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [(SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Can't make a derived instance of")
                   Int
2 (SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
pred) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
via_mechanism)
                SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
2 SDoc
extra) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon,
               Int -> SDoc -> SDoc
nest Int
2 SDoc
why]
      else SDoc
why
  where
    strat_used :: Bool
strat_used = Maybe (DerivStrategy GhcTc) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (DerivStrategy GhcTc)
mb_strat
    extra :: SDoc
extra | Bool -> Bool
not Bool
strat_used, (UsingGeneralizedNewtypeDeriving
newtype_deriving UsingGeneralizedNewtypeDeriving
-> UsingGeneralizedNewtypeDeriving -> Bool
forall a. Eq a => a -> a -> Bool
== UsingGeneralizedNewtypeDeriving
YesGeneralizedNewtypeDeriving)
          = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(even with cunning GeneralizedNewtypeDeriving)"
          | Bool
otherwise = SDoc
forall doc. IsOutput doc => doc
empty
    pred :: Type
pred = Class -> [Type] -> Type
mkClassPred Class
cls [Type]
cls_args
    via_mechanism :: SDoc
via_mechanism | Bool
strat_used
                  , Just DerivStrategy GhcTc
strat <- Maybe (DerivStrategy GhcTc)
mb_strat
                  = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"with the" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (DerivStrategy GhcTc -> SDoc
forall a. DerivStrategy a -> SDoc
derivStrategyName DerivStrategy GhcTc
strat) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"strategy"
                  | Bool
otherwise
                  = SDoc
forall doc. IsOutput doc => doc
empty

badCon :: DataCon -> SDoc -> SDoc
badCon :: DataCon -> SDoc -> SDoc
badCon DataCon
con SDoc
msg = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Constructor" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
con) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
msg

derivErrDiagnosticMessage :: Class
                          -> [Type]
                          -> Maybe (DerivStrategy GhcTc)
                          -> UsingGeneralizedNewtypeDeriving
                          -> Bool -- If True, includes the herald \"can't make a derived..\"
                          -> DeriveInstanceErrReason
                          -> SDoc
derivErrDiagnosticMessage :: Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> DeriveInstanceErrReason
-> SDoc
derivErrDiagnosticMessage Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald = \case
  DerivErrNotWellKinded TyCon
tc Type
cls_kind Int
_
    -> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cannot derive well-kinded instance of form"
                         SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Class -> [Type] -> SDoc
pprClassPred Class
cls [Type]
cls_tys
                                       SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"...")))
                  Int
2 SDoc
forall doc. IsOutput doc => doc
empty
           , Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Class" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
cls)
                         SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"expects an argument of kind"
                         SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
pprKind Type
cls_kind))
           ]
  DeriveInstanceErrReason
DerivErrSafeHaskellGenericInst
    ->     String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Generic instances can only be derived in"
       SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Safe Haskell using the stock strategy."
  DerivErrDerivingViaWrongKind Type
cls_kind Type
via_ty Type
via_kind
    -> SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cannot derive instance via" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
pprType Type
via_ty))
          Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Class" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
cls)
                  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"expects an argument of kind"
                  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
pprKind Type
cls_kind) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
','
         SDoc -> SDoc -> SDoc
$+$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
pprType Type
via_ty)
                  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has kind" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
pprKind Type
via_kind))
  DerivErrNoEtaReduce Type
inst_ty
    -> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cannot eta-reduce to an instance of form",
            Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"instance (...) =>"
                   SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Class -> [Type] -> SDoc
pprClassPred Class
cls ([Type]
cls_tys [Type] -> [Type] -> [Type]
forall a. [a] -> [a] -> [a]
++ [Type
inst_ty]))]
  DeriveInstanceErrReason
DerivErrBootFileFound
    -> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
         (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cannot derive instances in hs-boot files"
          SDoc -> SDoc -> SDoc
$+$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Write an instance declaration instead")
  DerivErrDataConsNotAllInScope TyCon
tc
    -> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
         (SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The data constructors of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"are not all in scope")
            Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"so you cannot derive an instance for it"))
  DeriveInstanceErrReason
DerivErrGNDUsedOnData
    -> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
         (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"GeneralizedNewtypeDeriving cannot be used on non-newtypes")
  DeriveInstanceErrReason
DerivErrNullaryClasses
    -> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
         (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cannot derive instances for nullary classes")
  DeriveInstanceErrReason
DerivErrLastArgMustBeApp
    -> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
         ( String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The last argument of the instance must be a"
         SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"data or newtype application")
  DerivErrNoFamilyInstance TyCon
tc [Type]
tc_args
    -> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
         (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"No family instance for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> [Type] -> SDoc
pprTypeApp TyCon
tc [Type]
tc_args))
  DerivErrNotStockDeriveable DeriveAnyClassEnabled
_
    -> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
         (SDoc -> SDoc
quotes (Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
cls) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not a stock derivable class (Eq, Show, etc.)")
  DerivErrHasAssociatedDatatypes HasAssociatedDataFamInsts
hasAdfs AssociatedTyLastVarInKind
at_last_cls_tv_in_kinds AssociatedTyNotParamOverLastTyVar
at_without_last_cls_tv
    -> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
         (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (HasAssociatedDataFamInsts
hasAdfs HasAssociatedDataFamInsts -> HasAssociatedDataFamInsts -> Bool
forall a. Eq a => a -> a -> Bool
== HasAssociatedDataFamInsts
YesHasAdfs) SDoc
adfs_msg
               , case AssociatedTyNotParamOverLastTyVar
at_without_last_cls_tv of
                    YesAssociatedTyNotParamOverLastTyVar TyCon
tc -> TyCon -> SDoc
at_without_last_cls_tv_msg TyCon
tc
                    AssociatedTyNotParamOverLastTyVar
NoAssociatedTyNotParamOverLastTyVar     -> SDoc
forall doc. IsOutput doc => doc
empty
               , case AssociatedTyLastVarInKind
at_last_cls_tv_in_kinds of
                   YesAssocTyLastVarInKind TyCon
tc -> TyCon -> SDoc
at_last_cls_tv_in_kinds_msg TyCon
tc
                   AssociatedTyLastVarInKind
NoAssocTyLastVarInKind     -> SDoc
forall doc. IsOutput doc => doc
empty
               ]
       where

         adfs_msg :: SDoc
adfs_msg  = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the class has associated data types"

         at_without_last_cls_tv_msg :: TyCon -> SDoc
at_without_last_cls_tv_msg TyCon
at_tc = SDoc -> Int -> SDoc -> SDoc
hang
           (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the associated type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
at_tc)
            SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not parameterized over the last type variable")
           Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"of the class" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
cls))

         at_last_cls_tv_in_kinds_msg :: TyCon -> SDoc
at_last_cls_tv_in_kinds_msg TyCon
at_tc = SDoc -> Int -> SDoc -> SDoc
hang
           (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the associated type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
at_tc)
            SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"contains the last type variable")
          Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"of the class" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
cls)
            SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in a kind, which is not (yet) allowed")
  DeriveInstanceErrReason
DerivErrNewtypeNonDeriveableClass
    -> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> DeriveInstanceErrReason
-> SDoc
derivErrDiagnosticMessage Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald (DeriveAnyClassEnabled -> DeriveInstanceErrReason
DerivErrNotStockDeriveable DeriveAnyClassEnabled
NoDeriveAnyClassEnabled)
  DerivErrCannotEtaReduceEnough Bool
eta_ok
    -> let cant_derive_err :: SDoc
cant_derive_err = Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppUnless Bool
eta_ok SDoc
eta_msg
           eta_msg :: SDoc
eta_msg = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"cannot eta-reduce the representation type enough"
       in Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
          SDoc
cant_derive_err
  DerivErrOnlyAnyClassDeriveable TyCon
tc DeriveAnyClassEnabled
_
    -> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
         (SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is a type class,"
                          SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"and can only have a derived instance"
                          SDoc -> SDoc -> SDoc
$+$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"if DeriveAnyClass is enabled")
  DerivErrNotDeriveable DeriveAnyClassEnabled
_
    -> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald SDoc
forall doc. IsOutput doc => doc
empty
  DerivErrNotAClass Type
predType
    -> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
         (SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
predType) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not a class")
  DerivErrNoConstructors TyCon
rep_tc
    -> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
         (SDoc -> SDoc
quotes (TyCon -> SDoc
pprSourceTyCon TyCon
rep_tc) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"must have at least one data constructor")
  DerivErrLangExtRequired Extension
ext
    -> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
         (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"You need " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Extension -> SDoc
forall a. Outputable a => a -> SDoc
ppr Extension
ext
            SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"to derive an instance for this class")
  DerivErrDunnoHowToDeriveForType Type
ty
    -> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
        (SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Don't know how to derive" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
cls))
              Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"for type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty)))
  DerivErrMustBeEnumType TyCon
rep_tc
    -> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
         ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ SDoc -> SDoc
quotes (TyCon -> SDoc
pprSourceTyCon TyCon
rep_tc) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"must be an enumeration type"
              , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(an enumeration consists of one or more nullary, non-GADT constructors)" ])

  DerivErrMustHaveExactlyOneConstructor TyCon
rep_tc
    -> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
         (SDoc -> SDoc
quotes (TyCon -> SDoc
pprSourceTyCon TyCon
rep_tc) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"must have precisely one constructor")
  DerivErrMustHaveSomeParameters TyCon
rep_tc
    -> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
         (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Data type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
rep_tc) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"must have some type parameters")
  DerivErrMustNotHaveClassContext TyCon
rep_tc [Type]
bad_stupid_theta
    -> Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
         (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Data type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
rep_tc)
           SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"must not have a class context:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [Type] -> SDoc
pprTheta [Type]
bad_stupid_theta)
  DerivErrBadConstructor Maybe HasWildcard
_ [DeriveInstanceBadConstructor]
reasons
    -> let why :: SDoc
why = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (DeriveInstanceBadConstructor -> SDoc)
-> [DeriveInstanceBadConstructor] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map DeriveInstanceBadConstructor -> SDoc
renderReason [DeriveInstanceBadConstructor]
reasons
       in Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald SDoc
why
         where
           renderReason :: DeriveInstanceBadConstructor -> SDoc
renderReason = \case
                 DerivErrBadConExistential DataCon
con
                   -> DataCon -> SDoc -> SDoc
badCon DataCon
con (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"must be truly polymorphic in the last argument of the data type"
                 DerivErrBadConCovariant DataCon
con
                   -> DataCon -> SDoc -> SDoc
badCon DataCon
con (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"must not use the type variable in a function argument"
                 DerivErrBadConFunTypes DataCon
con
                   -> DataCon -> SDoc -> SDoc
badCon DataCon
con (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"must not contain function types"
                 DerivErrBadConWrongArg DataCon
con
                   -> DataCon -> SDoc -> SDoc
badCon DataCon
con (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"must use the type variable only as the last argument of a data type"
                 DerivErrBadConIsGADT DataCon
con
                   -> DataCon -> SDoc -> SDoc
badCon DataCon
con (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is a GADT"
                 DerivErrBadConHasExistentials DataCon
con
                   -> DataCon -> SDoc -> SDoc
badCon DataCon
con (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has existential type variables in its type"
                 DerivErrBadConHasConstraints DataCon
con
                   -> DataCon -> SDoc -> SDoc
badCon DataCon
con (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has constraints in its type"
                 DerivErrBadConHasHigherRankType DataCon
con
                   -> DataCon -> SDoc -> SDoc
badCon DataCon
con (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has a higher-rank type"
  DerivErrGenerics [DeriveGenericsErrReason]
reasons
    -> let why :: SDoc
why = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (DeriveGenericsErrReason -> SDoc)
-> [DeriveGenericsErrReason] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map DeriveGenericsErrReason -> SDoc
renderReason [DeriveGenericsErrReason]
reasons
       in Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald SDoc
why
         where
           renderReason :: DeriveGenericsErrReason -> SDoc
renderReason = \case
             DerivErrGenericsMustNotHaveDatatypeContext TyCon
tc_name
                -> TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc_name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"must not have a datatype context"
             DerivErrGenericsMustNotHaveExoticArgs DataCon
dc
                -> DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
dc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"must not have exotic unlifted or polymorphic arguments"
             DerivErrGenericsMustBeVanillaDataCon DataCon
dc
                -> DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
dc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"must be a vanilla data constructor"
             DerivErrGenericsMustHaveSomeTypeParams TyCon
rep_tc
                ->     String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Data type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
rep_tc)
                   SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"must have some type parameters"
             DerivErrGenericsMustNotHaveExistentials DataCon
con
               -> DataCon -> SDoc -> SDoc
badCon DataCon
con (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"must not have existential arguments"
             DerivErrGenericsWrongArgKind DataCon
con
               -> DataCon -> SDoc -> SDoc
badCon DataCon
con (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"applies a type to an argument involving the last parameter"
                 SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but the applied type is not of kind * -> *"
  DerivErrEnumOrProduct DeriveInstanceErrReason
this DeriveInstanceErrReason
that
    -> let ppr1 :: SDoc
ppr1 = Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> DeriveInstanceErrReason
-> SDoc
derivErrDiagnosticMessage Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
False DeriveInstanceErrReason
this
           ppr2 :: SDoc
ppr2 = Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> DeriveInstanceErrReason
-> SDoc
derivErrDiagnosticMessage Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
False DeriveInstanceErrReason
that
       in Class
-> [Type]
-> Maybe (DerivStrategy GhcTc)
-> UsingGeneralizedNewtypeDeriving
-> Bool
-> SDoc
-> SDoc
cannotMakeDerivedInstanceHerald Class
cls [Type]
cls_tys Maybe (DerivStrategy GhcTc)
mb_strat UsingGeneralizedNewtypeDeriving
newtype_deriving Bool
pprHerald
          (SDoc
ppr1 SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"  or" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc
ppr2)

{- *********************************************************************
*                                                                      *
              Outputable SolverReportErrCtxt (for debugging)
*                                                                      *
**********************************************************************-}

instance Outputable SolverReportErrCtxt where
  ppr :: SolverReportErrCtxt -> SDoc
ppr (CEC { cec_binds :: SolverReportErrCtxt -> EvBindsVar
cec_binds              = EvBindsVar
bvar
           , cec_defer_type_errors :: SolverReportErrCtxt -> DiagnosticReason
cec_defer_type_errors  = DiagnosticReason
dte
           , cec_expr_holes :: SolverReportErrCtxt -> DiagnosticReason
cec_expr_holes         = DiagnosticReason
eh
           , cec_type_holes :: SolverReportErrCtxt -> DiagnosticReason
cec_type_holes         = DiagnosticReason
th
           , cec_out_of_scope_holes :: SolverReportErrCtxt -> DiagnosticReason
cec_out_of_scope_holes = DiagnosticReason
osh
           , cec_warn_redundant :: SolverReportErrCtxt -> Bool
cec_warn_redundant     = Bool
wr
           , cec_expand_syns :: SolverReportErrCtxt -> Bool
cec_expand_syns        = Bool
es
           , cec_suppress :: SolverReportErrCtxt -> Bool
cec_suppress           = Bool
sup })
    = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"CEC" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
         [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"cec_binds"              SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
forall doc. IsLine doc => doc
equals SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> EvBindsVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr EvBindsVar
bvar
         , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"cec_defer_type_errors"  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
forall doc. IsLine doc => doc
equals SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> DiagnosticReason -> SDoc
forall a. Outputable a => a -> SDoc
ppr DiagnosticReason
dte
         , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"cec_expr_holes"         SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
forall doc. IsLine doc => doc
equals SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> DiagnosticReason -> SDoc
forall a. Outputable a => a -> SDoc
ppr DiagnosticReason
eh
         , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"cec_type_holes"         SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
forall doc. IsLine doc => doc
equals SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> DiagnosticReason -> SDoc
forall a. Outputable a => a -> SDoc
ppr DiagnosticReason
th
         , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"cec_out_of_scope_holes" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
forall doc. IsLine doc => doc
equals SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> DiagnosticReason -> SDoc
forall a. Outputable a => a -> SDoc
ppr DiagnosticReason
osh
         , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"cec_warn_redundant"     SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
forall doc. IsLine doc => doc
equals SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
wr
         , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"cec_expand_syns"        SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
forall doc. IsLine doc => doc
equals SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
es
         , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"cec_suppress"           SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
forall doc. IsLine doc => doc
equals SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
sup ])

{- *********************************************************************
*                                                                      *
                    Outputting TcSolverReportMsg errors
*                                                                      *
**********************************************************************-}

-- | Pretty-print a 'SolverReportWithCtxt', containing a 'TcSolverReportMsg'
-- with its enclosing 'SolverReportErrCtxt'.
pprSolverReportWithCtxt :: SolverReportWithCtxt -> SDoc
pprSolverReportWithCtxt :: SolverReportWithCtxt -> SDoc
pprSolverReportWithCtxt (SolverReportWithCtxt { reportContext :: SolverReportWithCtxt -> SolverReportErrCtxt
reportContext = SolverReportErrCtxt
ctxt, reportContent :: SolverReportWithCtxt -> TcSolverReportMsg
reportContent = TcSolverReportMsg
msg })
   = SolverReportErrCtxt -> TcSolverReportMsg -> SDoc
pprTcSolverReportMsg SolverReportErrCtxt
ctxt TcSolverReportMsg
msg

-- | Pretty-print a 'TcSolverReportMsg', with its enclosing 'SolverReportErrCtxt'.
pprTcSolverReportMsg :: SolverReportErrCtxt -> TcSolverReportMsg -> SDoc
pprTcSolverReportMsg :: SolverReportErrCtxt -> TcSolverReportMsg -> SDoc
pprTcSolverReportMsg SolverReportErrCtxt
_ (BadTelescope TyVarBndrs
telescope [TcTyVar]
skols) =
  SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"These kind and type variables:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TyVarBndrs -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVarBndrs
telescope SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
       String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"are out of dependency order. Perhaps try this ordering:")
    Int
2 ([TcTyVar] -> SDoc
pprTyVars [TcTyVar]
sorted_tvs)
  where
    sorted_tvs :: [TcTyVar]
sorted_tvs = [TcTyVar] -> [TcTyVar]
scopedSort [TcTyVar]
skols
pprTcSolverReportMsg SolverReportErrCtxt
_ (UserTypeError Type
ty) =
  Type -> SDoc
pprUserTypeErrorTy Type
ty
pprTcSolverReportMsg SolverReportErrCtxt
ctxt (ReportHoleError Hole
hole HoleError
err) =
  SolverReportErrCtxt -> Hole -> HoleError -> SDoc
pprHoleError SolverReportErrCtxt
ctxt Hole
hole HoleError
err
pprTcSolverReportMsg SolverReportErrCtxt
ctxt
  (CannotUnifyVariable
    { mismatchMsg :: TcSolverReportMsg -> MismatchMsg
mismatchMsg         = MismatchMsg
msg
    , cannotUnifyReason :: TcSolverReportMsg -> CannotUnifyVariableReason
cannotUnifyReason   = CannotUnifyVariableReason
reason })
  =  SolverReportErrCtxt -> MismatchMsg -> SDoc
pprMismatchMsg SolverReportErrCtxt
ctxt MismatchMsg
msg
  SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SolverReportErrCtxt -> CannotUnifyVariableReason -> SDoc
pprCannotUnifyVariableReason SolverReportErrCtxt
ctxt CannotUnifyVariableReason
reason
pprTcSolverReportMsg SolverReportErrCtxt
ctxt
  (Mismatch
     { mismatchMsg :: TcSolverReportMsg -> MismatchMsg
mismatchMsg           = MismatchMsg
mismatch_msg
     , mismatchTyVarInfo :: TcSolverReportMsg -> Maybe TyVarInfo
mismatchTyVarInfo     = Maybe TyVarInfo
tv_info
     , mismatchAmbiguityInfo :: TcSolverReportMsg -> [AmbiguityInfo]
mismatchAmbiguityInfo = [AmbiguityInfo]
ambig_infos
     , mismatchCoercibleInfo :: TcSolverReportMsg -> Maybe CoercibleMsg
mismatchCoercibleInfo = Maybe CoercibleMsg
coercible_info })
  = SDoc -> Int -> SDoc -> SDoc
hang (SolverReportErrCtxt -> MismatchMsg -> SDoc
pprMismatchMsg SolverReportErrCtxt
ctxt MismatchMsg
mismatch_msg)
     Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ( SDoc -> (TyVarInfo -> SDoc) -> Maybe TyVarInfo -> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SDoc
forall doc. IsOutput doc => doc
empty (SolverReportErrCtxt -> TyVarInfo -> SDoc
pprTyVarInfo SolverReportErrCtxt
ctxt) Maybe TyVarInfo
tv_info
             SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: SDoc -> (CoercibleMsg -> SDoc) -> Maybe CoercibleMsg -> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SDoc
forall doc. IsOutput doc => doc
empty CoercibleMsg -> SDoc
pprCoercibleMsg Maybe CoercibleMsg
coercible_info
             SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: (AmbiguityInfo -> SDoc) -> [AmbiguityInfo] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map AmbiguityInfo -> SDoc
pprAmbiguityInfo [AmbiguityInfo]
ambig_infos ))
pprTcSolverReportMsg SolverReportErrCtxt
_ (FixedRuntimeRepError [FixedRuntimeRepErrorInfo]
frr_origs) =
  [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((FixedRuntimeRepErrorInfo -> SDoc)
-> [FixedRuntimeRepErrorInfo] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map FixedRuntimeRepErrorInfo -> SDoc
make_msg [FixedRuntimeRepErrorInfo]
frr_origs)
  where
    -- Assemble the error message: pair up each origin with the corresponding type, e.g.
    --   • FixedRuntimeRep origin msg 1 ...
    --       a :: TYPE r1
    --   • FixedRuntimeRep origin msg 2 ...
    --       b :: TYPE r2
    make_msg :: FixedRuntimeRepErrorInfo -> SDoc
    make_msg :: FixedRuntimeRepErrorInfo -> SDoc
make_msg (FRR_Info { frr_info_origin :: FixedRuntimeRepErrorInfo -> FixedRuntimeRepOrigin
frr_info_origin =
                           FixedRuntimeRepOrigin
                             { frr_type :: FixedRuntimeRepOrigin -> Type
frr_type    = Type
ty
                             , frr_context :: FixedRuntimeRepOrigin -> FixedRuntimeRepContext
frr_context = FixedRuntimeRepContext
frr_ctxt }
                       , frr_info_not_concrete :: FixedRuntimeRepErrorInfo -> Maybe (TcTyVar, Type)
frr_info_not_concrete =
                         Maybe (TcTyVar, Type)
mb_not_conc }) =
      -- Add bullet points if there is more than one error.
      (if [FixedRuntimeRepErrorInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FixedRuntimeRepErrorInfo]
frr_origs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then (SDoc
bullet SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>) else SDoc -> SDoc
forall a. a -> a
id) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
        [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ FixedRuntimeRepContext -> SDoc
pprFixedRuntimeRepContext FixedRuntimeRepContext
frr_ctxt
                   , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not have a fixed runtime representation." ]
             , Type -> SDoc
type_printout Type
ty
             , case Maybe (TcTyVar, Type)
mb_not_conc of
                Maybe (TcTyVar, Type)
Nothing -> SDoc
forall doc. IsOutput doc => doc
empty
                Just (TcTyVar
conc_tv, Type
not_conc) ->
                  TcTyVar -> Type -> SDoc
unsolved_concrete_eq_explanation TcTyVar
conc_tv Type
not_conc ]

    -- Don't print out the type (only the kind), if the type includes
    -- a confusing cast, unless the user passed -fprint-explicit-coercions.
    --
    -- Example:
    --
    --   In T20363, we have a representation-polymorphism error with a type
    --   of the form
    --
    --     ( (# #) |> co ) :: TYPE NilRep
    --
    --   where NilRep is a nullary type family application which reduces to TupleRep '[].
    --   We prefer avoiding showing the cast to the user, but we also don't want to
    --   print the confusing:
    --
    --     (# #) :: TYPE NilRep
    --
    --  So in this case we simply don't print the type, only the kind.
    confusing_cast :: Type -> Bool
    confusing_cast :: Type -> Bool
confusing_cast Type
ty =
      case Type
ty of
        CastTy Type
inner_ty KindCoercion
_
          -- A confusing cast is one that is responsible
          -- for a representation-polymorphism error.
          -> Type -> Bool
isConcrete ((() :: Constraint) => Type -> Type
Type -> Type
typeKind Type
inner_ty)
        Type
_ -> Bool
False

    type_printout :: Type -> SDoc
    type_printout :: Type -> SDoc
type_printout Type
ty =
      (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitCoercions ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \ Bool
show_coercions ->
        if  Type -> Bool
confusing_cast Type
ty Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
show_coercions
        then [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Its kind is:"
                  , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Type -> SDoc
pprWithTYPE ((() :: Constraint) => Type -> Type
Type -> Type
typeKind Type
ty)
                  , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(Use -fprint-explicit-coercions to see the full type.)" ]
        else [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Its type is:"
                  , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprWithTYPE ((() :: Constraint) => Type -> Type
Type -> Type
typeKind Type
ty) ]

    unsolved_concrete_eq_explanation :: TcTyVar -> Type -> SDoc
    unsolved_concrete_eq_explanation :: TcTyVar -> Type -> SDoc
unsolved_concrete_eq_explanation TcTyVar
tv Type
not_conc =
          String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cannot unify" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
not_conc)
      SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"with the type variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcTyVar
tv)
      SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"because it is not a concrete" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot
      where
        ki :: Type
ki = TcTyVar -> Type
tyVarKind TcTyVar
tv
        what :: SDoc
        what :: SDoc
what
          | Type -> Bool
isRuntimeRepTy Type
ki
          = SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RuntimeRep")
          | Type -> Bool
isLevityTy Type
ki
          = SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Levity")
          | Bool
otherwise
          = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type"
pprTcSolverReportMsg SolverReportErrCtxt
_ (UntouchableVariable TcTyVar
tv Implication
implic)
  | Implic { ic_given :: Implication -> [TcTyVar]
ic_given = [TcTyVar]
given, ic_info :: Implication -> SkolemInfoAnon
ic_info = SkolemInfoAnon
skol_info } <- Implication
implic
  = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ SDoc -> SDoc
quotes (TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcTyVar
tv) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is untouchable"
        , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"inside the constraints:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TcTyVar] -> SDoc
pprEvVarTheta [TcTyVar]
given
        , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound by" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SkolemInfoAnon -> SDoc
forall a. Outputable a => a -> SDoc
ppr SkolemInfoAnon
skol_info
        , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
          RealSrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TcLclEnv -> RealSrcSpan
getLclEnvLoc (Implication -> TcLclEnv
ic_env Implication
implic)) ]
pprTcSolverReportMsg SolverReportErrCtxt
_ (BlockedEquality ErrorItem
item) =
  [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cannot use equality for substitution:")
           Int
2 (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ErrorItem -> Type
errorItemPred ErrorItem
item))
       , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Doing so would be ill-kinded." ]
pprTcSolverReportMsg SolverReportErrCtxt
_ (ExpectingMoreArguments Int
n TypedThing
thing) =
  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Expecting" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
speakN (Int -> Int
forall a. Num a => a -> a
abs Int
n) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
    SDoc
more SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TypedThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypedThing
thing)
  where
    more :: SDoc
more
     | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1    = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"more argument to"
     | Bool
otherwise = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"more arguments to" -- n > 1
pprTcSolverReportMsg SolverReportErrCtxt
ctxt (UnboundImplicitParams (ErrorItem
item :| [ErrorItem]
items)) =
  let givens :: [Implication]
givens = SolverReportErrCtxt -> [Implication]
getUserGivens SolverReportErrCtxt
ctxt
  in if [Implication] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Implication]
givens
     then CtLoc -> SDoc -> SDoc
addArising (ErrorItem -> CtLoc
errorItemCtLoc ErrorItem
item) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
            [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unbound implicit parameter" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [Type] -> SDoc
forall a. [a] -> SDoc
plural [Type]
preds
                , Int -> SDoc -> SDoc
nest Int
2 ([Type] -> SDoc
pprParendTheta [Type]
preds) ]
     else SolverReportErrCtxt -> MismatchMsg -> SDoc
pprMismatchMsg SolverReportErrCtxt
ctxt ([Implication]
-> NonEmpty ErrorItem -> Maybe CND_Extra -> MismatchMsg
CouldNotDeduce [Implication]
givens (ErrorItem
item ErrorItem -> [ErrorItem] -> NonEmpty ErrorItem
forall a. a -> [a] -> NonEmpty a
:| [ErrorItem]
items) Maybe CND_Extra
forall a. Maybe a
Nothing)
  where
    preds :: [Type]
preds = (ErrorItem -> Type) -> [ErrorItem] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map ErrorItem -> Type
errorItemPred (ErrorItem
item ErrorItem -> [ErrorItem] -> [ErrorItem]
forall a. a -> [a] -> [a]
: [ErrorItem]
items)
pprTcSolverReportMsg SolverReportErrCtxt
_ (AmbiguityPreventsSolvingCt ErrorItem
item ([TcTyVar], [TcTyVar])
ambigs) =
  AmbiguityInfo -> SDoc
pprAmbiguityInfo (Bool -> ([TcTyVar], [TcTyVar]) -> AmbiguityInfo
Ambiguity Bool
True ([TcTyVar], [TcTyVar])
ambigs) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
  CtLoc -> SDoc
pprArising (ErrorItem -> CtLoc
errorItemCtLoc ErrorItem
item) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"prevents the constraint" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
pprParendType (Type -> SDoc) -> Type -> SDoc
forall a b. (a -> b) -> a -> b
$ ErrorItem -> Type
errorItemPred ErrorItem
item)
  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"from being solved."
pprTcSolverReportMsg ctxt :: SolverReportErrCtxt
ctxt@(CEC {cec_encl :: SolverReportErrCtxt -> [Implication]
cec_encl = [Implication]
implics})
  (CannotResolveInstance ErrorItem
item [ClsInst]
unifiers [ClsInst]
candidates [ImportError]
imp_errs [GhcHint]
suggs RelevantBindings
binds)
  =
    [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
      [ SDoc
no_inst_msg
      , Int -> SDoc -> SDoc
nest Int
2 SDoc
extra_note
      , Maybe SDoc
mb_patsyn_prov Maybe SDoc -> SDoc -> SDoc
forall a. Maybe a -> a -> a
`orElse` SDoc
forall doc. IsOutput doc => doc
empty
      , Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (Bool
has_ambigs Bool -> Bool -> Bool
&& Bool -> Bool
not ([ClsInst] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ClsInst]
unifiers Bool -> Bool -> Bool
&& [Implication] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Implication]
useful_givens))
        ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppUnless Bool
lead_with_ambig (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                  AmbiguityInfo -> SDoc
pprAmbiguityInfo (Bool -> ([TcTyVar], [TcTyVar]) -> AmbiguityInfo
Ambiguity Bool
False ([TcTyVar]
ambig_kvs, [TcTyVar]
ambig_tvs))
              , RelevantBindings -> SDoc
pprRelevantBindings RelevantBindings
binds
              , SDoc
potential_msg ])
      , Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (Maybe SDoc -> Bool
forall a. Maybe a -> Bool
isNothing Maybe SDoc
mb_patsyn_prov) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
            -- Don't suggest fixes for the provided context of a pattern
            -- synonym; the right fix is to bind more in the pattern
        [SDoc] -> SDoc
show_fixes (Bool -> Type -> [Implication] -> [SDoc]
ctxtFixes Bool
has_ambigs Type
pred [Implication]
implics
                    [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [SDoc]
drv_fixes [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [SDoc]
naked_sc_fixes)
      , Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (Bool -> Bool
not ([ClsInst] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ClsInst]
candidates))
        (SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"There are instances for similar types:")
            Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((ClsInst -> SDoc) -> [ClsInst] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ClsInst -> SDoc
forall a. Outputable a => a -> SDoc
ppr [ClsInst]
candidates)))
            -- See Note [Report candidate instances]
      , [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (ImportError -> SDoc) -> [ImportError] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ImportError -> SDoc
forall a. Outputable a => a -> SDoc
ppr [ImportError]
imp_errs
      , [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (GhcHint -> SDoc) -> [GhcHint] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map GhcHint -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GhcHint]
suggs ]
  where
    orig :: CtOrigin
orig          = ErrorItem -> CtOrigin
errorItemOrigin ErrorItem
item
    pred :: Type
pred          = ErrorItem -> Type
errorItemPred ErrorItem
item
    (Class
clas, [Type]
tys)   = (() :: Constraint) => Type -> (Class, [Type])
Type -> (Class, [Type])
getClassPredTys Type
pred
    -- See Note [Highlighting ambiguous type variables] in GHC.Tc.Errors
    ([TcTyVar]
ambig_kvs, [TcTyVar]
ambig_tvs) = Type -> ([TcTyVar], [TcTyVar])
ambigTkvsOfTy Type
pred
    ambigs :: [TcTyVar]
ambigs = [TcTyVar]
ambig_kvs [TcTyVar] -> [TcTyVar] -> [TcTyVar]
forall a. [a] -> [a] -> [a]
++ [TcTyVar]
ambig_tvs
    has_ambigs :: Bool
has_ambigs = Bool -> Bool
not ([TcTyVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TcTyVar]
ambigs)
    useful_givens :: [Implication]
useful_givens = CtOrigin -> [Implication] -> [Implication]
discardProvCtxtGivens CtOrigin
orig ([Implication] -> [Implication]
getUserGivensFromImplics [Implication]
implics)
         -- useful_givens are the enclosing implications with non-empty givens,
         -- modulo the horrid discardProvCtxtGivens
    lead_with_ambig :: Bool
lead_with_ambig = Bool -> Bool
not ([TcTyVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TcTyVar]
ambigs)
                   Bool -> Bool -> Bool
&& Bool -> Bool
not ((TcTyVar -> Bool) -> [TcTyVar] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TcTyVar -> Bool
isRuntimeUnkSkol [TcTyVar]
ambigs)
                   Bool -> Bool -> Bool
&& Bool -> Bool
not ([ClsInst] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ClsInst]
unifiers)
                   Bool -> Bool -> Bool
&& [Implication] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Implication]
useful_givens

    no_inst_msg :: SDoc
    no_inst_msg :: SDoc
no_inst_msg
      | Bool
lead_with_ambig
      = SolverReportErrCtxt -> TcSolverReportMsg -> SDoc
pprTcSolverReportMsg SolverReportErrCtxt
ctxt (TcSolverReportMsg -> SDoc) -> TcSolverReportMsg -> SDoc
forall a b. (a -> b) -> a -> b
$ ErrorItem -> ([TcTyVar], [TcTyVar]) -> TcSolverReportMsg
AmbiguityPreventsSolvingCt ErrorItem
item ([TcTyVar]
ambig_kvs, [TcTyVar]
ambig_tvs)
      | Bool
otherwise
      = SolverReportErrCtxt -> MismatchMsg -> SDoc
pprMismatchMsg SolverReportErrCtxt
ctxt (MismatchMsg -> SDoc) -> MismatchMsg -> SDoc
forall a b. (a -> b) -> a -> b
$ [Implication]
-> NonEmpty ErrorItem -> Maybe CND_Extra -> MismatchMsg
CouldNotDeduce [Implication]
useful_givens (ErrorItem
item ErrorItem -> [ErrorItem] -> NonEmpty ErrorItem
forall a. a -> [a] -> NonEmpty a
:| []) Maybe CND_Extra
forall a. Maybe a
Nothing

    -- Report "potential instances" only when the constraint arises
    -- directly from the user's use of an overloaded function
    want_potential :: CtOrigin -> Bool
want_potential (TypeEqOrigin {}) = Bool
False
    want_potential CtOrigin
_                 = Bool
True

    potential_msg :: SDoc
potential_msg
      = Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (Bool -> Bool
not ([ClsInst] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ClsInst]
unifiers) Bool -> Bool -> Bool
&& CtOrigin -> Bool
want_potential CtOrigin
orig) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
          SDoc
potential_hdr SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
          PotentialInstances -> SDoc
potentialInstancesErrMsg (PotentialInstances { matches :: [ClsInst]
matches = [], [ClsInst]
unifiers :: [ClsInst]
unifiers :: [ClsInst]
unifiers })

    potential_hdr :: SDoc
potential_hdr
      = Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen Bool
lead_with_ambig (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Probable fix: use a type annotation to specify what"
        SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TcTyVar] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList [TcTyVar]
ambig_tvs SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"should be."

    mb_patsyn_prov :: Maybe SDoc
    mb_patsyn_prov :: Maybe SDoc
mb_patsyn_prov
      | Bool -> Bool
not Bool
lead_with_ambig
      , ProvCtxtOrigin PSB{ psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
psb_def = L SrcSpanAnnA
_ Pat GhcRn
pat } <- CtOrigin
orig
      = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"In other words, a successful match on the pattern"
                   , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Pat GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr Pat GhcRn
pat
                   , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not provide the constraint" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprParendType Type
pred ])
      | Bool
otherwise = Maybe SDoc
forall a. Maybe a
Nothing

    extra_note :: SDoc
extra_note | (Type -> Bool) -> [Type] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Type -> Bool
isFunTy (TyCon -> [Type] -> [Type]
filterOutInvisibleTypes (Class -> TyCon
classTyCon Class
clas) [Type]
tys)
               = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(maybe you haven't applied a function to enough arguments?)"
               | Class -> Name
className Class
clas Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
typeableClassName  -- Avoid mysterious "No instance for (Typeable T)
               , [Type
_,Type
ty] <- [Type]
tys                        -- Look for (Typeable (k->*) (T k))
               , Just (TyCon
tc,[Type]
_) <- HasCallStack => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
tcSplitTyConApp_maybe Type
ty
               , Bool -> Bool
not (TyCon -> Bool
isTypeFamilyTyCon TyCon
tc)
               = SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"GHC can't yet do polykinded")
                    Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Typeable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                       SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((() :: Constraint) => Type -> Type
Type -> Type
typeKind Type
ty)))
               | Bool
otherwise
               = SDoc
forall doc. IsOutput doc => doc
empty

    drv_fixes :: [SDoc]
drv_fixes = case CtOrigin
orig of
                   CtOrigin
DerivClauseOrigin                  -> [Bool -> SDoc
drv_fix Bool
False]
                   CtOrigin
StandAloneDerivOrigin              -> [Bool -> SDoc
drv_fix Bool
True]
                   DerivOriginDC DataCon
_ Int
_       Bool
standalone -> [Bool -> SDoc
drv_fix Bool
standalone]
                   DerivOriginCoerce TcTyVar
_ Type
_ Type
_ Bool
standalone -> [Bool -> SDoc
drv_fix Bool
standalone]
                   CtOrigin
_                                  -> []

    drv_fix :: Bool -> SDoc
drv_fix Bool
standalone_wildcard
      | Bool
standalone_wildcard
      = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"fill in the wildcard constraint yourself"
      | Bool
otherwise
      = SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"use a standalone 'deriving instance' declaration,")
           Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"so you can specify the instance context yourself")

    -- naked_sc_fix: try to produce a helpful error message for
    -- superclass constraints caught by the subtleties described by
    -- Note [Recursive superclasses] in GHC.TyCl.Instance
    naked_sc_fixes :: [SDoc]
naked_sc_fixes
      | ScOrigin ClsInstOrQC
_ NakedScFlag
NakedSc <- CtOrigin
orig  -- A superclass wanted with no instance decls used yet
      , (Implication -> Bool) -> [Implication] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Implication -> Bool
non_tyvar_preds [Implication]
useful_givens  -- Some non-tyvar givens
      = [[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"If the constraint looks soluble from a superclass of the instance context,"
              , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"read 'Undecidable instances and loopy superclasses' in the user manual" ]]
      | Bool
otherwise = []

    non_tyvar_preds :: UserGiven -> Bool
    non_tyvar_preds :: Implication -> Bool
non_tyvar_preds = (TcTyVar -> Bool) -> [TcTyVar] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TcTyVar -> Bool
non_tyvar_pred ([TcTyVar] -> Bool)
-> (Implication -> [TcTyVar]) -> Implication -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Implication -> [TcTyVar]
ic_given

    non_tyvar_pred :: EvVar -> Bool
    -- Tells if the Given is of form (C ty1 .. tyn), where the tys are not all tyvars
    non_tyvar_pred :: TcTyVar -> Bool
non_tyvar_pred TcTyVar
given = case Type -> Maybe (Class, [Type])
getClassPredTys_maybe (TcTyVar -> Type
idType TcTyVar
given) of
                             Just (Class
_, [Type]
tys) -> Bool -> Bool
not ((Type -> Bool) -> [Type] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Type -> Bool
isTyVarTy [Type]
tys)
                             Maybe (Class, [Type])
Nothing       -> Bool
False

pprTcSolverReportMsg (CEC {cec_encl :: SolverReportErrCtxt -> [Implication]
cec_encl = [Implication]
implics}) (OverlappingInstances ErrorItem
item NonEmpty ClsInst
matches [ClsInst]
unifiers) =
  [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
    [ CtLoc -> SDoc -> SDoc
addArising CtLoc
ct_loc (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
        (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Overlapping instances for"
        SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprType (Class -> [Type] -> Type
mkClassPred Class
clas [Type]
tys))
    , Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppUnless ([SDoc] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SDoc]
matching_givens) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                  [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Matching givens (or their superclasses):"
                      , Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [SDoc]
matching_givens)]
    ,  PotentialInstances -> SDoc
potentialInstancesErrMsg
        (PotentialInstances { matches :: [ClsInst]
matches = NonEmpty ClsInst -> [ClsInst]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty ClsInst
matches, [ClsInst]
unifiers :: [ClsInst]
unifiers :: [ClsInst]
unifiers })
    ,  Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen ([SDoc] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SDoc]
matching_givens Bool -> Bool -> Bool
&& [ClsInst] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (NonEmpty ClsInst -> [ClsInst]
forall a. NonEmpty a -> [a]
NE.tail NonEmpty ClsInst
matches) Bool -> Bool -> Bool
&& [ClsInst] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ClsInst]
unifiers) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
       -- Intuitively, some given matched the wanted in their
       -- flattened or rewritten (from given equalities) form
       -- but the matcher can't figure that out because the
       -- constraints are non-flat and non-rewritten so we
       -- simply report back the whole given
       -- context. Accelerate Smart.hs showed this problem.
         [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"There exists a (perhaps superclass) match:"
             , Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([Implication] -> [SDoc]
pp_givens [Implication]
useful_givens))]

    ,  Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen ([ClsInst] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ClsInst] -> Bool) -> [ClsInst] -> Bool
forall a b. (a -> b) -> a -> b
$ NonEmpty ClsInst -> [ClsInst]
forall a. NonEmpty a -> [a]
NE.tail NonEmpty ClsInst
matches) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
       SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppUnless ([TcTyVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TcTyVar]
tyCoVars) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                        String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The choice depends on the instantiation of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                          SDoc -> SDoc
quotes ((TcTyVar -> SDoc) -> [TcTyVar] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr [TcTyVar]
tyCoVars)
                    , Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppUnless ([TyCon] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyCon]
famTyCons) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                        if ([TcTyVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TcTyVar]
tyCoVars)
                          then
                            String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The choice depends on the result of evaluating" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                              SDoc -> SDoc
quotes ((TyCon -> SDoc) -> [TyCon] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr [TyCon]
famTyCons)
                          else
                            String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"and the result of evaluating" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                              SDoc -> SDoc
quotes ((TyCon -> SDoc) -> [TyCon] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr [TyCon]
famTyCons)
                    , Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen ([SDoc] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([SDoc]
matching_givens)) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"To pick the first instance above, use IncoherentInstances"
                           , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"when compiling the other instance declarations"]
               ])]
  where
    ct_loc :: CtLoc
ct_loc          = ErrorItem -> CtLoc
errorItemCtLoc ErrorItem
item
    orig :: CtOrigin
orig            = CtLoc -> CtOrigin
ctLocOrigin CtLoc
ct_loc
    pred :: Type
pred            = ErrorItem -> Type
errorItemPred ErrorItem
item
    (Class
clas, [Type]
tys)     = (() :: Constraint) => Type -> (Class, [Type])
Type -> (Class, [Type])
getClassPredTys Type
pred
    tyCoVars :: [TcTyVar]
tyCoVars        = [Type] -> [TcTyVar]
tyCoVarsOfTypesList [Type]
tys
    famTyCons :: [TyCon]
famTyCons       = (TyCon -> Bool) -> [TyCon] -> [TyCon]
forall a. (a -> Bool) -> [a] -> [a]
filter TyCon -> Bool
isFamilyTyCon ([TyCon] -> [TyCon]) -> [TyCon] -> [TyCon]
forall a b. (a -> b) -> a -> b
$ (Type -> [TyCon]) -> [Type] -> [TyCon]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (UniqSet TyCon -> [TyCon]
forall elt. UniqSet elt -> [elt]
nonDetEltsUniqSet (UniqSet TyCon -> [TyCon])
-> (Type -> UniqSet TyCon) -> Type -> [TyCon]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> UniqSet TyCon
tyConsOfType) [Type]
tys
    useful_givens :: [Implication]
useful_givens   = CtOrigin -> [Implication] -> [Implication]
discardProvCtxtGivens CtOrigin
orig ([Implication] -> [Implication]
getUserGivensFromImplics [Implication]
implics)
    matching_givens :: [SDoc]
matching_givens = (Implication -> Maybe SDoc) -> [Implication] -> [SDoc]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Implication -> Maybe SDoc
matchable [Implication]
useful_givens
    matchable :: Implication -> Maybe SDoc
matchable implic :: Implication
implic@(Implic { ic_given :: Implication -> [TcTyVar]
ic_given = [TcTyVar]
evvars, ic_info :: Implication -> SkolemInfoAnon
ic_info = SkolemInfoAnon
skol_info })
      = case [Type]
ev_vars_matching of
             [] -> Maybe SDoc
forall a. Maybe a
Nothing
             [Type]
_  -> SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> Int -> SDoc -> SDoc
hang ([Type] -> SDoc
pprTheta [Type]
ev_vars_matching)
                            Int
2 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound by" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SkolemInfoAnon -> SDoc
forall a. Outputable a => a -> SDoc
ppr SkolemInfoAnon
skol_info
                                   , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                                     RealSrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TcLclEnv -> RealSrcSpan
getLclEnvLoc (Implication -> TcLclEnv
ic_env Implication
implic)) ])
        where ev_vars_matching :: [Type]
ev_vars_matching = [ Type
pred
                                 | TcTyVar
ev_var <- [TcTyVar]
evvars
                                 , let pred :: Type
pred = TcTyVar -> Type
evVarPred TcTyVar
ev_var
                                 , (Type -> Bool) -> [Type] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Type -> Bool
can_match (Type
pred Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
: Type -> [Type]
transSuperClasses Type
pred) ]
              can_match :: Type -> Bool
can_match Type
pred
                 = case Type -> Maybe (Class, [Type])
getClassPredTys_maybe Type
pred of
                     Just (Class
clas', [Type]
tys') -> Class
clas' Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== Class
clas
                                          Bool -> Bool -> Bool
&& Maybe Subst -> Bool
forall a. Maybe a -> Bool
isJust ([Type] -> [Type] -> Maybe Subst
tcMatchTys [Type]
tys [Type]
tys')
                     Maybe (Class, [Type])
Nothing -> Bool
False
pprTcSolverReportMsg SolverReportErrCtxt
_ (UnsafeOverlap ErrorItem
item ClsInst
match NonEmpty ClsInst
unsafe_overlapped) =
  [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ CtLoc -> SDoc -> SDoc
addArising CtLoc
ct_loc (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unsafe overlapping instances for"
                  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprType (Class -> [Type] -> Type
mkClassPred Class
clas [Type]
tys))
       , [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The matching instance is:",
              Int -> SDoc -> SDoc
nest Int
2 (ClsInst -> SDoc
pprInstance ClsInst
match)]
       , [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"It is compiled in a Safe module and as such can only"
              , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"overlap instances from the same module, however it"
              , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"overlaps the following instances from different" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"modules:"
              , Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [[ClsInst] -> SDoc
pprInstances ([ClsInst] -> SDoc) -> [ClsInst] -> SDoc
forall a b. (a -> b) -> a -> b
$ NonEmpty ClsInst -> [ClsInst]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty ClsInst
unsafe_overlapped])
              ]
       ]
  where
    ct_loc :: CtLoc
ct_loc      = ErrorItem -> CtLoc
errorItemCtLoc ErrorItem
item
    pred :: Type
pred        = ErrorItem -> Type
errorItemPred ErrorItem
item
    (Class
clas, [Type]
tys) = (() :: Constraint) => Type -> (Class, [Type])
Type -> (Class, [Type])
getClassPredTys Type
pred

pprCannotUnifyVariableReason :: SolverReportErrCtxt -> CannotUnifyVariableReason -> SDoc
pprCannotUnifyVariableReason :: SolverReportErrCtxt -> CannotUnifyVariableReason -> SDoc
pprCannotUnifyVariableReason SolverReportErrCtxt
ctxt (CannotUnifyWithPolytype ErrorItem
item TcTyVar
tv1 Type
ty2 Maybe TyVarInfo
mb_tv_info) =
  [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ (if TcTyVar -> Bool
isSkolemTyVar TcTyVar
tv1
          then String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cannot equate type variable"
          else String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cannot instantiate unification variable")
         SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcTyVar
tv1)
       , SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"with a" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"involving polytypes:") Int
2 (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty2)
       , SDoc -> (TyVarInfo -> SDoc) -> Maybe TyVarInfo -> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SDoc
forall doc. IsOutput doc => doc
empty (SolverReportErrCtxt -> TyVarInfo -> SDoc
pprTyVarInfo SolverReportErrCtxt
ctxt) Maybe TyVarInfo
mb_tv_info ]
  where
    what :: SDoc
what = String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ TypeOrKind -> String
levelString (TypeOrKind -> String) -> TypeOrKind -> String
forall a b. (a -> b) -> a -> b
$
           CtLoc -> Maybe TypeOrKind
ctLocTypeOrKind_maybe (ErrorItem -> CtLoc
errorItemCtLoc ErrorItem
item) Maybe TypeOrKind -> TypeOrKind -> TypeOrKind
forall a. Maybe a -> a -> a
`orElse` TypeOrKind
TypeLevel

pprCannotUnifyVariableReason SolverReportErrCtxt
_ (SkolemEscape ErrorItem
item Implication
implic [TcTyVar]
esc_skols) =
  let
    esc_doc :: SDoc
esc_doc = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"because" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [TcTyVar] -> SDoc
forall a. [a] -> SDoc
plural [TcTyVar]
esc_skols
                SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TcTyVar] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList [TcTyVar]
esc_skols
              , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"would escape" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                if [TcTyVar] -> Bool
forall a. [a] -> Bool
isSingleton [TcTyVar]
esc_skols then String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"its scope"
                                         else String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"their scope" ]
  in
  [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc
esc_doc
       , [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ (if [TcTyVar] -> Bool
forall a. [a] -> Bool
isSingleton [TcTyVar]
esc_skols
                then String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"This (rigid, skolem)" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                     SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"variable is"
                else String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"These (rigid, skolem)" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                     SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"variables are")
         SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound by"
       , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SkolemInfoAnon -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Implication -> SkolemInfoAnon
ic_info Implication
implic)
       , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
         RealSrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TcLclEnv -> RealSrcSpan
getLclEnvLoc (Implication -> TcLclEnv
ic_env Implication
implic)) ] ]
  where
    what :: SDoc
what = String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ TypeOrKind -> String
levelString (TypeOrKind -> String) -> TypeOrKind -> String
forall a b. (a -> b) -> a -> b
$
           CtLoc -> Maybe TypeOrKind
ctLocTypeOrKind_maybe (ErrorItem -> CtLoc
errorItemCtLoc ErrorItem
item) Maybe TypeOrKind -> TypeOrKind -> TypeOrKind
forall a. Maybe a -> a -> a
`orElse` TypeOrKind
TypeLevel

pprCannotUnifyVariableReason SolverReportErrCtxt
ctxt
  (OccursCheck
    { occursCheckInterestingTyVars :: CannotUnifyVariableReason -> [TcTyVar]
occursCheckInterestingTyVars = [TcTyVar]
interesting_tvs
    , occursCheckAmbiguityInfos :: CannotUnifyVariableReason -> [AmbiguityInfo]
occursCheckAmbiguityInfos    = [AmbiguityInfo]
ambig_infos })
  = [TcTyVar] -> SDoc
ppr_interesting_tyVars [TcTyVar]
interesting_tvs
  SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((AmbiguityInfo -> SDoc) -> [AmbiguityInfo] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map AmbiguityInfo -> SDoc
pprAmbiguityInfo [AmbiguityInfo]
ambig_infos)
  where
    ppr_interesting_tyVars :: [TcTyVar] -> SDoc
ppr_interesting_tyVars [] = SDoc
forall doc. IsOutput doc => doc
empty
    ppr_interesting_tyVars (TcTyVar
tv:[TcTyVar]
tvs) =
      SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Type variable kinds:") Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((TcTyVar -> SDoc) -> [TcTyVar] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (TcTyVar -> SDoc
tyvar_binding (TcTyVar -> SDoc) -> (TcTyVar -> TcTyVar) -> TcTyVar -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TidyEnv -> TcTyVar -> TcTyVar
tidyTyCoVarOcc (SolverReportErrCtxt -> TidyEnv
cec_tidy SolverReportErrCtxt
ctxt))
                (TcTyVar
tvTcTyVar -> [TcTyVar] -> [TcTyVar]
forall a. a -> [a] -> [a]
:[TcTyVar]
tvs))
    tyvar_binding :: TcTyVar -> SDoc
tyvar_binding TcTyVar
tyvar = TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcTyVar
tyvar SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TcTyVar -> Type
tyVarKind TcTyVar
tyvar)
pprCannotUnifyVariableReason SolverReportErrCtxt
ctxt (DifferentTyVars TyVarInfo
tv_info)
  = SolverReportErrCtxt -> TyVarInfo -> SDoc
pprTyVarInfo SolverReportErrCtxt
ctxt TyVarInfo
tv_info
pprCannotUnifyVariableReason SolverReportErrCtxt
ctxt (RepresentationalEq TyVarInfo
tv_info Maybe CoercibleMsg
mb_coercible_msg)
  = SolverReportErrCtxt -> TyVarInfo -> SDoc
pprTyVarInfo SolverReportErrCtxt
ctxt TyVarInfo
tv_info
  SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc -> (CoercibleMsg -> SDoc) -> Maybe CoercibleMsg -> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SDoc
forall doc. IsOutput doc => doc
empty CoercibleMsg -> SDoc
pprCoercibleMsg Maybe CoercibleMsg
mb_coercible_msg

pprMismatchMsg :: SolverReportErrCtxt -> MismatchMsg -> SDoc
pprMismatchMsg :: SolverReportErrCtxt -> MismatchMsg -> SDoc
pprMismatchMsg SolverReportErrCtxt
ctxt
  (BasicMismatch { mismatch_ea :: MismatchMsg -> MismatchEA
mismatch_ea   = MismatchEA
ea
                 , mismatch_item :: MismatchMsg -> ErrorItem
mismatch_item = ErrorItem
item
                 , mismatch_ty1 :: MismatchMsg -> Type
mismatch_ty1  = Type
ty1  -- Expected
                 , mismatch_ty2 :: MismatchMsg -> Type
mismatch_ty2  = Type
ty2  -- Actual
                 , mismatch_whenMatching :: MismatchMsg -> Maybe WhenMatching
mismatch_whenMatching = Maybe WhenMatching
mb_match_txt
                 , mismatch_mb_same_occ :: MismatchMsg -> Maybe SameOccInfo
mismatch_mb_same_occ  = Maybe SameOccInfo
same_occ_info })
  =  [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ CtLoc -> SDoc -> SDoc
addArising (ErrorItem -> CtLoc
errorItemCtLoc ErrorItem
item) SDoc
msg
          , SDoc
ea_extra
          , SDoc -> (WhenMatching -> SDoc) -> Maybe WhenMatching -> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SDoc
forall doc. IsOutput doc => doc
empty (SolverReportErrCtxt -> WhenMatching -> SDoc
pprWhenMatching SolverReportErrCtxt
ctxt) Maybe WhenMatching
mb_match_txt
          , SDoc -> (SameOccInfo -> SDoc) -> Maybe SameOccInfo -> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SDoc
forall doc. IsOutput doc => doc
empty SameOccInfo -> SDoc
pprSameOccInfo Maybe SameOccInfo
same_occ_info ]
  where
    msg :: SDoc
msg
      | (Type -> Bool
isLiftedRuntimeRep Type
ty1 Bool -> Bool -> Bool
&& Type -> Bool
isUnliftedRuntimeRep Type
ty2) Bool -> Bool -> Bool
||
        (Type -> Bool
isLiftedRuntimeRep Type
ty2 Bool -> Bool -> Bool
&& Type -> Bool
isUnliftedRuntimeRep Type
ty1) Bool -> Bool -> Bool
||
        (Type -> Bool
isLiftedLevity Type
ty1 Bool -> Bool -> Bool
&& Type -> Bool
isUnliftedLevity Type
ty2) Bool -> Bool -> Bool
||
        (Type -> Bool
isLiftedLevity Type
ty2 Bool -> Bool -> Bool
&& Type -> Bool
isUnliftedLevity Type
ty1)
      = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Couldn't match a lifted type with an unlifted type"

      | Type -> Bool
isAtomicTy Type
ty1 Bool -> Bool -> Bool
|| Type -> Bool
isAtomicTy Type
ty2
      = -- Print with quotes
        [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
herald1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty1)
            , Int -> SDoc -> SDoc
nest Int
padding (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
              String -> SDoc
forall doc. IsLine doc => String -> doc
text String
herald2 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty2) ]

      | Bool
otherwise
      = -- Print with vertical layout
        [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
herald1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty1
             , Int -> SDoc -> SDoc
nest Int
padding (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
               String -> SDoc
forall doc. IsLine doc => String -> doc
text String
herald2 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty2 ]

    herald1 :: String
herald1 = [String] -> String
conc [ String
"Couldn't match"
                   , if Bool
is_repr then String
"representation of" else String
""
                   , if Bool
want_ea then String
"expected"          else String
""
                   , String
what ]
    herald2 :: String
herald2 = [String] -> String
conc [ String
"with"
                   , if Bool
is_repr then String
"that of"           else String
""
                   , if Bool
want_ea then (String
"actual " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
what) else String
"" ]

    padding :: Int
padding = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
herald1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
herald2

    (Bool
want_ea, SDoc
ea_extra)
      = case MismatchEA
ea of
         MismatchEA
NoEA        -> (Bool
False, SDoc
forall doc. IsOutput doc => doc
empty)
         EA Maybe ExpectedActualInfo
mb_extra -> (Bool
True , SDoc
-> (ExpectedActualInfo -> SDoc) -> Maybe ExpectedActualInfo -> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SDoc
forall doc. IsOutput doc => doc
empty (SolverReportErrCtxt -> ExpectedActualInfo -> SDoc
pprExpectedActualInfo SolverReportErrCtxt
ctxt) Maybe ExpectedActualInfo
mb_extra)
    is_repr :: Bool
is_repr = case ErrorItem -> EqRel
errorItemEqRel ErrorItem
item of { EqRel
ReprEq -> Bool
True; EqRel
NomEq -> Bool
False }

    what :: String
what = TypeOrKind -> String
levelString (CtLoc -> Maybe TypeOrKind
ctLocTypeOrKind_maybe (ErrorItem -> CtLoc
errorItemCtLoc ErrorItem
item) Maybe TypeOrKind -> TypeOrKind -> TypeOrKind
forall a. Maybe a -> a -> a
`orElse` TypeOrKind
TypeLevel)

    conc :: [String] -> String
    conc :: [String] -> String
conc = (String -> String -> String) -> [String] -> String
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 String -> String -> String
add_space

    add_space :: String -> String -> String
    add_space :: String -> String -> String
add_space String
s1 String
s2 | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s1   = String
s2
                    | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s2   = String
s1
                    | Bool
otherwise = String
s1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char
' ' Char -> String -> String
forall a. a -> [a] -> [a]
: String
s2)
pprMismatchMsg SolverReportErrCtxt
_
  (KindMismatch { kmismatch_what :: MismatchMsg -> TypedThing
kmismatch_what     = TypedThing
thing
                , kmismatch_expected :: MismatchMsg -> Type
kmismatch_expected = Type
exp
                , kmismatch_actual :: MismatchMsg -> Type
kmismatch_actual   = Type
act })
  = SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Expected" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
kind_desc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma)
      Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TypedThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypedThing
thing) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has kind" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
        SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
act))
  where
    kind_desc :: SDoc
kind_desc | Type -> Bool
isConstraintLikeKind Type
exp = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a constraint"
              | Just Type
arg <- (() :: Constraint) => Type -> Maybe Type
Type -> Maybe Type
kindRep_maybe Type
exp  -- TYPE t0
              , Type -> Bool
tcIsTyVarTy Type
arg = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitRuntimeReps ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
                                   Bool
True  -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"kind" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
exp)
                                   Bool
False -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a type"
              | Bool
otherwise       = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"kind" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
exp)

pprMismatchMsg SolverReportErrCtxt
ctxt
  (TypeEqMismatch { teq_mismatch_ppr_explicit_kinds :: MismatchMsg -> Bool
teq_mismatch_ppr_explicit_kinds = Bool
ppr_explicit_kinds
                  , teq_mismatch_item :: MismatchMsg -> ErrorItem
teq_mismatch_item     = ErrorItem
item
                  , teq_mismatch_ty1 :: MismatchMsg -> Type
teq_mismatch_ty1      = Type
ty1   -- These types are the actual types
                  , teq_mismatch_ty2 :: MismatchMsg -> Type
teq_mismatch_ty2      = Type
ty2   --   that don't match; may be swapped
                  , teq_mismatch_expected :: MismatchMsg -> Type
teq_mismatch_expected = Type
exp   -- These are the context of
                  , teq_mismatch_actual :: MismatchMsg -> Type
teq_mismatch_actual   = Type
act   --   the mis-match
                  , teq_mismatch_what :: MismatchMsg -> Maybe TypedThing
teq_mismatch_what     = Maybe TypedThing
mb_thing
                  , teq_mb_same_occ :: MismatchMsg -> Maybe SameOccInfo
teq_mb_same_occ       = Maybe SameOccInfo
mb_same_occ })
  = CtLoc -> SDoc -> SDoc
addArising CtLoc
ct_loc (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Bool -> SDoc -> SDoc
pprWithExplicitKindsWhen Bool
ppr_explicit_kinds SDoc
msg
  SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SDoc -> (SameOccInfo -> SDoc) -> Maybe SameOccInfo -> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SDoc
forall doc. IsOutput doc => doc
empty SameOccInfo -> SDoc
pprSameOccInfo Maybe SameOccInfo
mb_same_occ
  where
    msg :: SDoc
msg | Just (TypeOrConstraint
torc, Type
rep) <- Type -> Maybe (TypeOrConstraint, Type)
sORTKind_maybe Type
exp
        = TypeOrConstraint -> Type -> SDoc
msg_for_exp_sort TypeOrConstraint
torc Type
rep

        | Just SDoc
nargs_msg <- Maybe SDoc
num_args_msg
        , Right MismatchMsg
ea_msg <- SolverReportErrCtxt
-> Maybe ErrorItem
-> TypeOrKind
-> CtOrigin
-> Either [ExpectedActualInfo] MismatchMsg
mk_ea_msg SolverReportErrCtxt
ctxt (ErrorItem -> Maybe ErrorItem
forall a. a -> Maybe a
Just ErrorItem
item) TypeOrKind
level CtOrigin
orig
        = SDoc
nargs_msg SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SolverReportErrCtxt -> MismatchMsg -> SDoc
pprMismatchMsg SolverReportErrCtxt
ctxt MismatchMsg
ea_msg

        | Type -> Type -> Type -> Type -> Bool
ea_looks_same Type
ty1 Type
ty2 Type
exp Type
act
        , Right MismatchMsg
ea_msg <- SolverReportErrCtxt
-> Maybe ErrorItem
-> TypeOrKind
-> CtOrigin
-> Either [ExpectedActualInfo] MismatchMsg
mk_ea_msg SolverReportErrCtxt
ctxt (ErrorItem -> Maybe ErrorItem
forall a. a -> Maybe a
Just ErrorItem
item) TypeOrKind
level CtOrigin
orig
        = SolverReportErrCtxt -> MismatchMsg -> SDoc
pprMismatchMsg SolverReportErrCtxt
ctxt MismatchMsg
ea_msg

        | Bool
otherwise
        = SDoc
bale_out_msg

      -- bale_out_msg: the mismatched types are /inside/ exp and act
    bale_out_msg :: SDoc
bale_out_msg = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [SDoc]
errs
      where
        errs :: [SDoc]
errs = case SolverReportErrCtxt
-> Maybe ErrorItem
-> TypeOrKind
-> CtOrigin
-> Either [ExpectedActualInfo] MismatchMsg
mk_ea_msg SolverReportErrCtxt
ctxt Maybe ErrorItem
forall a. Maybe a
Nothing TypeOrKind
level CtOrigin
orig of
                  Left [ExpectedActualInfo]
ea_info -> SolverReportErrCtxt -> MismatchMsg -> SDoc
pprMismatchMsg SolverReportErrCtxt
ctxt MismatchMsg
mismatch_err
                                SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: (ExpectedActualInfo -> SDoc) -> [ExpectedActualInfo] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SolverReportErrCtxt -> ExpectedActualInfo -> SDoc
pprExpectedActualInfo SolverReportErrCtxt
ctxt) [ExpectedActualInfo]
ea_info
                  Right MismatchMsg
ea_err -> [ SolverReportErrCtxt -> MismatchMsg -> SDoc
pprMismatchMsg SolverReportErrCtxt
ctxt MismatchMsg
mismatch_err
                                  , SolverReportErrCtxt -> MismatchMsg -> SDoc
pprMismatchMsg SolverReportErrCtxt
ctxt MismatchMsg
ea_err ]
        mismatch_err :: MismatchMsg
mismatch_err = MismatchEA -> ErrorItem -> Type -> Type -> MismatchMsg
mkBasicMismatchMsg MismatchEA
NoEA ErrorItem
item Type
ty1 Type
ty2

      -- 'expected' is (TYPE rep) or (CONSTRAINT rep)
    msg_for_exp_sort :: TypeOrConstraint -> Type -> SDoc
msg_for_exp_sort TypeOrConstraint
exp_torc Type
exp_rep
      | Just (TypeOrConstraint
act_torc, Type
act_rep) <- Type -> Maybe (TypeOrConstraint, Type)
sORTKind_maybe Type
act
      = -- (TYPE exp_rep) ~ (CONSTRAINT act_rep) etc
        TypeOrConstraint -> Type -> SDoc
msg_torc_torc TypeOrConstraint
act_torc Type
act_rep
      | Bool
otherwise
      = -- (TYPE _) ~ Bool, etc
        SDoc
maybe_num_args_msg SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
        [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Expected a" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TypeOrConstraint -> SDoc
forall {doc}. IsLine doc => TypeOrConstraint -> doc
ppr_torc TypeOrConstraint
exp_torc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma
            , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> case Maybe TypedThing
mb_thing of
                Maybe TypedThing
Nothing    -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"found something with kind"
                Just TypedThing
thing -> SDoc -> SDoc
quotes (TypedThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypedThing
thing) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has kind"
            , SDoc -> SDoc
quotes (Type -> SDoc
pprWithTYPE Type
act) ]

      where
        msg_torc_torc :: TypeOrConstraint -> Type -> SDoc
msg_torc_torc TypeOrConstraint
act_torc Type
act_rep
          | TypeOrConstraint
exp_torc TypeOrConstraint -> TypeOrConstraint -> Bool
forall a. Eq a => a -> a -> Bool
== TypeOrConstraint
act_torc
          = TypeOrConstraint -> Type -> SDoc
msg_same_torc TypeOrConstraint
act_torc Type
act_rep
          | Bool
otherwise
          = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Expected a" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TypeOrConstraint -> SDoc
forall {doc}. IsLine doc => TypeOrConstraint -> doc
ppr_torc TypeOrConstraint
exp_torc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma
                , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> case Maybe TypedThing
mb_thing of
                     Maybe TypedThing
Nothing    -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"found a"
                     Just TypedThing
thing -> SDoc -> SDoc
quotes (TypedThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypedThing
thing) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is a"
                  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TypeOrConstraint -> SDoc
forall {doc}. IsLine doc => TypeOrConstraint -> doc
ppr_torc TypeOrConstraint
act_torc ]

        msg_same_torc :: TypeOrConstraint -> Type -> SDoc
msg_same_torc TypeOrConstraint
act_torc Type
act_rep
          | Just SDoc
exp_doc <- Type -> Maybe SDoc
describe_rep Type
exp_rep
          , Just SDoc
act_doc <- Type -> Maybe SDoc
describe_rep Type
act_rep
          = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Expected" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
exp_doc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TypeOrConstraint -> SDoc
forall {doc}. IsLine doc => TypeOrConstraint -> doc
ppr_torc TypeOrConstraint
exp_torc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma
                , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"but" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> case Maybe TypedThing
mb_thing of
                     Just TypedThing
thing -> SDoc -> SDoc
quotes (TypedThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypedThing
thing) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is"
                     Maybe TypedThing
Nothing    -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"got"
                  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
act_doc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> TypeOrConstraint -> SDoc
forall {doc}. IsLine doc => TypeOrConstraint -> doc
ppr_torc TypeOrConstraint
act_torc ]
        msg_same_torc TypeOrConstraint
_ Type
_ = SDoc
bale_out_msg

    ct_loc :: CtLoc
ct_loc = ErrorItem -> CtLoc
errorItemCtLoc ErrorItem
item
    orig :: CtOrigin
orig   = ErrorItem -> CtOrigin
errorItemOrigin ErrorItem
item
    level :: TypeOrKind
level  = CtLoc -> Maybe TypeOrKind
ctLocTypeOrKind_maybe CtLoc
ct_loc Maybe TypeOrKind -> TypeOrKind -> TypeOrKind
forall a. Maybe a -> a -> a
`orElse` TypeOrKind
TypeLevel

    num_args_msg :: Maybe SDoc
num_args_msg = case TypeOrKind
level of
      TypeOrKind
KindLevel
        | Bool -> Bool
not (Type -> Bool
isMetaTyVarTy Type
exp) Bool -> Bool -> Bool
&& Bool -> Bool
not (Type -> Bool
isMetaTyVarTy Type
act)
           -- if one is a meta-tyvar, then it's possible that the user
           -- has asked for something impredicative, and we couldn't unify.
           -- Don't bother with counting arguments.
        -> let n_act :: Int
n_act = Type -> Int
count_args Type
act
               n_exp :: Int
n_exp = Type -> Int
count_args Type
exp in
           case Int
n_act Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n_exp of
             Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0   -- we don't know how many args there are, so don't
                         -- recommend removing args that aren't
               , Just TypedThing
thing <- Maybe TypedThing
mb_thing
               -> SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ SolverReportErrCtxt -> TcSolverReportMsg -> SDoc
pprTcSolverReportMsg SolverReportErrCtxt
ctxt (Int -> TypedThing -> TcSolverReportMsg
ExpectingMoreArguments Int
n TypedThing
thing)
             Int
_ -> Maybe SDoc
forall a. Maybe a
Nothing

      TypeOrKind
_ -> Maybe SDoc
forall a. Maybe a
Nothing

    maybe_num_args_msg :: SDoc
maybe_num_args_msg = Maybe SDoc
num_args_msg Maybe SDoc -> SDoc -> SDoc
forall a. Maybe a -> a -> a
`orElse` SDoc
forall doc. IsOutput doc => doc
empty

    count_args :: Type -> Int
count_args Type
ty = (PiTyBinder -> Bool) -> [PiTyBinder] -> Int
forall a. (a -> Bool) -> [a] -> Int
count PiTyBinder -> Bool
isVisiblePiTyBinder ([PiTyBinder] -> Int) -> [PiTyBinder] -> Int
forall a b. (a -> b) -> a -> b
$ ([PiTyBinder], Type) -> [PiTyBinder]
forall a b. (a, b) -> a
fst (([PiTyBinder], Type) -> [PiTyBinder])
-> ([PiTyBinder], Type) -> [PiTyBinder]
forall a b. (a -> b) -> a -> b
$ Type -> ([PiTyBinder], Type)
splitPiTys Type
ty

    ppr_torc :: TypeOrConstraint -> doc
ppr_torc TypeOrConstraint
TypeLike       = String -> doc
forall doc. IsLine doc => String -> doc
text String
"type";
    ppr_torc TypeOrConstraint
ConstraintLike = String -> doc
forall doc. IsLine doc => String -> doc
text String
"constraint"

    describe_rep :: RuntimeRepType -> Maybe SDoc
    -- describe_rep IntRep            = Just "an IntRep"
    -- describe_rep (BoxedRep Lifted) = Just "a lifted"
    --   etc
    describe_rep :: Type -> Maybe SDoc
describe_rep Type
rep
      | Just (TyCon
rr_tc, [Type]
rr_args) <- Type -> Maybe (TyCon, [Type])
splitRuntimeRep_maybe Type
rep
      = case [Type]
rr_args of
          [Type
lev_ty] | TyCon
rr_tc TyCon -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
boxedRepDataConKey
                   , Just Levity
lev <- Type -> Maybe Levity
levityType_maybe Type
lev_ty
                -> case Levity
lev of
                      Levity
Lifted   -> SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a lifted")
                      Levity
Unlifted -> SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a boxed unlifted")
          [] | TyCon
rr_tc TyCon -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
tupleRepDataConTyConKey -> SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a zero-bit")
             | String -> Bool
starts_with_vowel String
rr_occ -> SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"an" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
rr_occ)
             | Bool
otherwise                -> SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a"  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
rr_occ)
             where
               rr_occ :: String
rr_occ = OccName -> String
occNameString (TyCon -> OccName
forall a. NamedThing a => a -> OccName
getOccName TyCon
rr_tc)

          [Type]
_ -> Maybe SDoc
forall a. Maybe a
Nothing -- Must be TupleRep [r1..rn]
      | Bool
otherwise = Maybe SDoc
forall a. Maybe a
Nothing

    starts_with_vowel :: String -> Bool
starts_with_vowel (Char
c:String
_) = Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"AEIOU"
    starts_with_vowel []    = Bool
False

pprMismatchMsg SolverReportErrCtxt
ctxt (CouldNotDeduce [Implication]
useful_givens (ErrorItem
item :| [ErrorItem]
others) Maybe CND_Extra
mb_extra)
  = SDoc
main_msg SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
     case Either [ExpectedActualInfo] MismatchMsg
supplementary of
      Left [ExpectedActualInfo]
infos
        -> [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((ExpectedActualInfo -> SDoc) -> [ExpectedActualInfo] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SolverReportErrCtxt -> ExpectedActualInfo -> SDoc
pprExpectedActualInfo SolverReportErrCtxt
ctxt) [ExpectedActualInfo]
infos)
      Right MismatchMsg
other_msg
        -> SolverReportErrCtxt -> MismatchMsg -> SDoc
pprMismatchMsg SolverReportErrCtxt
ctxt MismatchMsg
other_msg
  where
    main_msg :: SDoc
main_msg
      | [Implication] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Implication]
useful_givens
      = CtLoc -> SDoc -> SDoc
addArising CtLoc
ct_loc (SDoc
no_instance_msg SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
missing)
      | Bool
otherwise
      = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (CtLoc -> SDoc -> SDoc
addArising CtLoc
ct_loc (SDoc
no_deduce_msg SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
missing)
              SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: [Implication] -> [SDoc]
pp_givens [Implication]
useful_givens)

    supplementary :: Either [ExpectedActualInfo] MismatchMsg
supplementary = case Maybe CND_Extra
mb_extra of
      Maybe CND_Extra
Nothing
        -> [ExpectedActualInfo] -> Either [ExpectedActualInfo] MismatchMsg
forall a b. a -> Either a b
Left []
      Just (CND_Extra TypeOrKind
level Type
ty1 Type
ty2)
        -> SolverReportErrCtxt
-> TypeOrKind
-> Type
-> Type
-> CtOrigin
-> Either [ExpectedActualInfo] MismatchMsg
mk_supplementary_ea_msg SolverReportErrCtxt
ctxt TypeOrKind
level Type
ty1 Type
ty2 CtOrigin
orig
    ct_loc :: CtLoc
ct_loc = ErrorItem -> CtLoc
errorItemCtLoc ErrorItem
item
    orig :: CtOrigin
orig   = CtLoc -> CtOrigin
ctLocOrigin CtLoc
ct_loc
    wanteds :: [Type]
wanteds = (ErrorItem -> Type) -> [ErrorItem] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map ErrorItem -> Type
errorItemPred (ErrorItem
itemErrorItem -> [ErrorItem] -> [ErrorItem]
forall a. a -> [a] -> [a]
:[ErrorItem]
others)

    no_instance_msg :: SDoc
no_instance_msg =
      case [Type]
wanteds of
        [Type
wanted] | Just (TyCon
tc, [Type]
_) <- (() :: Constraint) => Type -> Maybe (TyCon, [Type])
Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
wanted
                 -- Don't say "no instance" for a constraint such as "c" for a type variable c.
                 , TyCon -> Bool
isClassTyCon TyCon
tc -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"No instance for"
        [Type]
_ -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Could not solve:"

    no_deduce_msg :: SDoc
no_deduce_msg =
      case [Type]
wanteds of
        [Type
_wanted] -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Could not deduce"
        [Type]
_         -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Could not deduce:"

    missing :: SDoc
missing =
      case [Type]
wanteds of
        [Type
wanted] -> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
wanted)
        [Type]
_        -> [Type] -> SDoc
pprTheta [Type]
wanteds



{- *********************************************************************
*                                                                      *
                 Displaying potential instances
*                                                                      *
**********************************************************************-}

-- | Directly display the given matching and unifying instances,
-- with a header for each: `Matching instances`/`Potentially matching instances`.
pprPotentialInstances :: (ClsInst -> SDoc) -> PotentialInstances -> SDoc
pprPotentialInstances :: (ClsInst -> SDoc) -> PotentialInstances -> SDoc
pprPotentialInstances ClsInst -> SDoc
ppr_inst (PotentialInstances { [ClsInst]
matches :: PotentialInstances -> [ClsInst]
matches :: [ClsInst]
matches, [ClsInst]
unifiers :: PotentialInstances -> [ClsInst]
unifiers :: [ClsInst]
unifiers }) =
  [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
    [ Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ClsInst] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ClsInst]
matches) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
       String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Matching instance" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [ClsInst] -> SDoc
forall a. [a] -> SDoc
plural [ClsInst]
matches SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
         Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((ClsInst -> SDoc) -> [ClsInst] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ClsInst -> SDoc
ppr_inst [ClsInst]
matches))
    , Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ClsInst] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ClsInst]
unifiers) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
        (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Potentially matching instance" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [ClsInst] -> SDoc
forall a. [a] -> SDoc
plural [ClsInst]
unifiers SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon) SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
         Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((ClsInst -> SDoc) -> [ClsInst] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ClsInst -> SDoc
ppr_inst [ClsInst]
unifiers))
    ]

-- | Display a summary of available instances, omitting those involving
-- out-of-scope types, in order to explain why we couldn't solve a particular
-- constraint, e.g. due to instance overlap or out-of-scope types.
--
-- To directly display a collection of matching/unifying instances,
-- use 'pprPotentialInstances'.
potentialInstancesErrMsg :: PotentialInstances -> SDoc
-- See Note [Displaying potential instances]
potentialInstancesErrMsg :: PotentialInstances -> SDoc
potentialInstancesErrMsg PotentialInstances
potentials =
  (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintPotentialInstances ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_insts ->
  (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
sty ->
    PotentialInstances -> Bool -> PprStyle -> SDoc
potentials_msg_with_options PotentialInstances
potentials Bool
print_insts PprStyle
sty

-- | Display a summary of available instances, omitting out-of-scope ones.
--
-- Use 'potentialInstancesErrMsg' to automatically set the pretty-printing
-- options.
potentials_msg_with_options :: PotentialInstances
                            -> Bool -- ^ Whether to print /all/ potential instances
                            -> PprStyle
                            -> SDoc
potentials_msg_with_options :: PotentialInstances -> Bool -> PprStyle -> SDoc
potentials_msg_with_options
  (PotentialInstances { [ClsInst]
matches :: PotentialInstances -> [ClsInst]
matches :: [ClsInst]
matches, [ClsInst]
unifiers :: PotentialInstances -> [ClsInst]
unifiers :: [ClsInst]
unifiers })
  Bool
show_all_potentials PprStyle
sty
  | [ClsInst] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ClsInst]
matches Bool -> Bool -> Bool
&& [ClsInst] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ClsInst]
unifiers
  = SDoc
forall doc. IsOutput doc => doc
empty

  | [ClsInst] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ClsInst]
show_these_matches Bool -> Bool -> Bool
&& [ClsInst] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ClsInst]
show_these_unifiers
  = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> SDoc
not_in_scope_msg SDoc
forall doc. IsOutput doc => doc
empty
         , SDoc
flag_hint ]

  | Bool
otherwise
  = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ (ClsInst -> SDoc) -> PotentialInstances -> SDoc
pprPotentialInstances
            ClsInst -> SDoc
pprInstance -- print instance + location info
            (PotentialInstances
              { matches :: [ClsInst]
matches  = [ClsInst]
show_these_matches
              , unifiers :: [ClsInst]
unifiers = [ClsInst]
show_these_unifiers })
         , [ClsInst] -> SDoc
overlapping_but_not_more_specific_msg [ClsInst]
sorted_matches
         , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
           [ Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (Int
n_in_scope_hidden Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
             String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"...plus"
               SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc -> SDoc
speakNOf Int
n_in_scope_hidden (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"other")
           , Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (Int
not_in_scopes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
              SDoc -> SDoc
not_in_scope_msg (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"...plus")
           , SDoc
flag_hint ] ]
  where
    n_show_matches, n_show_unifiers :: Int
    n_show_matches :: Int
n_show_matches  = Int
3
    n_show_unifiers :: Int
n_show_unifiers = Int
2

    ([ClsInst]
in_scope_matches, [ClsInst]
not_in_scope_matches) = (ClsInst -> Bool) -> [ClsInst] -> ([ClsInst], [ClsInst])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ClsInst -> Bool
inst_in_scope [ClsInst]
matches
    ([ClsInst]
in_scope_unifiers, [ClsInst]
not_in_scope_unifiers) = (ClsInst -> Bool) -> [ClsInst] -> ([ClsInst], [ClsInst])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ClsInst -> Bool
inst_in_scope [ClsInst]
unifiers
    sorted_matches :: [ClsInst]
sorted_matches = (ClsInst -> ClsInst -> Ordering) -> [ClsInst] -> [ClsInst]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ClsInst -> ClsInst -> Ordering
fuzzyClsInstCmp [ClsInst]
in_scope_matches
    sorted_unifiers :: [ClsInst]
sorted_unifiers = (ClsInst -> ClsInst -> Ordering) -> [ClsInst] -> [ClsInst]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ClsInst -> ClsInst -> Ordering
fuzzyClsInstCmp [ClsInst]
in_scope_unifiers
    ([ClsInst]
show_these_matches, [ClsInst]
show_these_unifiers)
       | Bool
show_all_potentials = ([ClsInst]
sorted_matches, [ClsInst]
sorted_unifiers)
       | Bool
otherwise           = (Int -> [ClsInst] -> [ClsInst]
forall a. Int -> [a] -> [a]
take Int
n_show_matches  [ClsInst]
sorted_matches
                               ,Int -> [ClsInst] -> [ClsInst]
forall a. Int -> [a] -> [a]
take Int
n_show_unifiers [ClsInst]
sorted_unifiers)
    n_in_scope_hidden :: Int
n_in_scope_hidden
      = [ClsInst] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ClsInst]
sorted_matches Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [ClsInst] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ClsInst]
sorted_unifiers
      Int -> Int -> Int
forall a. Num a => a -> a -> a
- [ClsInst] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ClsInst]
show_these_matches Int -> Int -> Int
forall a. Num a => a -> a -> a
- [ClsInst] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ClsInst]
show_these_unifiers

       -- "in scope" means that all the type constructors
       -- are lexically in scope; these instances are likely
       -- to be more useful
    inst_in_scope :: ClsInst -> Bool
    inst_in_scope :: ClsInst -> Bool
inst_in_scope ClsInst
cls_inst = (Name -> Bool) -> NameSet -> Bool
nameSetAll Name -> Bool
name_in_scope (NameSet -> Bool) -> NameSet -> Bool
forall a b. (a -> b) -> a -> b
$
                             [Type] -> NameSet
orphNamesOfTypes (ClsInst -> [Type]
is_tys ClsInst
cls_inst)

    name_in_scope :: Name -> Bool
name_in_scope Name
name
      | Name -> Bool
pretendNameIsInScope Name
name
      = Bool
True -- E.g. (->); see Note [pretendNameIsInScope] in GHC.Builtin.Names
      | Just Module
mod <- Name -> Maybe Module
nameModule_maybe Name
name
      = QualifyName -> Bool
qual_in_scope (PprStyle -> QueryQualifyName
qualName PprStyle
sty Module
mod (Name -> OccName
nameOccName Name
name))
      | Bool
otherwise
      = Bool
True

    qual_in_scope :: QualifyName -> Bool
    qual_in_scope :: QualifyName -> Bool
qual_in_scope QualifyName
NameUnqual    = Bool
True
    qual_in_scope (NameQual {}) = Bool
True
    qual_in_scope QualifyName
_             = Bool
False

    not_in_scopes :: Int
    not_in_scopes :: Int
not_in_scopes = [ClsInst] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ClsInst]
not_in_scope_matches Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [ClsInst] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ClsInst]
not_in_scope_unifiers

    not_in_scope_msg :: SDoc -> SDoc
not_in_scope_msg SDoc
herald =
      SDoc -> Int -> SDoc -> SDoc
hang (SDoc
herald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc -> SDoc
speakNOf Int
not_in_scopes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"instance")
                     SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"involving out-of-scope types")
           Int
2 (Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen Bool
show_all_potentials (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
               (ClsInst -> SDoc) -> PotentialInstances -> SDoc
pprPotentialInstances
               ClsInst -> SDoc
pprInstanceHdr -- only print the header, not the instance location info
                 (PotentialInstances
                   { matches :: [ClsInst]
matches = [ClsInst]
not_in_scope_matches
                   , unifiers :: [ClsInst]
unifiers = [ClsInst]
not_in_scope_unifiers
                   }))

    flag_hint :: SDoc
flag_hint = Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppUnless (Bool
show_all_potentials
                         Bool -> Bool -> Bool
|| ([ClsInst] -> [ClsInst] -> Bool
forall a b. [a] -> [b] -> Bool
equalLength [ClsInst]
show_these_matches [ClsInst]
matches
                             Bool -> Bool -> Bool
&& [ClsInst] -> [ClsInst] -> Bool
forall a b. [a] -> [b] -> Bool
equalLength [ClsInst]
show_these_unifiers [ClsInst]
unifiers)) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(use -fprint-potential-instances to see them all)"

-- | Compute a message informing the user of any instances that are overlapped
-- but were not discarded because the instance overlapping them wasn't
-- strictly more specific.
overlapping_but_not_more_specific_msg :: [ClsInst] -> SDoc
overlapping_but_not_more_specific_msg :: [ClsInst] -> SDoc
overlapping_but_not_more_specific_msg [ClsInst]
insts
  -- Only print one example of "overlapping but not strictly more specific",
  -- to avoid information overload.
  | (ClsInst, ClsInst)
overlap : [(ClsInst, ClsInst)]
_ <- [(ClsInst, ClsInst)]
overlapping_but_not_more_specific
  = SDoc
overlap_header SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ (ClsInst, ClsInst) -> SDoc
ppr_overlapping (ClsInst, ClsInst)
overlap
  | Bool
otherwise
  = SDoc
forall doc. IsOutput doc => doc
empty
    where
      overlap_header :: SDoc
      overlap_header :: SDoc
overlap_header
        | [(ClsInst, ClsInst)
_] <- [(ClsInst, ClsInst)]
overlapping_but_not_more_specific
        = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"An overlapping instance can only be chosen when it is strictly more specific."
        | Bool
otherwise
        = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Overlapping instances can only be chosen when they are strictly more specific."
      overlapping_but_not_more_specific :: [(ClsInst, ClsInst)]
      overlapping_but_not_more_specific :: [(ClsInst, ClsInst)]
overlapping_but_not_more_specific
        = ((ClsInst, ClsInst) -> (ClsInst, ClsInst) -> Ordering)
-> [(ClsInst, ClsInst)] -> [(ClsInst, ClsInst)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
nubOrdBy (((ClsInst, ClsInst) -> TcTyVar)
-> (ClsInst, ClsInst) -> (ClsInst, ClsInst) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (ClsInst -> TcTyVar
is_dfun (ClsInst -> TcTyVar)
-> ((ClsInst, ClsInst) -> ClsInst) -> (ClsInst, ClsInst) -> TcTyVar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClsInst, ClsInst) -> ClsInst
forall a b. (a, b) -> a
fst))
          [ (ClsInst
overlapper, ClsInst
overlappee)
          | [ClsInst]
these <- (ClsInst -> ClsInst -> Bool) -> [ClsInst] -> [[ClsInst]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Name -> Name -> Bool)
-> (ClsInst -> Name) -> ClsInst -> ClsInst -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ClsInst -> Name
is_cls_nm) [ClsInst]
insts
          -- Take all pairs of distinct instances...
          , ClsInst
one:[ClsInst]
others <- [ClsInst] -> [[ClsInst]]
forall a. [a] -> [[a]]
tails [ClsInst]
these -- if `these = [inst_1, inst_2, ...]`
          , ClsInst
other <- [ClsInst]
others           -- then we get pairs `(one, other) = (inst_i, inst_j)` with `i < j`
          -- ... such that one instance in the pair overlaps the other...
          , let mb_overlapping :: [(ClsInst, ClsInst)]
mb_overlapping
                  | OverlapMode -> Bool
hasOverlappingFlag (OverlapFlag -> OverlapMode
overlapMode (OverlapFlag -> OverlapMode) -> OverlapFlag -> OverlapMode
forall a b. (a -> b) -> a -> b
$ ClsInst -> OverlapFlag
is_flag ClsInst
one)
                  Bool -> Bool -> Bool
|| OverlapMode -> Bool
hasOverlappableFlag (OverlapFlag -> OverlapMode
overlapMode (OverlapFlag -> OverlapMode) -> OverlapFlag -> OverlapMode
forall a b. (a -> b) -> a -> b
$ ClsInst -> OverlapFlag
is_flag ClsInst
other)
                  = [(ClsInst
one, ClsInst
other)]
                  | OverlapMode -> Bool
hasOverlappingFlag (OverlapFlag -> OverlapMode
overlapMode (OverlapFlag -> OverlapMode) -> OverlapFlag -> OverlapMode
forall a b. (a -> b) -> a -> b
$ ClsInst -> OverlapFlag
is_flag ClsInst
other)
                  Bool -> Bool -> Bool
|| OverlapMode -> Bool
hasOverlappableFlag (OverlapFlag -> OverlapMode
overlapMode (OverlapFlag -> OverlapMode) -> OverlapFlag -> OverlapMode
forall a b. (a -> b) -> a -> b
$ ClsInst -> OverlapFlag
is_flag ClsInst
one)
                  = [(ClsInst
other, ClsInst
one)]
                  | Bool
otherwise
                  = []
          , (ClsInst
overlapper, ClsInst
overlappee) <- [(ClsInst, ClsInst)]
mb_overlapping
          -- ... but the overlapper is not more specific than the overlappee.
          , Bool -> Bool
not (ClsInst
overlapper ClsInst -> ClsInst -> Bool
`more_specific_than` ClsInst
overlappee)
          ]
      more_specific_than :: ClsInst -> ClsInst -> Bool
      ClsInst
is1 more_specific_than :: ClsInst -> ClsInst -> Bool
`more_specific_than` ClsInst
is2
        = Maybe Subst -> Bool
forall a. Maybe a -> Bool
isJust ([Type] -> [Type] -> Maybe Subst
tcMatchTys (ClsInst -> [Type]
is_tys ClsInst
is1) (ClsInst -> [Type]
is_tys ClsInst
is2))
      ppr_overlapping :: (ClsInst, ClsInst) -> SDoc
      ppr_overlapping :: (ClsInst, ClsInst) -> SDoc
ppr_overlapping (ClsInst
overlapper, ClsInst
overlappee)
        = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The first instance that follows overlaps the second, but is not more specific than it:"
        SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (ClsInst -> SDoc) -> [ClsInst] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ClsInst -> SDoc
pprInstanceHdr [ClsInst
overlapper, ClsInst
overlappee])

{- Note [Displaying potential instances]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When showing a list of instances for
  - overlapping instances (show ones that match)
  - no such instance (show ones that could match)
we want to give it a bit of structure.  Here's the plan

* Say that an instance is "in scope" if all of the
  type constructors it mentions are lexically in scope.
  These are the ones most likely to be useful to the programmer.

* Show at most n_show in-scope instances,
  and summarise the rest ("plus N others")

* Summarise the not-in-scope instances ("plus 4 not in scope")

* Add the flag -fshow-potential-instances which replaces the
  summary with the full list
-}

{- *********************************************************************
*                                                                      *
             Outputting additional solver report information
*                                                                      *
**********************************************************************-}

-- | Pretty-print an informational message, to accompany a 'TcSolverReportMsg'.
pprExpectedActualInfo :: SolverReportErrCtxt -> ExpectedActualInfo -> SDoc
pprExpectedActualInfo :: SolverReportErrCtxt -> ExpectedActualInfo -> SDoc
pprExpectedActualInfo SolverReportErrCtxt
_ (ExpectedActual { ea_expected :: ExpectedActualInfo -> Type
ea_expected = Type
exp, ea_actual :: ExpectedActualInfo -> Type
ea_actual = Type
act }) =
  [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
    [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Expected:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
exp
    , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"  Actual:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
act ]
pprExpectedActualInfo SolverReportErrCtxt
_
  (ExpectedActualAfterTySynExpansion
    { ea_expanded_expected :: ExpectedActualInfo -> Type
ea_expanded_expected = Type
exp
    , ea_expanded_actual :: ExpectedActualInfo -> Type
ea_expanded_actual   = Type
act } )
  = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat
      [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Type synonyms expanded:"
      , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Expected type:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
exp
      , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"  Actual type:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
act ]

pprCoercibleMsg :: CoercibleMsg -> SDoc
pprCoercibleMsg :: CoercibleMsg -> SDoc
pprCoercibleMsg (UnknownRoles Type
ty) =
  SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NB: We cannot know what roles the parameters to" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
          SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"have;")
       Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"we must assume that the role is nominal")
pprCoercibleMsg (TyConIsAbstract TyCon
tc) =
  [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NB: The type constructor"
       , SDoc -> SDoc
quotes (TyCon -> SDoc
pprSourceTyCon TyCon
tc)
       , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is abstract" ]
pprCoercibleMsg (OutOfScopeNewtypeConstructor TyCon
tc DataCon
dc) =
  SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The data constructor" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SDoc) -> Name -> SDoc
forall a b. (a -> b) -> a -> b
$ DataCon -> Name
dataConName DataCon
dc))
    Int
2 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"of newtype" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
pprSourceTyCon TyCon
tc)
           , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not in scope" ])

pprWhenMatching :: SolverReportErrCtxt -> WhenMatching -> SDoc
pprWhenMatching :: SolverReportErrCtxt -> WhenMatching -> SDoc
pprWhenMatching SolverReportErrCtxt
ctxt (WhenMatching Type
cty1 Type
cty2 CtOrigin
sub_o Maybe TypeOrKind
mb_sub_t_or_k) =
  (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitCoercions ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
printExplicitCoercions ->
    if Bool
printExplicitCoercions
       Bool -> Bool -> Bool
|| Bool -> Bool
not (Type
cty1 Type -> Type -> Bool
`pickyEqType` Type
cty2)
      then [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"When matching" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
sub_whats)
                      Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
cty1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                               Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((() :: Constraint) => Type -> Type
Type -> Type
typeKind Type
cty1)
                             , Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
cty2 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                               Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((() :: Constraint) => Type -> Type
Type -> Type
typeKind Type
cty2) ])
                , SDoc
supplementary ]
      else String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"When matching the kind of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
cty1)
  where
    sub_t_or_k :: TypeOrKind
sub_t_or_k = Maybe TypeOrKind
mb_sub_t_or_k Maybe TypeOrKind -> TypeOrKind -> TypeOrKind
forall a. Maybe a -> a -> a
`orElse` TypeOrKind
TypeLevel
    sub_whats :: SDoc
sub_whats  = String -> SDoc
forall doc. IsLine doc => String -> doc
text (TypeOrKind -> String
levelString TypeOrKind
sub_t_or_k) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
's'
    supplementary :: SDoc
supplementary =
      case SolverReportErrCtxt
-> TypeOrKind
-> Type
-> Type
-> CtOrigin
-> Either [ExpectedActualInfo] MismatchMsg
mk_supplementary_ea_msg SolverReportErrCtxt
ctxt TypeOrKind
sub_t_or_k Type
cty1 Type
cty2 CtOrigin
sub_o of
        Left [ExpectedActualInfo]
infos -> [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (ExpectedActualInfo -> SDoc) -> [ExpectedActualInfo] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SolverReportErrCtxt -> ExpectedActualInfo -> SDoc
pprExpectedActualInfo SolverReportErrCtxt
ctxt) [ExpectedActualInfo]
infos
        Right MismatchMsg
msg  -> SolverReportErrCtxt -> MismatchMsg -> SDoc
pprMismatchMsg SolverReportErrCtxt
ctxt MismatchMsg
msg

pprTyVarInfo :: SolverReportErrCtxt -> TyVarInfo -> SDoc
pprTyVarInfo :: SolverReportErrCtxt -> TyVarInfo -> SDoc
pprTyVarInfo SolverReportErrCtxt
ctxt (TyVarInfo { thisTyVar :: TyVarInfo -> TcTyVar
thisTyVar = TcTyVar
tv1, otherTy :: TyVarInfo -> Maybe TcTyVar
otherTy = Maybe TcTyVar
mb_tv2 }) =
  TcTyVar -> SDoc
mk_msg TcTyVar
tv1 SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ case Maybe TcTyVar
mb_tv2 of { Maybe TcTyVar
Nothing -> SDoc
forall doc. IsOutput doc => doc
empty; Just TcTyVar
tv2 -> TcTyVar -> SDoc
mk_msg TcTyVar
tv2 }
  where
    mk_msg :: TcTyVar -> SDoc
mk_msg TcTyVar
tv = case TcTyVar -> TcTyVarDetails
tcTyVarDetails TcTyVar
tv of
      SkolemTv SkolemInfo
sk_info TcLevel
_ Bool
_ -> SolverReportErrCtxt -> [(SkolemInfoAnon, [TcTyVar])] -> SDoc
pprSkols SolverReportErrCtxt
ctxt [(SkolemInfo -> SkolemInfoAnon
getSkolemInfo SkolemInfo
sk_info, [TcTyVar
tv])]
      RuntimeUnk {} -> SDoc -> SDoc
quotes (TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcTyVar
tv) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is an interactive-debugger skolem"
      MetaTv {}     -> SDoc
forall doc. IsOutput doc => doc
empty

pprAmbiguityInfo :: AmbiguityInfo -> SDoc
pprAmbiguityInfo :: AmbiguityInfo -> SDoc
pprAmbiguityInfo (Ambiguity Bool
prepend_msg ([TcTyVar]
ambig_kvs, [TcTyVar]
ambig_tvs)) = SDoc
msg
  where

    msg :: SDoc
msg |  (TcTyVar -> Bool) -> [TcTyVar] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TcTyVar -> Bool
isRuntimeUnkSkol [TcTyVar]
ambig_kvs  -- See Note [Runtime skolems]
        Bool -> Bool -> Bool
|| (TcTyVar -> Bool) -> [TcTyVar] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TcTyVar -> Bool
isRuntimeUnkSkol [TcTyVar]
ambig_tvs
        = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cannot resolve unknown runtime type"
                 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [TcTyVar] -> SDoc
forall a. [a] -> SDoc
plural [TcTyVar]
ambig_tvs SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TcTyVar] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList [TcTyVar]
ambig_tvs
               , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Use :print or :force to determine these types"]

        | Bool -> Bool
not ([TcTyVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TcTyVar]
ambig_tvs)
        = SDoc -> [TcTyVar] -> SDoc
pp_ambig (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type") [TcTyVar]
ambig_tvs

        | Bool
otherwise
        = SDoc -> [TcTyVar] -> SDoc
pp_ambig (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"kind") [TcTyVar]
ambig_kvs

    pp_ambig :: SDoc -> [TcTyVar] -> SDoc
pp_ambig SDoc
what [TcTyVar]
tkvs
      | Bool
prepend_msg -- "Ambiguous type variable 't0'"
      = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Ambiguous" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"variable"
        SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [TcTyVar] -> SDoc
forall a. [a] -> SDoc
plural [TcTyVar]
tkvs SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TcTyVar] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList [TcTyVar]
tkvs

      | Bool
otherwise -- "The type variable 't0' is ambiguous"
      = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"variable" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [TcTyVar] -> SDoc
forall a. [a] -> SDoc
plural [TcTyVar]
tkvs
        SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TcTyVar] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList [TcTyVar]
tkvs SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TcTyVar] -> SDoc
forall a. [a] -> SDoc
isOrAre [TcTyVar]
tkvs SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ambiguous"
pprAmbiguityInfo (NonInjectiveTyFam TyCon
tc) =
  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NB:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc)
  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is a non-injective type family"

pprSameOccInfo :: SameOccInfo -> SDoc
pprSameOccInfo :: SameOccInfo -> SDoc
pprSameOccInfo (SameOcc Bool
same_pkg Name
n1 Name
n2) =
  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NB:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (Bool -> Name -> SDoc
ppr_from Bool
same_pkg Name
n1 SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Bool -> Name -> SDoc
ppr_from Bool
same_pkg Name
n2)
  where
    ppr_from :: Bool -> Name -> SDoc
ppr_from Bool
same_pkg Name
nm
      | SrcSpan -> Bool
isGoodSrcSpan SrcSpan
loc
      = SDoc -> Int -> SDoc -> SDoc
hang (SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nm) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is defined at")
           Int
2 (SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcSpan
loc)
      | Bool
otherwise  -- Imported things have an UnhelpfulSrcSpan
      = SDoc -> Int -> SDoc -> SDoc
hang (SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nm))
           Int
2 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is defined in" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod))
                  , Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppUnless (Bool
same_pkg Bool -> Bool -> Bool
|| Unit
pkg Unit -> Unit -> Bool
forall a. Eq a => a -> a -> Bool
== Unit
mainUnit) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                    Int -> SDoc -> SDoc
nest Int
4 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in package" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr Unit
pkg) ])
      where
        pkg :: Unit
pkg = Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod
        mod :: Module
mod = (() :: Constraint) => Name -> Module
Name -> Module
nameModule Name
nm
        loc :: SrcSpan
loc = Name -> SrcSpan
nameSrcSpan Name
nm

{- *********************************************************************
*                                                                      *
                  Outputting HoleError messages
*                                                                      *
**********************************************************************-}

pprHoleError :: SolverReportErrCtxt -> Hole -> HoleError -> SDoc
pprHoleError :: SolverReportErrCtxt -> Hole -> HoleError -> SDoc
pprHoleError SolverReportErrCtxt
_ (Hole { Type
hole_ty :: Type
hole_ty :: Hole -> Type
hole_ty, hole_occ :: Hole -> RdrName
hole_occ = RdrName
rdr }) (OutOfScopeHole [ImportError]
imp_errs)
  = SDoc
out_of_scope_msg SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((ImportError -> SDoc) -> [ImportError] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ImportError -> SDoc
forall a. Outputable a => a -> SDoc
ppr [ImportError]
imp_errs)
  where
    herald :: SDoc
herald | OccName -> Bool
isDataOcc (RdrName -> OccName
rdrNameOcc RdrName
rdr) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Data constructor not in scope:"
           | Bool
otherwise     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Variable not in scope:"
    out_of_scope_msg :: SDoc
out_of_scope_msg -- Print v :: ty only if the type has structure
      | Bool
boring_type = SDoc -> Int -> SDoc -> SDoc
hang SDoc
herald Int
2 (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr)
      | Bool
otherwise   = SDoc -> Int -> SDoc -> SDoc
hang SDoc
herald Int
2 (RdrName -> Type -> SDoc
pp_rdr_with_type RdrName
rdr Type
hole_ty)
    boring_type :: Bool
boring_type = Type -> Bool
isTyVarTy Type
hole_ty
pprHoleError SolverReportErrCtxt
ctxt (Hole { Type
hole_ty :: Hole -> Type
hole_ty :: Type
hole_ty, RdrName
hole_occ :: Hole -> RdrName
hole_occ :: RdrName
hole_occ}) (HoleError HoleSort
sort [TcTyVar]
other_tvs [(SkolemInfoAnon, [TcTyVar])]
hole_skol_info) =
  [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc
hole_msg
       , SDoc
tyvars_msg
       , case HoleSort
sort of { ExprHole {} -> SDoc
expr_hole_hint; HoleSort
_ -> SDoc
type_hole_hint } ]

  where

    hole_msg :: SDoc
hole_msg = case HoleSort
sort of
      ExprHole {} ->
        SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Found hole:")
          Int
2 (RdrName -> Type -> SDoc
pp_rdr_with_type RdrName
hole_occ Type
hole_ty)
      HoleSort
TypeHole ->
        SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Found type wildcard" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
hole_occ))
          Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"standing for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes SDoc
pp_hole_type_with_kind)
      HoleSort
ConstraintHole ->
        SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Found extra-constraints wildcard standing for")
          Int
2 (SDoc -> SDoc
quotes (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Type -> SDoc
pprType Type
hole_ty)  -- always kind constraint

    hole_kind :: Type
hole_kind = (() :: Constraint) => Type -> Type
Type -> Type
typeKind Type
hole_ty

    pp_hole_type_with_kind :: SDoc
pp_hole_type_with_kind
      | Type -> Bool
isLiftedTypeKind Type
hole_kind
        Bool -> Bool -> Bool
|| Type -> Bool
isCoVarType Type
hole_ty -- Don't print the kind of unlifted
                               -- equalities (#15039)
      = Type -> SDoc
pprType Type
hole_ty
      | Bool
otherwise
      = Type -> SDoc
pprType Type
hole_ty SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprKind Type
hole_kind

    tyvars :: [TcTyVar]
tyvars = Type -> [TcTyVar]
tyCoVarsOfTypeList Type
hole_ty
    tyvars_msg :: SDoc
tyvars_msg = Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppUnless ([TcTyVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TcTyVar]
tyvars) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                 String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Where:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((TcTyVar -> SDoc) -> [TcTyVar] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map TcTyVar -> SDoc
loc_msg [TcTyVar]
other_tvs)
                                    SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ SolverReportErrCtxt -> [(SkolemInfoAnon, [TcTyVar])] -> SDoc
pprSkols SolverReportErrCtxt
ctxt [(SkolemInfoAnon, [TcTyVar])]
hole_skol_info)
                      -- Coercion variables can be free in the
                      -- hole, via kind casts
    expr_hole_hint :: SDoc
expr_hole_hint                       -- Give hint for, say,   f x = _x
         | CLabelString -> Int
lengthFS (OccName -> CLabelString
occNameFS (RdrName -> OccName
rdrNameOcc RdrName
hole_occ)) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1  -- Don't give this hint for plain "_"
         = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Or perhaps" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
hole_occ)
           SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is mis-spelled, or not in scope"
         | Bool
otherwise
         = SDoc
forall doc. IsOutput doc => doc
empty

    type_hole_hint :: SDoc
type_hole_hint
         | DiagnosticReason
ErrorWithoutFlag <- SolverReportErrCtxt -> DiagnosticReason
cec_type_holes SolverReportErrCtxt
ctxt
         = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"To use the inferred type, enable PartialTypeSignatures"
         | Bool
otherwise
         = SDoc
forall doc. IsOutput doc => doc
empty

    loc_msg :: TcTyVar -> SDoc
loc_msg TcTyVar
tv
       | TcTyVar -> Bool
isTyVar TcTyVar
tv
       = case TcTyVar -> TcTyVarDetails
tcTyVarDetails TcTyVar
tv of
           MetaTv {} -> SDoc -> SDoc
quotes (TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcTyVar
tv) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is an ambiguous type variable"
           TcTyVarDetails
_         -> SDoc
forall doc. IsOutput doc => doc
empty  -- Skolems dealt with already
       | Bool
otherwise  -- A coercion variable can be free in the hole type
       = (SDocContext -> Bool) -> SDoc -> SDoc
ppWhenOption SDocContext -> Bool
sdocPrintExplicitCoercions (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
           SDoc -> SDoc
quotes (TcTyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcTyVar
tv) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is a coercion variable"

pp_rdr_with_type :: RdrName -> Type -> SDoc
pp_rdr_with_type :: RdrName -> Type -> SDoc
pp_rdr_with_type RdrName
occ Type
hole_ty = SDoc -> Int -> SDoc -> SDoc
hang (RdrName -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc RdrName
occ) Int
2 (SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprType Type
hole_ty)

{- *********************************************************************
*                                                                      *
                  Outputting ScopeError messages
*                                                                      *
**********************************************************************-}

pprScopeError :: RdrName -> NotInScopeError -> SDoc
pprScopeError :: RdrName -> NotInScopeError -> SDoc
pprScopeError RdrName
rdr_name NotInScopeError
scope_err =
  case NotInScopeError
scope_err of
    NotInScope {} ->
      SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Not in scope:")
        Int
2 (SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name))
    NoExactName Name
name ->
      String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The Name" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not in scope."
    SameName [GlobalRdrElt]
gres ->
      Bool -> SDoc -> SDoc -> SDoc
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr ([GlobalRdrElt] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GlobalRdrElt]
gres Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2) (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"pprScopeError SameName: fewer than 2 elements" SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
2 ([GlobalRdrElt] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GlobalRdrElt]
gres))
      (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Same Name in multiple name-spaces:")
           Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((Name -> SDoc) -> [Name] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> SDoc
pp_one [Name]
sorted_names))
      where
        sorted_names :: [Name]
sorted_names = (Name -> Name -> Ordering) -> [Name] -> [Name]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (SrcSpan -> SrcSpan -> Ordering
leftmost_smallest (SrcSpan -> SrcSpan -> Ordering)
-> (Name -> SrcSpan) -> Name -> Name -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Name -> SrcSpan
nameSrcSpan) ((GlobalRdrElt -> Name) -> [GlobalRdrElt] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GlobalRdrElt -> Name
greMangledName [GlobalRdrElt]
gres)
        pp_one :: Name -> SDoc
pp_one Name
name
          = SDoc -> Int -> SDoc -> SDoc
hang (NameSpace -> SDoc
pprNameSpace (OccName -> NameSpace
occNameSpace (Name -> OccName
forall a. NamedThing a => a -> OccName
getOccName Name
name))
                  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma)
               Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"declared at:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcLoc -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SrcLoc
nameSrcLoc Name
name))
    MissingBinding SDoc
thing [GhcHint]
_ ->
      [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"The" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
thing
               SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name)
          , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"lacks an accompanying binding" ]
    NotInScopeError
NoTopLevelBinding ->
      SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"No top-level binding for")
        Int
2 (SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in this module")
    UnknownSubordinate SDoc
doc ->
      SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
rdr_name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not a (visible)" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
doc
  where
    what :: SDoc
what = NameSpace -> SDoc
pprNonVarNameSpace (OccName -> NameSpace
occNameSpace (RdrName -> OccName
rdrNameOcc RdrName
rdr_name))

scopeErrorHints :: NotInScopeError -> [GhcHint]
scopeErrorHints :: NotInScopeError -> [GhcHint]
scopeErrorHints NotInScopeError
scope_err =
  case NotInScopeError
scope_err of
    NotInScopeError
NotInScope             -> [GhcHint]
noHints
    NoExactName {}         -> [GhcHint
SuggestDumpSlices]
    SameName {}            -> [GhcHint
SuggestDumpSlices]
    MissingBinding SDoc
_ [GhcHint]
hints -> [GhcHint]
hints
    NotInScopeError
NoTopLevelBinding      -> [GhcHint]
noHints
    UnknownSubordinate {}  -> [GhcHint]
noHints

{- *********************************************************************
*                                                                      *
                  Outputting ImportError messages
*                                                                      *
**********************************************************************-}

instance Outputable ImportError where
  ppr :: ImportError -> SDoc
ppr (MissingModule ModuleName
mod_name) =
    [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep
      [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NB: no module named"
      , SDoc -> SDoc
quotes (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
mod_name)
      , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is imported."
      ]
  ppr  (ModulesDoNotExport NonEmpty Module
mods OccName
occ_name)
    | Module
mod NE.:| [] <- NonEmpty Module
mods
    = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep
        [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NB: the module"
        , SDoc -> SDoc
quotes (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod)
        , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"does not export"
        , SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ_name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot ]
    | Bool
otherwise
    = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep
        [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NB: neither"
        , [SDoc] -> SDoc
quotedListWithNor ((Module -> SDoc) -> [Module] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([Module] -> [SDoc]) -> [Module] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ NonEmpty Module -> [Module]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Module
mods)
        , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"export"
        , SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ_name) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot ]

{- *********************************************************************
*                                                                      *
             Suggested fixes for implication constraints
*                                                                      *
**********************************************************************-}

-- TODO: these functions should use GhcHint instead.

show_fixes :: [SDoc] -> SDoc
show_fixes :: [SDoc] -> SDoc
show_fixes []     = SDoc
forall doc. IsOutput doc => doc
empty
show_fixes (SDoc
f:[SDoc]
fs) = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Possible fix:"
                        , Int -> SDoc -> SDoc
nest Int
2 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (SDoc
f SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: (SDoc -> SDoc) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"or" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>) [SDoc]
fs))]

ctxtFixes :: Bool -> PredType -> [Implication] -> [SDoc]
ctxtFixes :: Bool -> Type -> [Implication] -> [SDoc]
ctxtFixes Bool
has_ambig_tvs Type
pred [Implication]
implics
  | Bool -> Bool
not Bool
has_ambig_tvs
  , Type -> Bool
isTyVarClassPred Type
pred   -- Don't suggest adding (Eq T) to the context, say
  , (SkolemInfoAnon
skol:[SkolemInfoAnon]
skols) <- [Implication] -> Type -> [SkolemInfoAnon]
usefulContext [Implication]
implics Type
pred
  , let what :: SDoc
what | [SkolemInfoAnon] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SkolemInfoAnon]
skols
             , SigSkol (PatSynCtxt {}) Type
_ [(Name, TcTyVar)]
_ <- SkolemInfoAnon
skol
             = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"\"required\""
             | Bool
otherwise
             = SDoc
forall doc. IsOutput doc => doc
empty
  = [[SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"add" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Type -> SDoc
pprParendType Type
pred
           SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"to the" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"context of"
         , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SkolemInfoAnon -> SDoc
ppr_skol SkolemInfoAnon
skol SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$
                    [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"or" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SkolemInfoAnon -> SDoc
ppr_skol SkolemInfoAnon
skol
                         | SkolemInfoAnon
skol <- [SkolemInfoAnon]
skols ] ] ]
  | Bool
otherwise = []
  where
    ppr_skol :: SkolemInfoAnon -> SDoc
ppr_skol (PatSkol (RealDataCon DataCon
dc) HsMatchContext GhcTc
_) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the data constructor" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
dc)
    ppr_skol (PatSkol (PatSynCon PatSyn
ps)   HsMatchContext GhcTc
_) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the pattern synonym"  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (PatSyn -> SDoc
forall a. Outputable a => a -> SDoc
ppr PatSyn
ps)
    ppr_skol SkolemInfoAnon
skol_info = SkolemInfoAnon -> SDoc
forall a. Outputable a => a -> SDoc
ppr SkolemInfoAnon
skol_info

usefulContext :: [Implication] -> PredType -> [SkolemInfoAnon]
-- usefulContext picks out the implications whose context
-- the programmer might plausibly augment to solve 'pred'
usefulContext :: [Implication] -> Type -> [SkolemInfoAnon]
usefulContext [Implication]
implics Type
pred
  = [Implication] -> [SkolemInfoAnon]
go [Implication]
implics
  where
    pred_tvs :: TyVarSet
pred_tvs = Type -> TyVarSet
tyCoVarsOfType Type
pred
    go :: [Implication] -> [SkolemInfoAnon]
go [] = []
    go (Implication
ic : [Implication]
ics)
       | Implication -> Bool
implausible Implication
ic = [SkolemInfoAnon]
rest
       | Bool
otherwise      = Implication -> SkolemInfoAnon
ic_info Implication
ic SkolemInfoAnon -> [SkolemInfoAnon] -> [SkolemInfoAnon]
forall a. a -> [a] -> [a]
: [SkolemInfoAnon]
rest
       where
          -- Stop when the context binds a variable free in the predicate
          rest :: [SkolemInfoAnon]
rest | (TcTyVar -> Bool) -> [TcTyVar] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (TcTyVar -> TyVarSet -> Bool
`elemVarSet` TyVarSet
pred_tvs) (Implication -> [TcTyVar]
ic_skols Implication
ic) = []
               | Bool
otherwise                                 = [Implication] -> [SkolemInfoAnon]
go [Implication]
ics

    implausible :: Implication -> Bool
implausible Implication
ic
      | [TcTyVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Implication -> [TcTyVar]
ic_skols Implication
ic)            = Bool
True
      | SkolemInfoAnon -> Bool
implausible_info (Implication -> SkolemInfoAnon
ic_info Implication
ic) = Bool
True
      | Bool
otherwise                     = Bool
False

    implausible_info :: SkolemInfoAnon -> Bool
implausible_info (SigSkol (InfSigCtxt {}) Type
_ [(Name, TcTyVar)]
_) = Bool
True
    implausible_info SkolemInfoAnon
_                             = Bool
False
    -- Do not suggest adding constraints to an *inferred* type signature

pp_givens :: [Implication] -> [SDoc]
pp_givens :: [Implication] -> [SDoc]
pp_givens [Implication]
givens
   = case [Implication]
givens of
         []     -> []
         (Implication
g:[Implication]
gs) ->      SDoc -> Implication -> SDoc
ppr_given (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"from the context:") Implication
g
                 SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: (Implication -> SDoc) -> [Implication] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SDoc -> Implication -> SDoc
ppr_given (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"or from:")) [Implication]
gs
    where
       ppr_given :: SDoc -> Implication -> SDoc
ppr_given SDoc
herald implic :: Implication
implic@(Implic { ic_given :: Implication -> [TcTyVar]
ic_given = [TcTyVar]
gs, ic_info :: Implication -> SkolemInfoAnon
ic_info = SkolemInfoAnon
skol_info })
           = SDoc -> Int -> SDoc -> SDoc
hang (SDoc
herald SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [TcTyVar] -> SDoc
pprEvVarTheta ((TcTyVar -> Type) -> [TcTyVar] -> [TcTyVar]
forall a. (a -> Type) -> [a] -> [a]
mkMinimalBySCs TcTyVar -> Type
evVarPred [TcTyVar]
gs))
             -- See Note [Suppress redundant givens during error reporting]
             -- for why we use mkMinimalBySCs above.
                Int
2 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound by" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SkolemInfoAnon -> SDoc
forall a. Outputable a => a -> SDoc
ppr SkolemInfoAnon
skol_info
                       , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> RealSrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TcLclEnv -> RealSrcSpan
getLclEnvLoc (Implication -> TcLclEnv
ic_env Implication
implic)) ])

{- *********************************************************************
*                                                                      *
                       CtOrigin information
*                                                                      *
**********************************************************************-}

levelString :: TypeOrKind -> String
levelString :: TypeOrKind -> String
levelString TypeOrKind
TypeLevel = String
"type"
levelString TypeOrKind
KindLevel = String
"kind"

pprArising :: CtLoc -> SDoc
-- Used for the main, top-level error message
-- We've done special processing for TypeEq, KindEq, givens
pprArising :: CtLoc -> SDoc
pprArising CtLoc
ct_loc
  | Bool
in_generated_code = SDoc
forall doc. IsOutput doc => doc
empty  -- See Note ["Arising from" messages in generated code]
  | Bool
suppress_origin   = SDoc
forall doc. IsOutput doc => doc
empty
  | Bool
otherwise         = CtOrigin -> SDoc
pprCtOrigin CtOrigin
orig
  where
    orig :: CtOrigin
orig = CtLoc -> CtOrigin
ctLocOrigin CtLoc
ct_loc
    in_generated_code :: Bool
in_generated_code = TcLclEnv -> Bool
lclEnvInGeneratedCode (CtLoc -> TcLclEnv
ctLocEnv CtLoc
ct_loc)
    suppress_origin :: Bool
suppress_origin
      | CtOrigin -> Bool
isGivenOrigin CtOrigin
orig = Bool
True
      | Bool
otherwise          = case CtOrigin
orig of
          TypeEqOrigin {}         -> Bool
True -- We've done special processing
          KindEqOrigin {}         -> Bool
True -- for TypeEq, KindEq, givens
          AmbiguityCheckOrigin {} -> Bool
True -- The "In the ambiguity check" context
                                          -- is sufficient; more would be repetitive
          CtOrigin
_ -> Bool
False

-- Add the "arising from..." part to a message
addArising :: CtLoc -> SDoc -> SDoc
addArising :: CtLoc -> SDoc -> SDoc
addArising CtLoc
ct_loc SDoc
msg = SDoc -> Int -> SDoc -> SDoc
hang SDoc
msg Int
2 (CtLoc -> SDoc
pprArising CtLoc
ct_loc)

pprWithArising :: [Ct] -> SDoc
-- Print something like
--    (Eq a) arising from a use of x at y
--    (Show a) arising from a use of p at q
-- Also return a location for the error message
-- Works for Wanted/Derived only
pprWithArising :: [Ct] -> SDoc
pprWithArising []
  = String -> SDoc
forall a. HasCallStack => String -> a
panic String
"pprWithArising"
pprWithArising (Ct
ct:[Ct]
cts)
  | [Ct] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Ct]
cts
  = CtLoc -> SDoc -> SDoc
addArising CtLoc
loc ([Type] -> SDoc
pprTheta [Ct -> Type
ctPred Ct
ct])
  | Bool
otherwise
  = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((Ct -> SDoc) -> [Ct] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Ct -> SDoc
ppr_one (Ct
ctCt -> [Ct] -> [Ct]
forall a. a -> [a] -> [a]
:[Ct]
cts))
  where
    loc :: CtLoc
loc = Ct -> CtLoc
ctLoc Ct
ct
    ppr_one :: Ct -> SDoc
ppr_one Ct
ct' = SDoc -> Int -> SDoc -> SDoc
hang (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (Type -> SDoc
pprType (Ct -> Type
ctPred Ct
ct')))
                     Int
2 (CtLoc -> SDoc
pprCtLoc (Ct -> CtLoc
ctLoc Ct
ct'))

{- Note ["Arising from" messages in generated code]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider code generated when we desugar code before typechecking;
see Note [Rebindable syntax and HsExpansion].

In this code, constraints may be generated, but we don't want to
say "arising from a call of foo" if 'foo' doesn't appear in the
users code.  We leave the actual CtOrigin untouched (partly because
it is generated in many, many places), but suppress the "Arising from"
message for constraints that originate in generated code.
-}


{- *********************************************************************
*                                                                      *
                           SkolemInfo
*                                                                      *
**********************************************************************-}


tidySkolemInfo :: TidyEnv -> SkolemInfo -> SkolemInfo
tidySkolemInfo :: TidyEnv -> SkolemInfo -> SkolemInfo
tidySkolemInfo TidyEnv
env (SkolemInfo Unique
u SkolemInfoAnon
sk_anon) = Unique -> SkolemInfoAnon -> SkolemInfo
SkolemInfo Unique
u (TidyEnv -> SkolemInfoAnon -> SkolemInfoAnon
tidySkolemInfoAnon TidyEnv
env SkolemInfoAnon
sk_anon)

----------------
tidySkolemInfoAnon :: TidyEnv -> SkolemInfoAnon -> SkolemInfoAnon
tidySkolemInfoAnon :: TidyEnv -> SkolemInfoAnon -> SkolemInfoAnon
tidySkolemInfoAnon TidyEnv
env (DerivSkol Type
ty)         = Type -> SkolemInfoAnon
DerivSkol (TidyEnv -> Type -> Type
tidyType TidyEnv
env Type
ty)
tidySkolemInfoAnon TidyEnv
env (SigSkol UserTypeCtxt
cx Type
ty [(Name, TcTyVar)]
tv_prs) = TidyEnv
-> UserTypeCtxt -> Type -> [(Name, TcTyVar)] -> SkolemInfoAnon
tidySigSkol TidyEnv
env UserTypeCtxt
cx Type
ty [(Name, TcTyVar)]
tv_prs
tidySkolemInfoAnon TidyEnv
env (InferSkol [(Name, Type)]
ids)        = [(Name, Type)] -> SkolemInfoAnon
InferSkol ((Type -> Type) -> [(Name, Type)] -> [(Name, Type)]
forall (f :: * -> *) b c a.
Functor f =>
(b -> c) -> f (a, b) -> f (a, c)
mapSnd (TidyEnv -> Type -> Type
tidyType TidyEnv
env) [(Name, Type)]
ids)
tidySkolemInfoAnon TidyEnv
env (UnifyForAllSkol Type
ty)   = Type -> SkolemInfoAnon
UnifyForAllSkol (TidyEnv -> Type -> Type
tidyType TidyEnv
env Type
ty)
tidySkolemInfoAnon TidyEnv
_   SkolemInfoAnon
info                   = SkolemInfoAnon
info

tidySigSkol :: TidyEnv -> UserTypeCtxt
            -> TcType -> [(Name,TcTyVar)] -> SkolemInfoAnon
-- We need to take special care when tidying SigSkol
-- See Note [SigSkol SkolemInfo] in "GHC.Tc.Types.Origin"
tidySigSkol :: TidyEnv
-> UserTypeCtxt -> Type -> [(Name, TcTyVar)] -> SkolemInfoAnon
tidySigSkol TidyEnv
env UserTypeCtxt
cx Type
ty [(Name, TcTyVar)]
tv_prs
  = UserTypeCtxt -> Type -> [(Name, TcTyVar)] -> SkolemInfoAnon
SigSkol UserTypeCtxt
cx (TidyEnv -> Type -> Type
tidy_ty TidyEnv
env Type
ty) [(Name, TcTyVar)]
tv_prs'
  where
    tv_prs' :: [(Name, TcTyVar)]
tv_prs' = (TcTyVar -> TcTyVar) -> [(Name, TcTyVar)] -> [(Name, TcTyVar)]
forall (f :: * -> *) b c a.
Functor f =>
(b -> c) -> f (a, b) -> f (a, c)
mapSnd (TidyEnv -> TcTyVar -> TcTyVar
tidyTyCoVarOcc TidyEnv
env) [(Name, TcTyVar)]
tv_prs
    inst_env :: NameEnv TcTyVar
inst_env = [(Name, TcTyVar)] -> NameEnv TcTyVar
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(Name, TcTyVar)]
tv_prs'

    tidy_ty :: TidyEnv -> Type -> Type
tidy_ty TidyEnv
env (ForAllTy (Bndr TcTyVar
tv ForAllTyFlag
vis) Type
ty)
      = VarBndr TcTyVar ForAllTyFlag -> Type -> Type
ForAllTy (TcTyVar -> ForAllTyFlag -> VarBndr TcTyVar ForAllTyFlag
forall var argf. var -> argf -> VarBndr var argf
Bndr TcTyVar
tv' ForAllTyFlag
vis) (TidyEnv -> Type -> Type
tidy_ty TidyEnv
env' Type
ty)
      where
        (TidyEnv
env', TcTyVar
tv') = TidyEnv -> TcTyVar -> (TidyEnv, TcTyVar)
tidy_tv_bndr TidyEnv
env TcTyVar
tv

    tidy_ty TidyEnv
env ty :: Type
ty@(FunTy FunTyFlag
af Type
w Type
arg Type
res) -- Look under  c => t
      | FunTyFlag -> Bool
isInvisibleFunArg FunTyFlag
af
      = Type
ty { ft_mult = tidy_ty env w
           , ft_arg  = tidyType env arg
           , ft_res  = tidy_ty env res }

    tidy_ty TidyEnv
env Type
ty = TidyEnv -> Type -> Type
tidyType TidyEnv
env Type
ty

    tidy_tv_bndr :: TidyEnv -> TyCoVar -> (TidyEnv, TyCoVar)
    tidy_tv_bndr :: TidyEnv -> TcTyVar -> (TidyEnv, TcTyVar)
tidy_tv_bndr env :: TidyEnv
env@(TidyOccEnv
occ_env, VarEnv TcTyVar
subst) TcTyVar
tv
      | Just TcTyVar
tv' <- NameEnv TcTyVar -> Name -> Maybe TcTyVar
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv NameEnv TcTyVar
inst_env (TcTyVar -> Name
tyVarName TcTyVar
tv)
      = ((TidyOccEnv
occ_env, VarEnv TcTyVar -> TcTyVar -> TcTyVar -> VarEnv TcTyVar
forall a. VarEnv a -> TcTyVar -> a -> VarEnv a
extendVarEnv VarEnv TcTyVar
subst TcTyVar
tv TcTyVar
tv'), TcTyVar
tv')

      | Bool
otherwise
      = TidyEnv -> TcTyVar -> (TidyEnv, TcTyVar)
tidyVarBndr TidyEnv
env TcTyVar
tv

pprSkols :: SolverReportErrCtxt -> [(SkolemInfoAnon, [TcTyVar])] -> SDoc
pprSkols :: SolverReportErrCtxt -> [(SkolemInfoAnon, [TcTyVar])] -> SDoc
pprSkols SolverReportErrCtxt
ctxt [(SkolemInfoAnon, [TcTyVar])]
zonked_ty_vars
  =
      let tidy_ty_vars :: [(SkolemInfoAnon, [TcTyVar])]
tidy_ty_vars = ((SkolemInfoAnon, [TcTyVar]) -> (SkolemInfoAnon, [TcTyVar]))
-> [(SkolemInfoAnon, [TcTyVar])] -> [(SkolemInfoAnon, [TcTyVar])]
forall a b. (a -> b) -> [a] -> [b]
map ((SkolemInfoAnon -> SkolemInfoAnon)
-> ([TcTyVar] -> [TcTyVar])
-> (SkolemInfoAnon, [TcTyVar])
-> (SkolemInfoAnon, [TcTyVar])
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (TidyEnv -> SkolemInfoAnon -> SkolemInfoAnon
tidySkolemInfoAnon (SolverReportErrCtxt -> TidyEnv
cec_tidy SolverReportErrCtxt
ctxt)) [TcTyVar] -> [TcTyVar]
forall a. a -> a
id) [(SkolemInfoAnon, [TcTyVar])]
zonked_ty_vars
      in [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (((SkolemInfoAnon, [TcTyVar]) -> SDoc)
-> [(SkolemInfoAnon, [TcTyVar])] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SkolemInfoAnon, [TcTyVar]) -> SDoc
pp_one [(SkolemInfoAnon, [TcTyVar])]
tidy_ty_vars)
  where

    no_msg :: SDoc
no_msg = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"No skolem info - we could not find the origin of the following variables" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [(SkolemInfoAnon, [TcTyVar])] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [(SkolemInfoAnon, [TcTyVar])]
zonked_ty_vars
       SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"This should not happen, please report it as a bug following the instructions at:"
       SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"https://gitlab.haskell.org/ghc/ghc/wikis/report-a-bug"


    pp_one :: (SkolemInfoAnon, [TcTyVar]) -> SDoc
pp_one (UnkSkol CallStack
cs, [TcTyVar]
tvs)
      = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> Int -> SDoc -> SDoc
hang ([TcTyVar] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList [TcTyVar]
tvs)
                 Int
2 ([TcTyVar] -> String -> String -> SDoc
forall {doc} {a}. IsLine doc => [a] -> String -> String -> doc
is_or_are [TcTyVar]
tvs String
"a" String
"(rigid, skolem)")
             , Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"of unknown origin")
             , Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([TcTyVar] -> SrcSpan
skolsSpan [TcTyVar]
tvs))
             , SDoc
no_msg
             , CallStack -> SDoc
prettyCallStackDoc CallStack
cs
             ]
    pp_one (SkolemInfoAnon
RuntimeUnkSkol, [TcTyVar]
tvs)
      = SDoc -> Int -> SDoc -> SDoc
hang ([TcTyVar] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList [TcTyVar]
tvs)
           Int
2 ([TcTyVar] -> String -> String -> SDoc
forall {doc} {a}. IsLine doc => [a] -> String -> String -> doc
is_or_are [TcTyVar]
tvs String
"an" String
"unknown runtime")
    pp_one (SkolemInfoAnon
skol_info, [TcTyVar]
tvs)
      = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ SDoc -> Int -> SDoc -> SDoc
hang ([TcTyVar] -> SDoc
forall a. Outputable a => [a] -> SDoc
pprQuotedList [TcTyVar]
tvs)
                  Int
2 ([TcTyVar] -> String -> String -> SDoc
forall {doc} {a}. IsLine doc => [a] -> String -> String -> doc
is_or_are [TcTyVar]
tvs String
"a"  String
"rigid" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bound by")
             , Int -> SDoc -> SDoc
nest Int
2 (SkolemInfoAnon -> SDoc
pprSkolInfo SkolemInfoAnon
skol_info)
             , Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"at" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([TcTyVar] -> SrcSpan
skolsSpan [TcTyVar]
tvs)) ]

    is_or_are :: [a] -> String -> String -> doc
is_or_are [a
_] String
article String
adjective = String -> doc
forall doc. IsLine doc => String -> doc
text String
"is" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> doc
forall doc. IsLine doc => String -> doc
text String
article doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> doc
forall doc. IsLine doc => String -> doc
text String
adjective
                                      doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> doc
forall doc. IsLine doc => String -> doc
text String
"type variable"
    is_or_are [a]
_   String
_       String
adjective = String -> doc
forall doc. IsLine doc => String -> doc
text String
"are" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> doc
forall doc. IsLine doc => String -> doc
text String
adjective
                                      doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> doc
forall doc. IsLine doc => String -> doc
text String
"type variables"

skolsSpan :: [TcTyVar] -> SrcSpan
skolsSpan :: [TcTyVar] -> SrcSpan
skolsSpan [TcTyVar]
skol_tvs = (SrcSpan -> SrcSpan -> SrcSpan) -> [SrcSpan] -> SrcSpan
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans ((TcTyVar -> SrcSpan) -> [TcTyVar] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map TcTyVar -> SrcSpan
forall a. NamedThing a => a -> SrcSpan
getSrcSpan [TcTyVar]
skol_tvs)

{- *********************************************************************
*                                                                      *
                Utilities for expected/actual messages
*                                                                      *
**********************************************************************-}

mk_supplementary_ea_msg :: SolverReportErrCtxt -> TypeOrKind
                        -> Type -> Type -> CtOrigin -> Either [ExpectedActualInfo] MismatchMsg
mk_supplementary_ea_msg :: SolverReportErrCtxt
-> TypeOrKind
-> Type
-> Type
-> CtOrigin
-> Either [ExpectedActualInfo] MismatchMsg
mk_supplementary_ea_msg SolverReportErrCtxt
ctxt TypeOrKind
level Type
ty1 Type
ty2 CtOrigin
orig
  | TypeEqOrigin { uo_expected :: CtOrigin -> Type
uo_expected = Type
exp, uo_actual :: CtOrigin -> Type
uo_actual = Type
act } <- CtOrigin
orig
  , Bool -> Bool
not (Type -> Type -> Type -> Type -> Bool
ea_looks_same Type
ty1 Type
ty2 Type
exp Type
act)
  = SolverReportErrCtxt
-> Maybe ErrorItem
-> TypeOrKind
-> CtOrigin
-> Either [ExpectedActualInfo] MismatchMsg
mk_ea_msg SolverReportErrCtxt
ctxt Maybe ErrorItem
forall a. Maybe a
Nothing TypeOrKind
level CtOrigin
orig
  | Bool
otherwise
  = [ExpectedActualInfo] -> Either [ExpectedActualInfo] MismatchMsg
forall a b. a -> Either a b
Left []

ea_looks_same :: Type -> Type -> Type -> Type -> Bool
-- True if the faulting types (ty1, ty2) look the same as
-- the expected/actual types (exp, act).
-- If so, we don't want to redundantly report the latter
ea_looks_same :: Type -> Type -> Type -> Type -> Bool
ea_looks_same Type
ty1 Type
ty2 Type
exp Type
act
  = (Type
act Type -> Type -> Bool
`looks_same` Type
ty1 Bool -> Bool -> Bool
&& Type
exp Type -> Type -> Bool
`looks_same` Type
ty2) Bool -> Bool -> Bool
||
    (Type
exp Type -> Type -> Bool
`looks_same` Type
ty1 Bool -> Bool -> Bool
&& Type
act Type -> Type -> Bool
`looks_same` Type
ty2)
  where
    looks_same :: Type -> Type -> Bool
looks_same Type
t1 Type
t2 = Type
t1 Type -> Type -> Bool
`pickyEqType` Type
t2
                    Bool -> Bool -> Bool
|| Type
t1 Type -> Type -> Bool
`eqType` Type
liftedTypeKind Bool -> Bool -> Bool
&& Type
t2 Type -> Type -> Bool
`eqType` Type
liftedTypeKind
      -- pickyEqType is sensitive to synonyms, so only replies True
      -- when the types really look the same.  However,
      -- (TYPE 'LiftedRep) and Type both print the same way.

mk_ea_msg :: SolverReportErrCtxt -> Maybe ErrorItem -> TypeOrKind
          -> CtOrigin -> Either [ExpectedActualInfo] MismatchMsg
-- Constructs a "Couldn't match" message
-- The (Maybe ErrorItem) says whether this is the main top-level message (Just)
--     or a supplementary message (Nothing)
mk_ea_msg :: SolverReportErrCtxt
-> Maybe ErrorItem
-> TypeOrKind
-> CtOrigin
-> Either [ExpectedActualInfo] MismatchMsg
mk_ea_msg SolverReportErrCtxt
ctxt Maybe ErrorItem
at_top TypeOrKind
level
  (TypeEqOrigin { uo_actual :: CtOrigin -> Type
uo_actual = Type
act, uo_expected :: CtOrigin -> Type
uo_expected = Type
exp, uo_thing :: CtOrigin -> Maybe TypedThing
uo_thing = Maybe TypedThing
mb_thing })
  | Just TypedThing
thing <- Maybe TypedThing
mb_thing
  , TypeOrKind
KindLevel <- TypeOrKind
level
  = MismatchMsg -> Either [ExpectedActualInfo] MismatchMsg
forall a b. b -> Either a b
Right (MismatchMsg -> Either [ExpectedActualInfo] MismatchMsg)
-> MismatchMsg -> Either [ExpectedActualInfo] MismatchMsg
forall a b. (a -> b) -> a -> b
$ KindMismatch { kmismatch_what :: TypedThing
kmismatch_what     = TypedThing
thing
                         , kmismatch_expected :: Type
kmismatch_expected = Type
exp
                         , kmismatch_actual :: Type
kmismatch_actual   = Type
act }
  | Just ErrorItem
item <- Maybe ErrorItem
at_top
  , let  ea :: MismatchEA
ea = Maybe ExpectedActualInfo -> MismatchEA
EA (Maybe ExpectedActualInfo -> MismatchEA)
-> Maybe ExpectedActualInfo -> MismatchEA
forall a b. (a -> b) -> a -> b
$ if Bool
expanded_syns then ExpectedActualInfo -> Maybe ExpectedActualInfo
forall a. a -> Maybe a
Just ExpectedActualInfo
ea_expanded else Maybe ExpectedActualInfo
forall a. Maybe a
Nothing
         mismatch :: MismatchMsg
mismatch = MismatchEA -> ErrorItem -> Type -> Type -> MismatchMsg
mkBasicMismatchMsg MismatchEA
ea ErrorItem
item Type
exp Type
act
  = MismatchMsg -> Either [ExpectedActualInfo] MismatchMsg
forall a b. b -> Either a b
Right MismatchMsg
mismatch
  | Bool
otherwise
  = [ExpectedActualInfo] -> Either [ExpectedActualInfo] MismatchMsg
forall a b. a -> Either a b
Left ([ExpectedActualInfo] -> Either [ExpectedActualInfo] MismatchMsg)
-> [ExpectedActualInfo] -> Either [ExpectedActualInfo] MismatchMsg
forall a b. (a -> b) -> a -> b
$
    if Bool
expanded_syns
    then [ExpectedActualInfo
ea,ExpectedActualInfo
ea_expanded]
    else [ExpectedActualInfo
ea]

  where
    ea :: ExpectedActualInfo
ea = ExpectedActual { ea_expected :: Type
ea_expected = Type
exp, ea_actual :: Type
ea_actual = Type
act }
    ea_expanded :: ExpectedActualInfo
ea_expanded =
      ExpectedActualAfterTySynExpansion
        { ea_expanded_expected :: Type
ea_expanded_expected = Type
expTy1
        , ea_expanded_actual :: Type
ea_expanded_actual   = Type
expTy2 }

    expanded_syns :: Bool
expanded_syns = SolverReportErrCtxt -> Bool
cec_expand_syns SolverReportErrCtxt
ctxt
                 Bool -> Bool -> Bool
&& Bool -> Bool
not (Type
expTy1 Type -> Type -> Bool
`pickyEqType` Type
exp Bool -> Bool -> Bool
&& Type
expTy2 Type -> Type -> Bool
`pickyEqType` Type
act)
    (Type
expTy1, Type
expTy2) = Type -> Type -> (Type, Type)
expandSynonymsToMatch Type
exp Type
act
mk_ea_msg SolverReportErrCtxt
_ Maybe ErrorItem
_ TypeOrKind
_ CtOrigin
_ = [ExpectedActualInfo] -> Either [ExpectedActualInfo] MismatchMsg
forall a b. a -> Either a b
Left []

{- Note [Expanding type synonyms to make types similar]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

In type error messages, if -fprint-expanded-types is used, we want to expand
type synonyms to make expected and found types as similar as possible, but we
shouldn't expand types too much to make type messages even more verbose and
harder to understand. The whole point here is to make the difference in expected
and found types clearer.

`expandSynonymsToMatch` does this, it takes two types, and expands type synonyms
only as much as necessary. Given two types t1 and t2:

  * If they're already same, it just returns the types.

  * If they're in form `C1 t1_1 .. t1_n` and `C2 t2_1 .. t2_m` (C1 and C2 are
    type constructors), it expands C1 and C2 if they're different type synonyms.
    Then it recursively does the same thing on expanded types. If C1 and C2 are
    same, then it applies the same procedure to arguments of C1 and arguments of
    C2 to make them as similar as possible.

    Most important thing here is to keep number of synonym expansions at
    minimum. For example, if t1 is `T (T3, T5, Int)` and t2 is `T (T5, T3,
    Bool)` where T5 = T4, T4 = T3, ..., T1 = X, it returns `T (T3, T3, Int)` and
    `T (T3, T3, Bool)`.

  * Otherwise types don't have same shapes and so the difference is clearly
    visible. It doesn't do any expansions and show these types.

Note that we only expand top-layer type synonyms. Only when top-layer
constructors are the same we start expanding inner type synonyms.

Suppose top-layer type synonyms of t1 and t2 can expand N and M times,
respectively. If their type-synonym-expanded forms will meet at some point (i.e.
will have same shapes according to `sameShapes` function), it's possible to find
where they meet in O(N+M) top-layer type synonym expansions and O(min(N,M))
comparisons. We first collect all the top-layer expansions of t1 and t2 in two
lists, then drop the prefix of the longer list so that they have same lengths.
Then we search through both lists in parallel, and return the first pair of
types that have same shapes. Inner types of these two types with same shapes
are then expanded using the same algorithm.

In case they don't meet, we return the last pair of types in the lists, which
has top-layer type synonyms completely expanded. (in this case the inner types
are not expanded at all, as the current form already shows the type error)
-}

-- | Expand type synonyms in given types only enough to make them as similar as
-- possible. Returned types are the same in terms of used type synonyms.
--
-- To expand all synonyms, see 'Type.expandTypeSynonyms'.
--
-- See `ExpandSynsFail` tests in tests testsuite/tests/typecheck/should_fail for
-- some examples of how this should work.
expandSynonymsToMatch :: Type -> Type -> (Type, Type)
expandSynonymsToMatch :: Type -> Type -> (Type, Type)
expandSynonymsToMatch Type
ty1 Type
ty2 = (Type
ty1_ret, Type
ty2_ret)
  where
    (Type
ty1_ret, Type
ty2_ret) = Type -> Type -> (Type, Type)
go Type
ty1 Type
ty2

    -- Returns (type synonym expanded version of first type,
    --          type synonym expanded version of second type)
    go :: Type -> Type -> (Type, Type)
    go :: Type -> Type -> (Type, Type)
go Type
t1 Type
t2
      | Type
t1 Type -> Type -> Bool
`pickyEqType` Type
t2 =
        -- Types are same, nothing to do
        (Type
t1, Type
t2)

    go (TyConApp TyCon
tc1 [Type]
tys1) (TyConApp TyCon
tc2 [Type]
tys2)
      | TyCon
tc1 TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
tc2
      , [Type]
tys1 [Type] -> [Type] -> Bool
forall a b. [a] -> [b] -> Bool
`equalLength` [Type]
tys2 =
        -- Type constructors are same. They may be synonyms, but we don't
        -- expand further. The lengths of tys1 and tys2 must be equal;
        -- for example, with type S a = a, we don't want
        -- to zip (S Monad Int) and (S Bool).
        let ([Type]
tys1', [Type]
tys2') =
              [(Type, Type)] -> ([Type], [Type])
forall a b. [(a, b)] -> ([a], [b])
unzip (String
-> (Type -> Type -> (Type, Type))
-> [Type]
-> [Type]
-> [(Type, Type)]
forall a b c.
(() :: Constraint) =>
String -> (a -> b -> c) -> [a] -> [b] -> [c]
zipWithEqual String
"expandSynonymsToMatch" Type -> Type -> (Type, Type)
go [Type]
tys1 [Type]
tys2)
         in (TyCon -> [Type] -> Type
TyConApp TyCon
tc1 [Type]
tys1', TyCon -> [Type] -> Type
TyConApp TyCon
tc2 [Type]
tys2')

    go (AppTy Type
t1_1 Type
t1_2) (AppTy Type
t2_1 Type
t2_2) =
      let (Type
t1_1', Type
t2_1') = Type -> Type -> (Type, Type)
go Type
t1_1 Type
t2_1
          (Type
t1_2', Type
t2_2') = Type -> Type -> (Type, Type)
go Type
t1_2 Type
t2_2
       in (Type -> Type -> Type
mkAppTy Type
t1_1' Type
t1_2', Type -> Type -> Type
mkAppTy Type
t2_1' Type
t2_2')

    go ty1 :: Type
ty1@(FunTy FunTyFlag
_ Type
w1 Type
t1_1 Type
t1_2) ty2 :: Type
ty2@(FunTy FunTyFlag
_ Type
w2 Type
t2_1 Type
t2_2) | Type
w1 Type -> Type -> Bool
`eqType` Type
w2 =
      let (Type
t1_1', Type
t2_1') = Type -> Type -> (Type, Type)
go Type
t1_1 Type
t2_1
          (Type
t1_2', Type
t2_2') = Type -> Type -> (Type, Type)
go Type
t1_2 Type
t2_2
       in ( Type
ty1 { ft_arg = t1_1', ft_res = t1_2' }
          , Type
ty2 { ft_arg = t2_1', ft_res = t2_2' })

    go (ForAllTy VarBndr TcTyVar ForAllTyFlag
b1 Type
t1) (ForAllTy VarBndr TcTyVar ForAllTyFlag
b2 Type
t2) =
      -- NOTE: We may have a bug here, but we just can't reproduce it easily.
      -- See D1016 comments for details and our attempts at producing a test
      -- case. Short version: We probably need RnEnv2 to really get this right.
      let (Type
t1', Type
t2') = Type -> Type -> (Type, Type)
go Type
t1 Type
t2
       in (VarBndr TcTyVar ForAllTyFlag -> Type -> Type
ForAllTy VarBndr TcTyVar ForAllTyFlag
b1 Type
t1', VarBndr TcTyVar ForAllTyFlag -> Type -> Type
ForAllTy VarBndr TcTyVar ForAllTyFlag
b2 Type
t2')

    go (CastTy Type
ty1 KindCoercion
_) Type
ty2 = Type -> Type -> (Type, Type)
go Type
ty1 Type
ty2
    go Type
ty1 (CastTy Type
ty2 KindCoercion
_) = Type -> Type -> (Type, Type)
go Type
ty1 Type
ty2

    go Type
t1 Type
t2 =
      -- See Note [Expanding type synonyms to make types similar] for how this
      -- works
      let
        t1_exp_tys :: [Type]
t1_exp_tys = Type
t1 Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
: Type -> [Type]
tyExpansions Type
t1
        t2_exp_tys :: [Type]
t2_exp_tys = Type
t2 Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
: Type -> [Type]
tyExpansions Type
t2
        t1_exps :: Int
t1_exps    = [Type] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
t1_exp_tys
        t2_exps :: Int
t2_exps    = [Type] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
t2_exp_tys
        dif :: Int
dif        = Int -> Int
forall a. Num a => a -> a
abs (Int
t1_exps Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
t2_exps)
      in
        [(Type, Type)] -> (Type, Type)
followExpansions ([(Type, Type)] -> (Type, Type)) -> [(Type, Type)] -> (Type, Type)
forall a b. (a -> b) -> a -> b
$
          String -> [Type] -> [Type] -> [(Type, Type)]
forall a b. (() :: Constraint) => String -> [a] -> [b] -> [(a, b)]
zipEqual String
"expandSynonymsToMatch.go"
            (if Int
t1_exps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
t2_exps then Int -> [Type] -> [Type]
forall a. Int -> [a] -> [a]
drop Int
dif [Type]
t1_exp_tys else [Type]
t1_exp_tys)
            (if Int
t2_exps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
t1_exps then Int -> [Type] -> [Type]
forall a. Int -> [a] -> [a]
drop Int
dif [Type]
t2_exp_tys else [Type]
t2_exp_tys)

    -- Expand the top layer type synonyms repeatedly, collect expansions in a
    -- list. The list does not include the original type.
    --
    -- Example, if you have:
    --
    --   type T10 = T9
    --   type T9  = T8
    --   ...
    --   type T0  = Int
    --
    -- `tyExpansions T10` returns [T9, T8, T7, ... Int]
    --
    -- This only expands the top layer, so if you have:
    --
    --   type M a = Maybe a
    --
    -- `tyExpansions (M T10)` returns [Maybe T10] (T10 is not expanded)
    tyExpansions :: Type -> [Type]
    tyExpansions :: Type -> [Type]
tyExpansions = (Type -> Maybe (Type, Type)) -> Type -> [Type]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (\Type
t -> (\Type
x -> (Type
x, Type
x)) (Type -> (Type, Type)) -> Maybe Type -> Maybe (Type, Type)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Type -> Maybe Type
coreView Type
t)

    -- Drop the type pairs until types in a pair look alike (i.e. the outer
    -- constructors are the same).
    followExpansions :: [(Type, Type)] -> (Type, Type)
    followExpansions :: [(Type, Type)] -> (Type, Type)
followExpansions [] = String -> SDoc -> (Type, Type)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"followExpansions" SDoc
forall doc. IsOutput doc => doc
empty
    followExpansions [(Type
t1, Type
t2)]
      | Type -> Type -> Bool
sameShapes Type
t1 Type
t2 = Type -> Type -> (Type, Type)
go Type
t1 Type
t2 -- expand subtrees
      | Bool
otherwise        = (Type
t1, Type
t2) -- the difference is already visible
    followExpansions ((Type
t1, Type
t2) : [(Type, Type)]
tss)
      -- Traverse subtrees when the outer shapes are the same
      | Type -> Type -> Bool
sameShapes Type
t1 Type
t2 = Type -> Type -> (Type, Type)
go Type
t1 Type
t2
      -- Otherwise follow the expansions until they look alike
      | Bool
otherwise = [(Type, Type)] -> (Type, Type)
followExpansions [(Type, Type)]
tss

    sameShapes :: Type -> Type -> Bool
    sameShapes :: Type -> Type -> Bool
sameShapes AppTy{}          AppTy{}          = Bool
True
    sameShapes (TyConApp TyCon
tc1 [Type]
_) (TyConApp TyCon
tc2 [Type]
_) = TyCon
tc1 TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
tc2
    sameShapes (FunTy {})       (FunTy {})       = Bool
True
    sameShapes (ForAllTy {})    (ForAllTy {})    = Bool
True
    sameShapes (CastTy Type
ty1 KindCoercion
_)   Type
ty2              = Type -> Type -> Bool
sameShapes Type
ty1 Type
ty2
    sameShapes Type
ty1              (CastTy Type
ty2 KindCoercion
_)   = Type -> Type -> Bool
sameShapes Type
ty1 Type
ty2
    sameShapes Type
_                Type
_                = Bool
False

{-
************************************************************************
*                                                                      *
\subsection{Contexts for renaming errors}
*                                                                      *
************************************************************************
-}

inHsDocContext :: HsDocContext -> SDoc
inHsDocContext :: HsDocContext -> SDoc
inHsDocContext HsDocContext
ctxt = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"In" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsDocContext -> SDoc
pprHsDocContext HsDocContext
ctxt

pprHsDocContext :: HsDocContext -> SDoc
pprHsDocContext :: HsDocContext -> SDoc
pprHsDocContext (GenericCtx SDoc
doc)      = SDoc
doc
pprHsDocContext (TypeSigCtx SDoc
doc)      = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the type signature for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
doc
pprHsDocContext (StandaloneKindSigCtx SDoc
doc) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the standalone kind signature for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
doc
pprHsDocContext HsDocContext
PatCtx                = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a pattern type-signature"
pprHsDocContext HsDocContext
SpecInstSigCtx        = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a SPECIALISE instance pragma"
pprHsDocContext HsDocContext
DefaultDeclCtx        = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a `default' declaration"
pprHsDocContext HsDocContext
DerivDeclCtx          = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a deriving declaration"
pprHsDocContext (RuleCtx CLabelString
name)        = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the rewrite rule" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
doubleQuotes (CLabelString -> SDoc
forall doc. IsLine doc => CLabelString -> doc
ftext CLabelString
name)
pprHsDocContext (TyDataCtx LocatedN RdrName
tycon)     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the data type declaration for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (LocatedN RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocatedN RdrName
tycon)
pprHsDocContext (FamPatCtx LocatedN RdrName
tycon)     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a type pattern of family instance for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (LocatedN RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocatedN RdrName
tycon)
pprHsDocContext (TySynCtx LocatedN RdrName
name)       = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the declaration for type synonym" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (LocatedN RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocatedN RdrName
name)
pprHsDocContext (TyFamilyCtx LocatedN RdrName
name)    = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the declaration for type family" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (LocatedN RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocatedN RdrName
name)
pprHsDocContext (ClassDeclCtx LocatedN RdrName
name)   = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the declaration for class" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (LocatedN RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocatedN RdrName
name)
pprHsDocContext HsDocContext
ExprWithTySigCtx      = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"an expression type signature"
pprHsDocContext HsDocContext
TypBrCtx              = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a Template-Haskell quoted type"
pprHsDocContext HsDocContext
HsTypeCtx             = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a type argument"
pprHsDocContext HsDocContext
HsTypePatCtx          = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"a type argument in a pattern"
pprHsDocContext HsDocContext
GHCiCtx               = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"GHCi input"
pprHsDocContext (SpliceTypeCtx LHsType GhcPs
hs_ty) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the spliced type" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (GenLocated SrcSpanAnnA (HsType GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
hs_ty)
pprHsDocContext HsDocContext
ClassInstanceCtx      = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"GHC.Tc.Gen.Splice.reifyInstances"

pprHsDocContext (ForeignDeclCtx LocatedN RdrName
name)
   = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the foreign declaration for" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (LocatedN RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocatedN RdrName
name)
pprHsDocContext (ConDeclCtx [LocatedN Name
name])
   = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the definition of data constructor" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (LocatedN Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocatedN Name
name)
pprHsDocContext (ConDeclCtx [LocatedN Name]
names)
   = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"the definition of data constructors" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [LocatedN Name] -> SDoc
forall a. Outputable a => [a] -> SDoc
interpp'SP [LocatedN Name]
names

pprConversionFailReason :: ConversionFailReason -> SDoc
pprConversionFailReason :: ConversionFailReason -> SDoc
pprConversionFailReason = \case
  IllegalOccName NameSpace
ctxt_ns String
occ ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> NameSpace -> SDoc
pprNameSpace NameSpace
ctxt_ns
    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"name:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
occ)
  SumAltArityExceeded Int
alt Int
arity ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Sum alternative" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
alt
    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"exceeds its arity," SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
arity
  IllegalSumAlt Int
alt ->
    [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal sum alternative:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
alt
         , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Sum alternatives must start from 1" ]
  IllegalSumArity Int
arity ->
    [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal sum arity:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
arity
         , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Sums must have an arity of at least 2" ]
  MalformedType TypeOrKind
typeOrKind Type
ty ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Malformed " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
ty_str SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text (Type -> String
forall a. Show a => a -> String
show Type
ty)
    where ty_str :: String
ty_str = case TypeOrKind
typeOrKind of
                     TypeOrKind
TypeLevel -> String
"type"
                     TypeOrKind
KindLevel -> String
"kind"
  IllegalLastStatement HsDoFlavour
do_or_lc LStmt GhcPs (LHsExpr GhcPs)
stmt ->
    [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal last statement of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HsDoFlavour -> SDoc
pprAHsDoFlavour HsDoFlavour
do_or_lc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon
         , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SDoc
forall a. Outputable a => a -> SDoc
ppr LStmt GhcPs (LHsExpr GhcPs)
GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
stmt
         , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(It should be an expression.)" ]
  ConversionFailReason
KindSigsOnlyAllowedOnGADTs ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Kind signatures are only allowed on GADTs"
  IllegalDeclaration THDeclDescriptor
declDescr IllegalDecls
bad_decls ->
    [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Illegal" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
what SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
descrDoc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon
        , Int -> SDoc -> SDoc
nest Int
2 SDoc
bads ]
    where
      (SDoc
what, SDoc
bads) = case IllegalDecls
bad_decls of
        IllegalDecls (NonEmpty (LHsDecl GhcPs) -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
NonEmpty (GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. NonEmpty a -> [a]
NE.toList -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls) ->
            (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"declaration" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [GenLocated SrcSpanAnnA (HsDecl GhcPs)] -> SDoc
forall a. [a] -> SDoc
plural [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls, [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsDecl GhcPs) -> SDoc)
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (HsDecl GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
decls)
        IllegalFamDecls (NonEmpty (LFamilyDecl GhcPs)
-> [GenLocated SrcSpanAnnA (FamilyDecl GhcPs)]
NonEmpty (GenLocated SrcSpanAnnA (FamilyDecl GhcPs))
-> [GenLocated SrcSpanAnnA (FamilyDecl GhcPs)]
forall a. NonEmpty a -> [a]
NE.toList -> [GenLocated SrcSpanAnnA (FamilyDecl GhcPs)]
decls) ->
            ( String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"family declaration" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> [GenLocated SrcSpanAnnA (FamilyDecl GhcPs)] -> SDoc
forall a. [a] -> SDoc
plural [GenLocated SrcSpanAnnA (FamilyDecl GhcPs)]
decls, [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (FamilyDecl GhcPs) -> SDoc)
-> [GenLocated SrcSpanAnnA (FamilyDecl GhcPs)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (FamilyDecl GhcPs) -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GenLocated SrcSpanAnnA (FamilyDecl GhcPs)]
decls)
      descrDoc :: SDoc
descrDoc = String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ case THDeclDescriptor
declDescr of
                   THDeclDescriptor
InstanceDecl -> String
"an instance declaration"
                   THDeclDescriptor
WhereClause -> String
"a where clause"
                   THDeclDescriptor
LetBinding -> String
"a let expression"
                   THDeclDescriptor
LetExpression -> String
"a let expression"
                   THDeclDescriptor
ClssDecl -> String
"a class declaration"
  ConversionFailReason
CannotMixGADTConsWith98Cons ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Cannot mix GADT constructors with Haskell 98"
    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"constructors"
  ConversionFailReason
EmptyStmtListInDoBlock ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Empty stmt list in do-block"
  ConversionFailReason
NonVarInInfixExpr ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Non-variable expression is not allowed in an infix expression"
  ConversionFailReason
MultiWayIfWithoutAlts ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Multi-way if-expression with no alternatives"
  ConversionFailReason
CasesExprWithoutAlts ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"\\cases expression with no alternatives"
  ConversionFailReason
ImplicitParamsWithOtherBinds ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Implicit parameters mixed with other bindings"
  InvalidCCallImpent String
from ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> String
forall a. Show a => a -> String
show String
from) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is not a valid ccall impent"
  ConversionFailReason
RecGadtNoCons ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RecGadtC must have at least one constructor name"
  ConversionFailReason
GadtNoCons ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"GadtC must have at least one constructor name"
  InvalidTypeInstanceHeader Type
tys ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Invalid type instance header:"
    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text (Type -> String
forall a. Show a => a -> String
show Type
tys)
  InvalidTyFamInstLHS Type
lhs ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Invalid type family instance LHS:"
    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text (Type -> String
forall a. Show a => a -> String
show Type
lhs)
  ConversionFailReason
InvalidImplicitParamBinding ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Implicit parameter binding only allowed in let or where"
  DefaultDataInstDecl [LDataFamInstDecl GhcPs]
adts ->
    (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Default data instance declarations"
    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"are not allowed:")
      SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ [GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [LDataFamInstDecl GhcPs]
[GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)]
adts
  FunBindLacksEquations Name
nm ->
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Function binding for"
    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text (Name -> String
forall a. Ppr a => a -> String
TH.pprint Name
nm))
    SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"has no equations"