import GHC.Utils.Constants (debugIsOn)

 import GHC.Parser.Annotation

 import GHC.Hs.Doc

 import GHC.Unit.Module.ModIface (IfaceExport)

 import GHC.Unit.Module.Warnings

     ]

 -- See Note [GHC.Prim Deprecations]

 ghcPrimWarns = WarnSome

   -- declaration warnings

   (map mk_decl_dep primOpDeprecations)

 The bits common to GHC.Tc.TyCl.Instance and GHC.Tc.Deriv.

 -}

 module GHC.Core.InstEnv (

         DFunId, InstMatch, ClsInstLookupResult,

 import GHC.Types.Basic

 import GHC.Types.Id

 import GHC.Generics (Generic)

 import Data.List.NonEmpty ( NonEmpty (..), nonEmpty )

 import qualified Data.List.NonEmpty as NE

 import Data.Maybe       ( isJust )

                 -- See Note [Implementation of deprecated instances]

                 -- in GHC.Tc.Solver.Dict

     }

 -- | A fuzzy comparison function for class instances, intended for sorting

 -- instances before displaying them to the user.

 type instance XWarning      (GhcPass _) = (NamespaceSpecifier, (EpToken "[", EpToken "]"))

 type instance XXWarnDecl    (GhcPass _) = DataConCantHappen

 instance OutputableBndrId p

         => Outputable (WarnDecls (GhcPass p)) where

     ppr (Warnings ext decls)

               <+> ppr txt

       where

         ppr_category = case txt of

                          _ -> empty

 {-

 import GHC.Parser.Annotation

 import GHC.Types.Name.Reader (WithUserRdr(..))

 import GHC.Data.BooleanFormula (BooleanFormula(..))

 import Language.Haskell.Syntax.Extension (Anno)

 -- ---------------------------------------------------------------------

 deriving instance Data (WarnDecl GhcRn)

 deriving instance Data (WarnDecl GhcTc)

 -- deriving instance (DataIdLR p p) => Data (AnnDecl p)

 deriving instance Data (AnnProvenance GhcPs)

 deriving instance Data (AnnProvenance GhcRn)

                [(IfExtName, IfaceWarningTxt)]

 data IfaceWarningTxt

 data IfaceStringLiteral

   = IfStringLiteral SourceText FastString

 fromIfaceWarningTxt :: IfaceWarningTxt -> WarningTxt GhcRn

 fromIfaceWarningTxt = \case

     IfDeprecatedTxt src strs -> DeprecatedTxt src (noLocA <$> map fromIfaceStringLiteralWithNames strs)

 fromIfaceStringLiteralWithNames :: (IfaceStringLiteral, [IfExtName]) -> WithHsDocIdentifiers StringLiteral GhcRn

     ds' = [(occ, toIfaceWarningTxt txt) | (occ, txt) <- ds]

 toIfaceWarningTxt :: WarningTxt GhcRn -> IfaceWarningTxt

 toIfaceWarningTxt (DeprecatedTxt src strs) = IfDeprecatedTxt src (map (toIfaceStringLiteralWithNames . unLoc) strs)

 toIfaceStringLiteralWithNames :: WithHsDocIdentifiers StringLiteral GhcRn -> (IfaceStringLiteral, [IfExtName])

                             {% fmap Just $ amsr (sLL $1 $> $ DeprecatedTxt (getDEPRECATED_PRAGs $1) (map stringLiteralToHsDocWst $ snd $ unLoc $2))

                                 (AnnPragma (glR $1) (epTok $3) (fst $ unLoc $2) noAnn noAnn noAnn noAnn) }

         | '{-# WARNING' warning_category strings '#-}'

                                 (AnnPragma (glR $1) (epTok $4) (fst $ unLoc $3) noAnn noAnn noAnn noAnn)}

         |  {- empty -}      { Nothing }

                                                                     (reLoc $ sL1 $2 $ mkWarningCategory (getSTRING $2))) }

         | {- empty -}                  { Nothing }

         : warning_category namespace_spec namelist strings

                 {% fmap unitOL $ amsA' (L (comb4 $1 $2 $3 $4)

                      (Warning (unLoc $2, fst $ unLoc $4) (unLoc $3)

 namespace_spec :: { Located NamespaceSpecifier }

   : 'type'      { sL1 $1 $ TypeNamespaceSpecifier (epTok $1) }

                               rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))

 rnWarningTxt :: WarningTxt GhcPs -> RnM (WarningTxt GhcRn)

   wst' <- traverse (traverse rnHsDoc) wst

 rnWarningTxt (DeprecatedTxt st wst) = do

   wst' <- traverse (traverse rnHsDoc) wst

   pure (DeprecatedTxt st wst')

 import Control.Monad

 import GHC.Settings.Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE )

 import GHC.Unit.Module

 import GHC.Iface.Load

 import qualified GHC.LanguageExtensions as LangExt

 import GHC.Types.Var.Set

 import GHC.Types.SrcLoc

 import GHC.Builtin.Names

 import GHC.Utils.Error

 import GHC.Hs

 import GHC.Driver.Session

 import GHC.Unit.Module (getModule)

 import GHC.Unit.Module.ModIface (mi_fix)

 import GHC.Iface.Load   (loadInterfaceForName)

                nest 2 (vcat (map (ppr . hsDocString . unLoc) msg)) ]

          where

           (extra, msg) = case txt of

             DeprecatedTxt _ msg -> (" is deprecated", msg)

     TcRnRedundantSourceImport mod_name

       -> mkSimpleDecorated $

 import GHC.Unit.Types (Module)

 import GHC.Unit.State (UnitState)

 import GHC.Unit.Module.ModIface (ModIface)

 import GHC.Utils.Outputable

 import GHC.Core.Multiplicity ( scaledThing )

 import GHC.Unit.Module

 import GHC.Types.Id

 import GHC.Types.Name

 import GHC.Types.Name.Reader

 import GHC.Unit.State

 import GHC.Unit.External

 import Data.List ( mapAccumL )

 import qualified Data.List.NonEmpty as NE

 import GHC.Core.Class (Class (className))

 import GHC.Prelude

 import GHC.Tc.Utils.TcType (Type)

 import GHC.Types.Name (Name, nameUnique, stableNameCmp)

 import GHC.Types.Name.Env

 import GHC.Types.Unique.FM (lookupUFM_Directly)

 import GHC.Types.SrcLoc (SrcSpan)

 import GHC.Unit.Types (Module)

 import GHC.Utils.Outputable

   -- TcRnPragmaWarning

   GhcDiagnosticCode "WarningTxt"                                    = 63394

   GhcDiagnosticCode "DeprecatedTxt"                                 = 68441

   -- TcRnRunSliceFailure/ConversionFail

   GhcDiagnosticCode "IllegalOccName"                                = 55017

 {-# LANGUAGE LambdaCase #-}

 {-# LANGUAGE TypeFamilies #-}

 -- | Warnings for a module

 module GHC.Unit.Module.Warnings

    ( WarningCategory(..)

 import GHC.Prelude

 import GHC.Types.SourceText

 import GHC.Types.Name.Occurrence

 import GHC.Types.Name.Env

 import GHC.Unicode

 import Language.Haskell.Syntax.Extension

 import Data.List (isPrefixOf)

 -- | The @deprecations@ category is used for all DEPRECATED pragmas and for

 -- WARNING pragmas that do not specify a category.

     s = unpackFS c

     is_allowed c = isAlphaNum c || c == '\'' || c == '-'

 -- | A finite or infinite set of warning categories.

 --

 -- Unlike 'WarningFlag', there are (in principle) infinitely many warning

 type LWarningTxt pass = XRec pass (WarningTxt pass)

 -- | To which warning category does this WARNING or DEPRECATED pragma belong?

 -- See Note [Warning categories].

 warningTxtCategory _ = defaultWarningCategory

 -- | The message that the WarningTxt was specified to output

 warningTxtMessage (DeprecatedTxt _ m) = m

 -- | True if the 2 WarningTxts have the same category and messages

 warningTxtSame w1 w2

   = warningTxtCategory w1 == warningTxtCategory w2

   && literal_message w1 == literal_message w2

   && same_type

   where

     literal_message = map (hsDocString . unLoc) . warningTxtMessage

     same_type | DeprecatedTxt {} <- w1, DeprecatedTxt {} <- w2 = True

               | otherwise                                      = False

 type instance Anno (WarningTxt (GhcPass pass)) = SrcSpanAnnP

       = case lsrc of

             NoSourceText   -> pp_ws ws

             SourceText src -> ftext src <+> ctg_doc <+> pp_ws ws <+> text "#-}"

         where

           ctg_doc = maybe empty (\ctg -> ppr ctg) mcat

       = case lsrc of

           NoSourceText   -> pp_ws ds

           SourceText src -> ftext src <+> pp_ws ds <+> text "#-}"

     <+> text "]"

 pprWarningTxtForMsg (WarningTxt _ _ ws)

                      = doubleQuotes (vcat (map (ftext . sl_fs . hsDocString . unLoc) ws))

 pprWarningTxtForMsg (DeprecatedTxt _ ds)

 -- | Names that are deprecated as exports

 type ExportWarnNames pass = [(Name, WarningTxt pass)]

 emptyWarn :: Warnings p

 emptyWarn = WarnSome [] []

 {-# LANGUAGE ConstraintKinds #-}

 {-# LANGUAGE DataKinds #-}

 {-# LANGUAGE DeriveDataTypeable #-}

 {-# LANGUAGE DeriveTraversable #-}

 {-# LANGUAGE FlexibleContexts #-}

 {-# LANGUAGE FlexibleInstances #-}

 {-# LANGUAGE LambdaCase #-}

 {-# LANGUAGE ScopedTypeVariables #-}

 {-# LANGUAGE TypeApplications #-}

   FamilyResultSig(..), LFamilyResultSig, InjectivityAnn(..), LInjectivityAnn,

   -- * Grouping

     ) where

 -- friends:

                        ,TyConFlavour(..), TypeOrData(..), NewOrData(..))

 import GHC.Types.ForeignCall (CType, CCallConv, Safety, Header, CLabelString, CCallTarget, CExportSpec)

 import GHC.Hs.Doc (LHsDoc) -- ROMES:TODO Discuss in #21592 whether this is parsed AST or base AST

 import Control.Exception (assert)

 import Data.Data        hiding (TyCon, Fixity, Infix)

 import Data.Maybe

 import Data.String

 import Data.Foldable

 import Data.Traversable

 import Data.List.NonEmpty (NonEmpty (..))

 {-

 ************************************************************************

                   (LIdP pass)              -- type constructor

                   [XRec pass (Maybe Role)] -- optional annotations

   | XRoleAnnotDecl !(XXRoleAnnotDecl pass)

 type family XWarning        x

 type family XXWarnDecl      x

 -- -------------------------------------

 -- AnnDecl type families

 type family XHsAnnotation  x

 .. index::

   simple: stack trace; in GHCi

 GHCi can use the profiling system to collect stack trace information

 when running interpreted code.  To gain access to stack traces, start

 GHCi like this:

 [GHC-99991] is untested (constructor = TyVarMissingInEnv)

 [GHC-92834] is untested (constructor = BadCoercionRole)

 [GHC-93008] is untested (constructor = HsigShapeSortMismatch)

 [GHC-68444] is untested (constructor = SumAltArityExceeded)

 [GHC-63966] is untested (constructor = IllegalSumAlt)

 [GHC-28709] is untested (constructor = MalformedType)

 import GHC.Types.SourceText

 import GHC.Types.SrcLoc

 import GHC.Types.Var

 import GHC.Utils.Misc

 import GHC.Utils.Outputable hiding ( (<>) )

 import GHC.Utils.Panic

   getAnnotationEntry = entryFromLocatedA

   setAnnotationAnchor = setAnchorAn

     o' <- markAnnOpen'' o src "{-# WARNING"

     mb_cat' <- markAnnotated mb_cat

     os' <- markEpToken os

     ws' <- markAnnotated ws

     cs' <- markEpToken cs

     c' <- markEpToken c

   exact (L (EpAnn l (AnnPragma o c (os,cs) l1 l2 t m) css) (DeprecatedTxt src ws)) = do

     o' <- markAnnOpen'' o src "{-# DEPRECATED"

     c' <- markEpToken c

     return (L (EpAnn l (AnnPragma o' c' (os',cs') l1 l2 t m) css) (DeprecatedTxt src ws'))

   getAnnotationEntry _ = NoEntryVal

   setAnnotationAnchor a _ _ _ = a

       tkIn' <- markEpToken tkIn

       L l' (_,wc') <- markAnnotated (L l (source, wc))

 instance ExactPrint (SourceText, WarningCategory) where

   getAnnotationEntry _ = NoEntryVal

   getAnnotationEntry _ = NoEntryVal

   setAnnotationAnchor a _ _ _ = a

     mb_cat' <- markAnnotated mb_cat

     ns_spec' <- exactNsSpec ns_spec

     lns' <- markAnnotated lns

     o' <- markEpToken o

     ls' <- markAnnotated ls

     c' <- markEpToken c

   exact (Warning (ns_spec, (o,c)) lns (DeprecatedTxt src ls)) = do

     ns_spec' <- exactNsSpec ns_spec

     Haddock.Backends.Xhtml.Types

     Haddock.Backends.Xhtml.Utils

     Haddock.Backends.LaTeX

     Haddock.Backends.Hoogle

     Haddock.Backends.Hyperlinker

     Haddock.Backends.Hyperlinker.Parser