+import GHC.Tc.Types.ErrCtxt( UserTypeCtxt(..) )

+       ; let ctxt = GHC.Tc.Types.ErrCtxt.InstDeclCtxt True

+import GHC.Tc.Types.ErrCtxt( UserTypeCtxt( InstDeclCtxt, DerivClauseCtxt ) )

+import GHC.Tc.Types.ErrCtxt( redundantConstraintsSpan )

+

+         , nest 2 (hang (text "fits the type of its context:") 2 pp_res_ty) ]

+    where

+      -- Zonking will have turned Infer into Check

+      pp_res_ty = case res_ty of

+                    Check ty -> ppr ty

+                    Infer ir -> text "OOPS" <+> ppr ir

+

+                           , TyVarBndrs, TypedThing

+import GHC.Tc.Types.ErrCtxt( ReportRedundantConstraints(..) )

+import GHC.Tc.Types.ErrCtxt( ReportRedundantConstraints(..) )

+import GHC.Tc.Types.ErrCtxt( UserTypeCtxt( GenSigCtxt ), pprUserTypeCtxt )

+import GHC.Tc.Types.ErrCtxt   ( UserTypeCtxt )

+                ; wrap <- addErrCtxtM (PatSigErrCtxt sig_ty res_ty) $

+              wrap <- addErrCtxtM (PatSigErrCtxt sig_ty res_ty) $

+import GHC.Tc.Types.ErrCtxt( ReportRedundantConstraints(..) )

+import GHC.Tc.Types.ErrCtxt( ReportRedundantConstraints(..) )

+import GHC.Tc.Types.ErrCtxt( UserTypeCtxt(..), reportRedundantConstraints )

+import GHC.Tc.Types.ErrCtxt( ReportRedundantConstraints(..) )

+import GHC.Tc.Types.ErrCtxt( ReportRedundantConstraints(..) )

+import GHC.Tc.Types.ErrCtxt( ReportRedundantConstraints(..) )

+import GHC.Tc.Types.ErrCtxt( UserTypeCtxt(..) )

+import GHC.Tc.Types.ErrCtxt( UserTypeCtxt )

+import GHC.Tc.Types.ErrCtxt

+

+  -- * UserTypeCtxt

+  , UserTypeCtxt(..), pprUserTypeCtxt, isSigMaybe

+  , ReportRedundantConstraints(..), reportRedundantConstraints

+  , redundantConstraintsSpan,

+import {-# SOURCE #-} GHC.Tc.Types.Origin   ( CtOrigin )

+import GHC.Tc.Utils.TcType   ( TcType, TcTyCon, ExpType )

+import GHC.Types.SrcLoc      ( SrcSpan, noSrcSpan )

+import GHC.Utils.Outputable

+{- *********************************************************************

+*                                                                      *

+          UserTypeCtxt

+*                                                                      *

+********************************************************************* -}

+

+-------------------------------------

+-- | UserTypeCtxt describes the origin of the polymorphic type

+-- in the places where we need an expression to have that type

+data UserTypeCtxt

+  = FunSigCtxt      -- Function type signature, when checking the type

+                    -- Also used for types in SPECIALISE pragmas

+       Name              -- Name of the function

+       ReportRedundantConstraints

+         -- See Note [Tracking needed EvIds] in GHC.Tc.Solver

+         -- This field is usually 'WantRCC', but 'NoRCC' for

+         --   * Record selectors (not important here)

+         --   * Class and instance methods.  Here the code may legitimately

+         --     be more polymorphic than the signature generated from the

+         --     class declaration

+         --   * Functions whose type signature has hidden the constraints

+         --     behind a type synonym.  E.g.

+         --          type Foo = forall a. Eq a => a -> a

+         --          id :: Foo

+         --          id x = x

+         --     Here we can't give a good location for the redundant constraints

+         --     (see lhsSigWcTypeContextSpan), so we don't report redundant

+         --     constraints at all. It's not clear that this a good choice;

+         --     perhaps we should report, just with a less informative SrcSpan.

+         --     c.f. #16154

+

+  | InfSigCtxt Name     -- Inferred type for function

+  | ExprSigCtxt         -- Expression type signature

+      ReportRedundantConstraints

+  | KindSigCtxt         -- Kind signature

+  | StandaloneKindSigCtxt  -- Standalone kind signature

+       Name                -- Name of the type/class

+  | TypeAppCtxt         -- Visible type application

+  | ConArgCtxt Name     -- Data constructor argument

+  | TySynCtxt Name      -- RHS of a type synonym decl

+  | PatSynCtxt Name     -- Type sig for a pattern synonym

+  | PatSigCtxt          -- Type sig in pattern

+                        --   eg  f (x::t) = ...

+                        --   or  (x::t, y) = e

+  | ForSigCtxt Name     -- Foreign import or export signature

+  | DefaultDeclCtxt     -- Class or types in a default declaration

+  | InstDeclCtxt Bool   -- An instance declaration

+                        --    True:  stand-alone deriving

+                        --    False: vanilla instance declaration

+  | SpecInstCtxt        -- SPECIALISE instance pragma

+  | GenSigCtxt          -- Higher-rank or impredicative situations

+                        -- e.g. (f e) where f has a higher-rank type

+                        -- We might want to elaborate this

+  | GhciCtxt Bool       -- GHCi command :kind <type>

+                        -- The Bool indicates if we are checking the outermost

+                        -- type application.

+                        -- See Note [Unsaturated type synonyms in GHCi] in

+                        -- GHC.Tc.Validity.

+

+  | ClassSCCtxt Name    -- Superclasses of a class

+  | SigmaCtxt           -- Theta part of a normal for-all type

+                        --      f :: <S> => a -> a

+  | DataTyCtxt Name     -- The "stupid theta" part of a data decl

+                        --      data <S> => T a = MkT a

+  | DerivClauseCtxt     -- A 'deriving' clause

+  | TyVarBndrKindCtxt Name  -- The kind of a type variable being bound

+  | RuleBndrTypeCtxt Name   -- The type of a term variable being bound in a RULE

+                            -- or SPECIALISE pragma

+                            --    RULE "foo" forall (x :: a -> a). f (Just x) = ...

+  | DataKindCtxt Name   -- The kind of a data/newtype (instance)

+  | TySynKindCtxt Name  -- The kind of the RHS of a type synonym

+  | TyFamResKindCtxt Name   -- The result kind of a type family

+  deriving( Eq ) -- Just for checkSkolInfoAnon

+

+-- | Report Redundant Constraints.

+data ReportRedundantConstraints

+  = NoRRC            -- ^ Don't report redundant constraints

+

+  | WantRRC SrcSpan  -- ^ Report redundant constraints

+      -- The SrcSpan is for the constraints

+      -- E.g. f :: (Eq a, Ord b) => blah

+      --      The span is for the (Eq a, Ord b)

+      -- We need to record the span here because we have

+      -- long since discarded the HsType in favour of a Type

+

+  deriving( Eq )  -- Just for checkSkolInfoAnon

+

+reportRedundantConstraints :: ReportRedundantConstraints -> Bool

+reportRedundantConstraints NoRRC        = False

+reportRedundantConstraints (WantRRC {}) = True

+

+redundantConstraintsSpan :: UserTypeCtxt -> SrcSpan

+redundantConstraintsSpan (FunSigCtxt _ (WantRRC span)) = span

+redundantConstraintsSpan (ExprSigCtxt (WantRRC span))  = span

+redundantConstraintsSpan _ = noSrcSpan

+

+{-

+-- Notes re TySynCtxt

+-- We allow type synonyms that aren't types; e.g.  type List = []

+--

+-- If the RHS mentions tyvars that aren't in scope, we'll

+-- quantify over them:

+--      e.g.    type T = a->a

+-- will become  type T = forall a. a->a

+--

+-- With gla-exts that's right, but for H98 we should complain.

+-}

+

+

+pprUserTypeCtxt :: UserTypeCtxt -> SDoc

+pprUserTypeCtxt (FunSigCtxt n _)   = text "the type signature for" <+> quotes (ppr n)

+pprUserTypeCtxt (InfSigCtxt n)     = text "the inferred type for" <+> quotes (ppr n)

+pprUserTypeCtxt (ExprSigCtxt _)    = text "an expression type signature"

+pprUserTypeCtxt KindSigCtxt        = text "a kind signature"

+pprUserTypeCtxt (StandaloneKindSigCtxt n) = text "a standalone kind signature for" <+> quotes (ppr n)

+pprUserTypeCtxt TypeAppCtxt       = text "a type argument"

+pprUserTypeCtxt (ConArgCtxt c)    = text "the type of the constructor" <+> quotes (ppr c)

+pprUserTypeCtxt (TySynCtxt c)     = text "the RHS of the type synonym" <+> quotes (ppr c)

+pprUserTypeCtxt PatSigCtxt        = text "a pattern type signature"

+pprUserTypeCtxt (ForSigCtxt n)    = text "the foreign declaration for" <+> quotes (ppr n)

+pprUserTypeCtxt DefaultDeclCtxt   = text "a `default' declaration"

+pprUserTypeCtxt (InstDeclCtxt False) = text "an instance declaration"

+pprUserTypeCtxt (InstDeclCtxt True)  = text "a stand-alone deriving instance declaration"

+pprUserTypeCtxt SpecInstCtxt      = text "a SPECIALISE instance pragma"

+pprUserTypeCtxt GenSigCtxt        = text "a type expected by the context"

+pprUserTypeCtxt (GhciCtxt {})     = text "a type in a GHCi command"

+pprUserTypeCtxt (ClassSCCtxt c)   = text "the super-classes of class" <+> quotes (ppr c)

+pprUserTypeCtxt SigmaCtxt         = text "the context of a polymorphic type"

+pprUserTypeCtxt (DataTyCtxt tc)   = text "the context of the data type declaration for" <+> quotes (ppr tc)

+pprUserTypeCtxt (PatSynCtxt n)    = text "the signature for pattern synonym" <+> quotes (ppr n)

+pprUserTypeCtxt (DerivClauseCtxt) = text "a `deriving' clause"

+pprUserTypeCtxt (TyVarBndrKindCtxt n) = text "the kind annotation on the type variable" <+> quotes (ppr n)

+pprUserTypeCtxt (RuleBndrTypeCtxt n)  = text "the type signature for" <+> quotes (ppr n)

+pprUserTypeCtxt (DataKindCtxt n)  = text "the kind annotation on the declaration for" <+> quotes (ppr n)

+pprUserTypeCtxt (TySynKindCtxt n) = text "the kind annotation on the declaration for" <+> quotes (ppr n)

+pprUserTypeCtxt (TyFamResKindCtxt n) = text "the result kind for" <+> quotes (ppr n)

+

+isSigMaybe :: UserTypeCtxt -> Maybe Name

+isSigMaybe (FunSigCtxt n _) = Just n

+isSigMaybe (ConArgCtxt n)   = Just n

+isSigMaybe (ForSigCtxt n)   = Just n

+isSigMaybe (PatSynCtxt n)   = Just n

+isSigMaybe _                = Nothing

+

+

+{- *********************************************************************

+*                                                                      *

+          ErrCtxt

+*                                                                      *

+********************************************************************* -}

+  | PatSigErrCtxt !TcType !ExpType

+import GHC.Tc.Types.ErrCtxt( UserTypeCtxt(..), ReportRedundantConstraints(..)

+                           , pprUserTypeCtxt  )

+import GHC.Tc.Types.ErrCtxt