{-# LANGUAGE CPP             #-}
{-# LANGUAGE PatternSynonyms #-}

-- | Compat Core module that handles the GHC module hierarchy re-organization
-- by re-exporting everything we care about.
--
-- This module provides no other compat mechanisms, except for simple
-- backward-compatible pattern synonyms.
module Development.IDE.GHC.Compat.Core (
    -- * Session
    DynFlags,
    extensions,
    extensionFlags,
    targetPlatform,
    packageFlags,
    generalFlags,
    warningFlags,
    topDir,
    hiDir,
    tmpDir,
    importPaths,
    useColor,
    canUseColor,
    useUnicode,
    objectDir,
    flagsForCompletion,
    setImportPaths,
    outputFile,
    pluginModNames,
    refLevelHoleFits,
    maxRefHoleFits,
    maxValidHoleFits,
    setOutputFile,
    lookupType,
    needWiredInHomeIface,
    loadWiredInHomeIface,
    readIface,
    loadSysInterface,
    importDecl,
    CommandLineOption,
    sPgm_F,
    settings,
    gopt,
    gopt_set,
    gopt_unset,
    wopt,
    wopt_set,
    xFlags,
    xopt,
    xopt_unset,
    xopt_set,
    FlagSpec(..),
    WarningFlag(..),
    GeneralFlag(..),
    PackageFlag,
    PackageArg(..),
    ModRenaming(..),
    pattern ExposePackage,
    parseDynamicFlagsCmdLine,
    parseDynamicFilePragma,
#if !MIN_VERSION_ghc(9,3,0)
    WarnReason(..),
#endif
    wWarningFlags,
    updOptLevel,
    -- slightly unsafe
    setUnsafeGlobalDynFlags,
    -- * Linear Haskell
    scaledThing,
    -- * Interface Files
    IfaceExport,
    IfaceTyCon(..),
    ModIface,
    ModIface_(..),
    HscSource(..),
    WhereFrom(..),
    loadInterface,
#if !MIN_VERSION_ghc(9,3,0)
    SourceModified(..),
#endif
    loadModuleInterface,
    RecompileRequired(..),
    mkPartialIface,
    mkFullIface,
    IsBootInterface(..),
    -- * Fixity
    LexicalFixity(..),
    Fixity (..),
    mi_fix,
    defaultFixity,
    lookupFixityRn,
    -- * ModSummary
    ModSummary(..),
    -- * HomeModInfo
    HomeModInfo(..),
    -- * ModGuts
    ModGuts(..),
    CgGuts(..),
    -- * ModDetails
    ModDetails(..),
    -- * HsExpr,
    -- * Var
    Type (
      TyCoRep.TyVarTy,
      TyCoRep.AppTy,
      TyCoRep.TyConApp,
      TyCoRep.ForAllTy,
      -- Omitted on purpose
      -- pattern Synonym right below it
      -- TyCoRep.FunTy,
      TyCoRep.LitTy,
      TyCoRep.CastTy,
      TyCoRep.CoercionTy
      ),
    pattern FunTy,
    pattern ConPatIn,
    conPatDetails,
    mapConPatDetail,
    -- * Specs
    ImpDeclSpec(..),
    ImportSpec(..),
    -- * SourceText
    SourceText(..),
    -- * Ways
    Way,
    wayGeneralFlags,
    wayUnsetGeneralFlags,
    -- * AvailInfo
    Avail.AvailInfo,
    pattern AvailName,
    pattern AvailFL,
    pattern AvailTC,
    Avail.availName,
    Avail.availNames,
#if !MIN_VERSION_ghc(9,7,0)
    Avail.availNamesWithSelectors,
#endif
    Avail.availsToNameSet,
    -- * TcGblEnv
    TcGblEnv(..),
    -- * Parsing and LExer types
    HsModule(..),
    GHC.ParsedSource,
    GHC.RenamedSource,
    -- * Compilation Main
    HscEnv,
    GHC.runGhc,
    unGhc,
    Session(..),
    modifySession,
    getSession,
    GHC.setSessionDynFlags,
    getSessionDynFlags,
    GhcMonad,
    Ghc,
    runHsc,
    compileFile,
    Phase(..),
    hscDesugar,
    hscGenHardCode,
    hscInteractive,
    hscSimplify,
    hscTypecheckRename,
    hscUpdateHPT,
    Development.IDE.GHC.Compat.Core.makeSimpleDetails,
    -- * Typecheck utils
    tcSplitForAllTyVars,
    tcSplitForAllTyVarBinder_maybe,
    typecheckIface,
    Development.IDE.GHC.Compat.Core.mkIfaceTc,
    Development.IDE.GHC.Compat.Core.mkBootModDetailsTc,
    Development.IDE.GHC.Compat.Core.initTidyOpts,
    driverNoStop,
    tidyProgram,
    ImportedModsVal(..),
    importedByUser,
    GHC.TypecheckedSource,
    -- * Source Locations
    HasSrcSpan,
    SrcLoc.Located,
    SrcLoc.unLoc,
    getLoc,
    GHC.getLocA,
    GHC.locA,
    GHC.noLocA,
    unLocA,
    LocatedAn,
    GHC.LocatedA,
    GHC.AnnListItem(..),
    GHC.NameAnn(..),
    SrcLoc.RealLocated,
    SrcLoc.GenLocated(..),
    SrcLoc.SrcSpan(SrcLoc.UnhelpfulSpan),
    SrcLoc.RealSrcSpan,
    pattern RealSrcSpan,
    SrcLoc.RealSrcLoc,
    pattern RealSrcLoc,
    SrcLoc.SrcLoc(SrcLoc.UnhelpfulLoc),
    BufSpan,
#if !MIN_VERSION_ghc(9,9,0)
    GHC.SrcAnn,
#endif
    SrcLoc.leftmost_smallest,
    SrcLoc.containsSpan,
    SrcLoc.mkGeneralSrcSpan,
    SrcLoc.mkRealSrcSpan,
    SrcLoc.mkRealSrcLoc,
    SrcLoc.getRealSrcSpan,
    SrcLoc.realSrcLocSpan,
    SrcLoc.realSrcSpanStart,
    SrcLoc.realSrcSpanEnd,
    isSubspanOfA,
    SrcLoc.isSubspanOf,
    SrcLoc.wiredInSrcSpan,
    SrcLoc.mkSrcSpan,
    SrcLoc.srcSpanStart,
    SrcLoc.srcSpanStartLine,
    SrcLoc.srcSpanStartCol,
    SrcLoc.srcSpanEnd,
    SrcLoc.srcSpanEndLine,
    SrcLoc.srcSpanEndCol,
    SrcLoc.srcSpanFile,
    SrcLoc.srcLocCol,
    SrcLoc.srcLocFile,
    SrcLoc.srcLocLine,
    SrcLoc.noSrcSpan,
    SrcLoc.noSrcLoc,
    SrcLoc.noLoc,
    mapLoc,
    -- * Finder
    FindResult(..),
    mkHomeModLocation,
    findObjectLinkableMaybe,
    InstalledFindResult(..),
    -- * Module and Package
    ModuleOrigin(..),
    PackageName(..),
    -- * Linker
    Unlinked(..),
    Linkable(..),
    unload,
    -- * Hooks
    Hooks,
    runMetaHook,
    MetaHook,
    MetaRequest(..),
    metaRequestE,
    metaRequestP,
    metaRequestT,
    metaRequestD,
    metaRequestAW,
    -- * HPT
    addToHpt,
    addListToHpt,
    -- * Driver-Make
    Target(..),
    TargetId(..),
    mkSimpleTarget,
    -- * GHCi
    initObjLinker,
    loadDLL,
    InteractiveImport(..),
    GHC.getContext,
    GHC.setContext,
    GHC.parseImportDecl,
    GHC.runDecls,
    Warn(..),
    -- * ModLocation
    GHC.ModLocation,
    Module.ml_hs_file,
    Module.ml_obj_file,
    Module.ml_hi_file,
    Module.ml_hie_file,
    -- * DataCon
    DataCon.dataConExTyCoVars,
    -- * Role
    Role(..),
    -- * Panic
    Plain.PlainGhcException,
    -- * Other
    GHC.CoreModule(..),
    GHC.SafeHaskellMode(..),
    pattern GRE,
    gre_name,
    gre_imp,
    gre_lcl,
    gre_par,
    collectHsBindsBinders,
    -- * Util Module re-exports
    module GHC.Builtin.Names,
    module GHC.Builtin.Types,
    module GHC.Builtin.Types.Prim,
    module GHC.Builtin.Utils,
    module GHC.Core.Class,
    module GHC.Core.Coercion,
    module GHC.Core.ConLike,
    module GHC.Core.DataCon,
    module GHC.Core.FamInstEnv,
    module GHC.Core.InstEnv,
    module GHC.Types.Unique.FM,
    module GHC.Core.PatSyn,
    module GHC.Core.Predicate,
    module GHC.Core.TyCon,
    module GHC.Core.TyCo.Ppr,
    module GHC.Core.Type,
    module GHC.Core.Unify,
    module GHC.Core.Utils,

    module GHC.HsToCore.Docs,
    module GHC.HsToCore.Expr,
    module GHC.HsToCore.Monad,

    module GHC.Iface.Syntax,
    module GHC.Iface.Recomp,

    module GHC.Hs.Decls,
    module GHC.Hs.Expr,
    module GHC.Hs.Doc,
    module GHC.Hs.Extension,
    module GHC.Hs.ImpExp,
    module GHC.Hs.Pat,
    module GHC.Hs.Type,
    module GHC.Hs.Utils,
    module Language.Haskell.Syntax,

    module GHC.Rename.Names,
    module GHC.Rename.Splice,

    module GHC.Tc.Instance.Family,
    module GHC.Tc.Module,
    module GHC.Tc.Types,
    module GHC.Tc.Types.Evidence,
    module GHC.Tc.Utils.Env,
    module GHC.Tc.Utils.Monad,

    module GHC.Types.Basic,
    module GHC.Types.Id,
    module GHC.Types.Name,
    module GHC.Types.Name.Set,
    module GHC.Types.Name.Cache,
    module GHC.Types.Name.Env,
    module GHC.Types.Name.Reader,
    module GHC.Utils.Error,
#if !MIN_VERSION_ghc(9,7,0)
    module GHC.Types.Avail,
#endif
    module GHC.Types.SourceFile,
    module GHC.Types.SourceText,
    module GHC.Types.TyThing,
    module GHC.Types.TyThing.Ppr,
    module GHC.Types.Unique.Supply,
    module GHC.Types.Var,
    module GHC.Unit.Module,
    module GHC.Unit.Module.Graph,
    -- * Syntax re-exports
    module GHC.Hs,
    module GHC.Hs.Binds,
    module GHC.Parser,
    module GHC.Parser.Header,
    module GHC.Parser.Lexer,
    module GHC.Utils.Panic,
#if MIN_VERSION_ghc(9,3,0)
    CompileReason(..),
    hsc_type_env_vars,
    hscUpdateHUG, hsc_HUG,
    GhcMessage(..),
    getKey,
    module GHC.Driver.Env.KnotVars,
    module GHC.Linker.Types,
    module GHC.Types.Unique.Map,
    module GHC.Utils.TmpFs,
    module GHC.Unit.Finder.Types,
    module GHC.Unit.Env,
    module GHC.Driver.Phases,
#endif
#if !MIN_VERSION_ghc(9,4,0)
    pattern HsFieldBind,
    hfbAnn,
    hfbLHS,
    hfbRHS,
    hfbPun,
#endif
#if !MIN_VERSION_ghc_boot_th(9,4,1)
    Extension(.., NamedFieldPuns),
#else
    Extension(..),
#endif
    mkCgInteractiveGuts,
    justBytecode,
    justObjects,
    emptyHomeModInfoLinkable,
    homeModInfoByteCode,
    homeModInfoObject,
#if !MIN_VERSION_ghc(9,5,0)
    field_label,
#endif
    groupOrigin,
    isVisibleFunArg,
#if MIN_VERSION_ghc(9,8,0)
    lookupGlobalRdrEnv
#endif
    ) where

import qualified GHC

-- NOTE(ozkutuk): Cpp clashes Phase.Cpp, so we hide it.
-- Not the greatest solution, but gets the job done
-- (until the CPP extension is actually needed).
import           GHC.LanguageExtensions.Type hiding (Cpp)

import           GHC.Builtin.Names           hiding (Unique, printName)
import           GHC.Builtin.Types
import           GHC.Builtin.Types.Prim
import           GHC.Builtin.Utils
import           GHC.Core                    (CoreProgram)
import           GHC.Core.Class
import           GHC.Core.Coercion
import           GHC.Core.ConLike
import           GHC.Core.DataCon            hiding (dataConExTyCoVars)
import qualified GHC.Core.DataCon            as DataCon
import           GHC.Core.FamInstEnv         hiding (pprFamInst)
import           GHC.Core.InstEnv
import           GHC.Core.PatSyn
import           GHC.Core.Predicate
import           GHC.Core.TyCo.Ppr
import qualified GHC.Core.TyCo.Rep           as TyCoRep
import           GHC.Core.TyCon
import           GHC.Core.Type
import           GHC.Core.Unify
import           GHC.Core.Utils
import           GHC.Driver.CmdLine          (Warn (..))
import           GHC.Driver.Hooks
import           GHC.Driver.Main             as GHC
import           GHC.Driver.Monad
import           GHC.Driver.Phases
import           GHC.Driver.Pipeline
import           GHC.Driver.Plugins
import           GHC.Driver.Session          hiding (ExposePackage)
import qualified GHC.Driver.Session          as DynFlags
import           GHC.Hs.Binds
import           GHC.HsToCore.Docs
import           GHC.HsToCore.Expr
import           GHC.HsToCore.Monad
import           GHC.Iface.Load
import           GHC.Iface.Make              as GHC
import           GHC.Iface.Recomp
import           GHC.Iface.Syntax
import           GHC.Iface.Tidy              as GHC
import           GHC.IfaceToCore
import           GHC.Parser
import           GHC.Parser.Header           hiding (getImports)
import           GHC.Rename.Fixity           (lookupFixityRn)
import           GHC.Rename.Names
import           GHC.Rename.Splice
import qualified GHC.Runtime.Interpreter     as GHCi
import           GHC.Tc.Instance.Family
import           GHC.Tc.Module
import           GHC.Tc.Types
import           GHC.Tc.Types.Evidence       hiding ((<.>))
import           GHC.Tc.Utils.Env
import           GHC.Tc.Utils.Monad          hiding (Applicative (..), IORef,
                                              MonadFix (..), MonadIO (..), allM,
                                              anyM, concatMapM, mapMaybeM,
                                              (<$>))
import           GHC.Tc.Utils.TcType         as TcType
import qualified GHC.Types.Avail             as Avail
import           GHC.Types.Basic
import           GHC.Types.Id
import           GHC.Types.Name              hiding (varName)
import           GHC.Types.Name.Cache
import           GHC.Types.Name.Env
import           GHC.Types.Name.Reader       hiding (GRE, gre_imp, gre_lcl,
                                              gre_name, gre_par)
import qualified GHC.Types.Name.Reader       as RdrName
import           GHC.Types.SrcLoc            (BufPos, BufSpan,
                                              SrcLoc (UnhelpfulLoc),
                                              SrcSpan (UnhelpfulSpan))
import qualified GHC.Types.SrcLoc            as SrcLoc
import           GHC.Types.Unique.FM
import           GHC.Types.Unique.Supply
import           GHC.Types.Var               (Var (varName), setTyVarUnique,
                                              setVarUnique)

import qualified GHC.Types.Var               as TypesVar
import           GHC.Unit.Info               (PackageName (..))
import           GHC.Unit.Module             hiding (ModLocation (..), UnitId,
                                              moduleUnit, toUnitId)
import qualified GHC.Unit.Module             as Module
import           GHC.Unit.State              (ModuleOrigin (..))
import           GHC.Utils.Error             (Severity (..), emptyMessages)
import           GHC.Utils.Panic             hiding (try)
import qualified GHC.Utils.Panic.Plain       as Plain


import           Data.Foldable               (toList)
import           GHC.Core.Multiplicity       (scaledThing)
import           GHC.Data.Bag
import           GHC.Driver.Env
import           GHC.Hs                       (HsModule (..))
#if !MIN_VERSION_ghc(9,9,0)
import           GHC.Hs                       (SrcSpanAnn')
#endif
import           GHC.Hs.Decls                 hiding (FunDep)
import           GHC.Hs.Doc
import           GHC.Hs.Expr
import           GHC.Hs.Extension
import           GHC.Hs.ImpExp
import           GHC.Hs.Pat
import           GHC.Hs.Type
import           GHC.Hs.Utils                hiding (collectHsBindsBinders)
import qualified GHC.Linker.Loader           as Linker
import           GHC.Linker.Types
import           GHC.Parser.Annotation       (EpAnn (..))
import           GHC.Parser.Lexer            hiding (getPsMessages,
                                              initParserState)
import           GHC.Platform.Ways
import           GHC.Runtime.Context         (InteractiveImport (..))
import           GHC.Types.Fixity            (Fixity (..), LexicalFixity (..),
                                              defaultFixity)
import           GHC.Types.Meta
import           GHC.Types.Name.Set
import           GHC.Types.SourceFile        (HscSource (..))
import           GHC.Types.SourceText
import           GHC.Types.Target            (Target (..), TargetId (..))
import           GHC.Types.TyThing
import           GHC.Types.TyThing.Ppr
import           GHC.Unit.Finder             hiding (mkHomeModLocation)
import           GHC.Unit.Home.ModInfo
import           GHC.Unit.Module.Imported
import           GHC.Unit.Module.ModDetails
import           GHC.Unit.Module.ModGuts
import           GHC.Unit.Module.ModIface    (IfaceExport, ModIface,
                                              ModIface_ (..), mi_fix)
import           GHC.Unit.Module.ModSummary  (ModSummary (..))
import           Language.Haskell.Syntax     hiding (FunDep)

-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]

#if !MIN_VERSION_ghc(9,3,0)
import           GHC.Types.SourceFile        (SourceModified (..))
import qualified GHC.Unit.Finder             as GHC
import           GHC.Unit.Module.Graph       (mkModuleGraph)
#endif

#if MIN_VERSION_ghc(9,3,0)
import qualified GHC.Data.Strict             as Strict
import qualified GHC.Driver.Config.Finder    as GHC
import qualified GHC.Driver.Config.Tidy      as GHC
import           GHC.Driver.Env              as GHCi
import           GHC.Driver.Env.KnotVars
import           GHC.Driver.Errors.Types
import           GHC.Types.Unique
import           GHC.Types.Unique.Map
import           GHC.Unit.Env
import qualified GHC.Unit.Finder             as GHC
import           GHC.Unit.Finder.Types
import           GHC.Unit.Module.Graph
import           GHC.Utils.Error             (mkPlainErrorMsgEnvelope)
import           GHC.Utils.Panic
import           GHC.Utils.TmpFs
#endif

#if !MIN_VERSION_ghc(9,7,0)
import           GHC.Types.Avail             (greNamePrintableName)
#endif

mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO Module.ModLocation
#if MIN_VERSION_ghc(9,3,0)
mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO ModLocation
mkHomeModLocation DynFlags
df ModuleName
mn FilePath
f = ModLocation -> IO ModLocation
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModLocation -> IO ModLocation) -> ModLocation -> IO ModLocation
forall a b. (a -> b) -> a -> b
$ FinderOpts -> ModuleName -> FilePath -> ModLocation
GHC.mkHomeModLocation (DynFlags -> FinderOpts
GHC.initFinderOpts DynFlags
df) ModuleName
mn FilePath
f
#else
mkHomeModLocation = GHC.mkHomeModLocation
#endif

#if MIN_VERSION_ghc(9,3,0)
pattern RealSrcSpan :: SrcLoc.RealSrcSpan -> Maybe BufSpan -> SrcLoc.SrcSpan
#else
pattern RealSrcSpan :: SrcLoc.RealSrcSpan -> Maybe BufSpan -> SrcLoc.SrcSpan
#endif

#if MIN_VERSION_ghc(9,3,0)
pattern $mRealSrcSpan :: forall {r}.
SrcSpan -> (RealSrcSpan -> Maybe BufSpan -> r) -> ((# #) -> r) -> r
$bRealSrcSpan :: RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan x y <- SrcLoc.RealSrcSpan x ((\case Maybe BufSpan
Strict.Nothing -> Maybe BufSpan
forall a. Maybe a
Nothing; Strict.Just BufSpan
a -> BufSpan -> Maybe BufSpan
forall a. a -> Maybe a
Just BufSpan
a) -> y) where
  RealSrcSpan RealSrcSpan
x Maybe BufSpan
y = RealSrcSpan -> Maybe BufSpan -> SrcSpan
SrcLoc.RealSrcSpan RealSrcSpan
x (case Maybe BufSpan
y of Maybe BufSpan
Nothing -> Maybe BufSpan
forall a. Maybe a
Strict.Nothing; Just BufSpan
a -> BufSpan -> Maybe BufSpan
forall a. a -> Maybe a
Strict.Just BufSpan
a)

#else
pattern RealSrcSpan x y = SrcLoc.RealSrcSpan x y
#endif
{-# COMPLETE RealSrcSpan, UnhelpfulSpan #-}

#if MIN_VERSION_ghc(9,3,0)
pattern RealSrcLoc :: SrcLoc.RealSrcLoc -> Strict.Maybe BufPos-> SrcLoc.SrcLoc
#else
pattern RealSrcLoc :: SrcLoc.RealSrcLoc -> Maybe BufPos-> SrcLoc.SrcLoc
#endif
pattern $mRealSrcLoc :: forall {r}.
SrcLoc -> (RealSrcLoc -> Maybe BufPos -> r) -> ((# #) -> r) -> r
$bRealSrcLoc :: RealSrcLoc -> Maybe BufPos -> SrcLoc
RealSrcLoc x y = SrcLoc.RealSrcLoc x y
{-# COMPLETE RealSrcLoc, UnhelpfulLoc #-}


pattern AvailTC :: Name -> [Name] -> [FieldLabel] -> Avail.AvailInfo
#if __GLASGOW_HASKELL__ >= 907
pattern AvailTC n names pieces <- Avail.AvailTC n ((,[]) -> (names,pieces))
#else
pattern $mAvailTC :: forall {r}.
AvailInfo
-> (Name -> [Name] -> [FieldLabel] -> r) -> ((# #) -> r) -> r
AvailTC n names pieces <- Avail.AvailTC n ((\[GreName]
gres -> (GreName -> ([Name], [FieldLabel]) -> ([Name], [FieldLabel]))
-> ([Name], [FieldLabel]) -> [GreName] -> ([Name], [FieldLabel])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\GreName
gre ([Name]
names, [FieldLabel]
pieces) -> case GreName
gre of
      Avail.NormalGreName Name
name -> (Name
nameName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Name]
names, [FieldLabel]
pieces)
      Avail.FieldGreName FieldLabel
label -> ([Name]
names, FieldLabel
labelFieldLabel -> [FieldLabel] -> [FieldLabel]
forall a. a -> [a] -> [a]
:[FieldLabel]
pieces)) ([], []) [GreName]
gres) -> (names, pieces))
#endif

pattern AvailName :: Name -> Avail.AvailInfo
#if __GLASGOW_HASKELL__ >= 907
pattern AvailName n <- Avail.Avail n
#else
pattern $mAvailName :: forall {r}. AvailInfo -> (Name -> r) -> ((# #) -> r) -> r
AvailName n <- Avail.Avail (Avail.NormalGreName n)
#endif

pattern AvailFL :: FieldLabel -> Avail.AvailInfo
#if __GLASGOW_HASKELL__ >= 907
pattern AvailFL fl <- (const Nothing -> Just fl) -- this pattern always fails as this field was removed in 9.7
#else
pattern $mAvailFL :: forall {r}. AvailInfo -> (FieldLabel -> r) -> ((# #) -> r) -> r
AvailFL fl <- Avail.Avail (Avail.FieldGreName fl)
#endif

{-# COMPLETE AvailTC, AvailName, AvailFL #-}

setImportPaths :: [FilePath] -> DynFlags -> DynFlags
setImportPaths :: [FilePath] -> DynFlags -> DynFlags
setImportPaths [FilePath]
importPaths DynFlags
flags = DynFlags
flags { importPaths = importPaths }

pattern ExposePackage :: String -> PackageArg -> ModRenaming -> PackageFlag
-- https://github.com/facebook/fbghc
#ifdef __FACEBOOK_HASKELL__
pattern ExposePackage s a mr <- DynFlags.ExposePackage s a _ mr
#else
pattern $mExposePackage :: forall {r}.
PackageFlag
-> (FilePath -> PackageArg -> ModRenaming -> r)
-> ((# #) -> r)
-> r
$bExposePackage :: FilePath -> PackageArg -> ModRenaming -> PackageFlag
ExposePackage s a mr = DynFlags.ExposePackage s a mr
#endif

isVisibleFunArg :: Development.IDE.GHC.Compat.Core.FunTyFlag -> Bool
#if __GLASGOW_HASKELL__ >= 906
isVisibleFunArg :: FunTyFlag -> Bool
isVisibleFunArg = FunTyFlag -> Bool
TypesVar.isVisibleFunArg
type FunTyFlag = TypesVar.FunTyFlag
#else
isVisibleFunArg VisArg = True
isVisibleFunArg _ = False
type FunTyFlag = TypesVar.AnonArgFlag
#endif
pattern FunTy :: Development.IDE.GHC.Compat.Core.FunTyFlag -> Type -> Type -> Type
pattern $mFunTy :: forall {r}.
Type -> (FunTyFlag -> Type -> Type -> r) -> ((# #) -> r) -> r
FunTy af arg res <- TyCoRep.FunTy {ft_af = af, ft_arg = arg, ft_res = res}


-- type HasSrcSpan x a = (GenLocated SrcSpan a ~ x)
-- type HasSrcSpan x = () :: Constraint

class HasSrcSpan a where
  getLoc :: a -> SrcSpan

instance HasSrcSpan SrcSpan where
  getLoc :: SrcSpan -> SrcSpan
getLoc = SrcSpan -> SrcSpan
forall a. a -> a
id

instance HasSrcSpan (SrcLoc.GenLocated SrcSpan a) where
  getLoc :: GenLocated SrcSpan a -> SrcSpan
getLoc = GenLocated SrcSpan a -> SrcSpan
forall l e. GenLocated l e -> l
GHC.getLoc

#if MIN_VERSION_ghc(9,9,0)
instance HasSrcSpan (EpAnn a) where
  getLoc = GHC.getHasLoc
#endif

#if MIN_VERSION_ghc(9,9,0)
instance HasSrcSpan (SrcLoc.GenLocated (EpAnn ann) a) where
  getLoc (L l _) = getLoc l
#else
instance HasSrcSpan (SrcSpanAnn' ann) where
  getLoc :: SrcSpanAnn' ann -> SrcSpan
getLoc = SrcSpanAnn' ann -> SrcSpan
forall ann. SrcSpanAnn' ann -> SrcSpan
GHC.locA
instance HasSrcSpan (SrcLoc.GenLocated (SrcSpanAnn' ann) a) where
  getLoc :: GenLocated (SrcSpanAnn' ann) a -> SrcSpan
getLoc (L SrcSpan
l a
_) = SrcSpan
l
#endif

pattern L :: HasSrcSpan a => SrcSpan -> e -> SrcLoc.GenLocated a e
pattern $mL :: forall {r} {a} {e}.
HasSrcSpan a =>
GenLocated a e -> (SrcSpan -> e -> r) -> ((# #) -> r) -> r
L l a <- GHC.L (getLoc -> l) a
{-# COMPLETE L #-}

-- This is from the old api, but it still simplifies
pattern ConPatIn :: SrcLoc.Located (ConLikeP GhcPs) -> HsConPatDetails GhcPs -> Pat GhcPs
#if MIN_VERSION_ghc(9,9,0)
pattern ConPatIn con args <- ConPat _ (L _ (SrcLoc.noLoc -> con)) args
  where
    ConPatIn con args = ConPat GHC.noAnn (GHC.noLocA $ SrcLoc.unLoc con) args
#else
pattern $mConPatIn :: forall {r}.
Pat GhcPs
-> (Located (ConLikeP GhcPs) -> HsConPatDetails GhcPs -> r)
-> ((# #) -> r)
-> r
$bConPatIn :: Located (ConLikeP GhcPs) -> HsConPatDetails GhcPs -> Pat GhcPs
ConPatIn con args <- ConPat EpAnnNotUsed (L _ (SrcLoc.noLoc -> con)) args
  where
    ConPatIn Located (ConLikeP GhcPs)
con HsConPatDetails GhcPs
args = XConPat GhcPs
-> XRec GhcPs (ConLikeP GhcPs)
-> HsConPatDetails GhcPs
-> Pat GhcPs
forall p.
XConPat p -> XRec p (ConLikeP p) -> HsConPatDetails p -> Pat p
ConPat XConPat GhcPs
EpAnn [AddEpAnn]
forall ann. EpAnn ann
EpAnnNotUsed (RdrName -> GenLocated SrcSpanAnnN RdrName
forall a an. a -> LocatedAn an a
GHC.noLocA (RdrName -> GenLocated SrcSpanAnnN RdrName)
-> RdrName -> GenLocated SrcSpanAnnN RdrName
forall a b. (a -> b) -> a -> b
$ Located RdrName -> RdrName
forall l e. GenLocated l e -> e
SrcLoc.unLoc Located RdrName
Located (ConLikeP GhcPs)
con) HsConPatDetails GhcPs
args
#endif

conPatDetails :: Pat p -> Maybe (HsConPatDetails p)
conPatDetails :: forall p. Pat p -> Maybe (HsConPatDetails p)
conPatDetails (ConPat XConPat p
_ XRec p (ConLikeP p)
_ HsConPatDetails p
args) = HsConPatDetails p -> Maybe (HsConPatDetails p)
forall a. a -> Maybe a
Just HsConPatDetails p
args
conPatDetails Pat p
_ = Maybe (HsConPatDetails p)
forall a. Maybe a
Nothing

mapConPatDetail :: (HsConPatDetails p -> Maybe (HsConPatDetails p)) -> Pat p -> Maybe (Pat p)
mapConPatDetail :: forall p.
(HsConPatDetails p -> Maybe (HsConPatDetails p))
-> Pat p -> Maybe (Pat p)
mapConPatDetail HsConPatDetails p -> Maybe (HsConPatDetails p)
f pat :: Pat p
pat@(ConPat XConPat p
_ XRec p (ConLikeP p)
_ HsConPatDetails p
args) = (\HsConPatDetails p
args' -> Pat p
pat { pat_args = args'}) (HsConPatDetails p -> Pat p)
-> Maybe (HsConPatDetails p) -> Maybe (Pat p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsConPatDetails p -> Maybe (HsConPatDetails p)
f HsConPatDetails p
args
mapConPatDetail HsConPatDetails p -> Maybe (HsConPatDetails p)
_ Pat p
_ = Maybe (Pat p)
forall a. Maybe a
Nothing


initObjLinker :: HscEnv -> IO ()
initObjLinker :: HscEnv -> IO ()
initObjLinker HscEnv
env =
    Interp -> IO ()
GHCi.initObjLinker (HscEnv -> Interp
GHCi.hscInterp HscEnv
env)

loadDLL :: HscEnv -> String -> IO (Maybe String)
loadDLL :: HscEnv -> FilePath -> IO (Maybe FilePath)
loadDLL HscEnv
env FilePath
str = do
    Maybe FilePath
res <- Interp -> FilePath -> IO (Maybe FilePath)
GHCi.loadDLL (HscEnv -> Interp
GHCi.hscInterp HscEnv
env) FilePath
str
#if MIN_VERSION_ghc(9,11,0)
    pure $
      case res of
        Left err_msg -> Just err_msg
        Right _      -> Nothing
#else
    Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
res
#endif

unload :: HscEnv -> [Linkable] -> IO ()
unload :: HscEnv -> [Linkable] -> IO ()
unload HscEnv
hsc_env [Linkable]
linkables =
  Interp -> HscEnv -> [Linkable] -> IO ()
Linker.unload
    (HscEnv -> Interp
GHCi.hscInterp HscEnv
hsc_env)
    HscEnv
hsc_env [Linkable]
linkables

#if !MIN_VERSION_ghc(9,3,0)
setOutputFile :: FilePath -> DynFlags -> DynFlags
setOutputFile f d = d {
  outputFile_    = Just f
  }
#endif

isSubspanOfA :: LocatedAn la a -> LocatedAn lb b -> Bool
isSubspanOfA :: forall la a lb b. LocatedAn la a -> LocatedAn lb b -> Bool
isSubspanOfA LocatedAn la a
a LocatedAn lb b
b = SrcSpan -> SrcSpan -> Bool
SrcLoc.isSubspanOf (LocatedAn la a -> SrcSpan
forall ann a. GenLocated (SrcSpanAnn' ann) a -> SrcSpan
GHC.getLocA LocatedAn la a
a) (LocatedAn lb b -> SrcSpan
forall ann a. GenLocated (SrcSpanAnn' ann) a -> SrcSpan
GHC.getLocA LocatedAn lb b
b)

type LocatedAn a = GHC.LocatedAn a

unLocA :: forall pass a. XRec (GhcPass pass) a -> a
unLocA :: forall (pass :: Pass) a. XRec (GhcPass pass) a -> a
unLocA = forall p a. UnXRec p => XRec p a -> a
unXRec @(GhcPass pass)


pattern GRE :: Name -> Parent -> Bool -> [ImportSpec] -> RdrName.GlobalRdrElt
{-# COMPLETE GRE #-}
pattern $mGRE :: forall {r}.
GlobalRdrElt
-> (Name -> Parent -> Bool -> [ImportSpec] -> r)
-> ((# #) -> r)
-> r
GRE{GlobalRdrElt -> Name
gre_name, GlobalRdrElt -> Parent
gre_par, GlobalRdrElt -> Bool
gre_lcl, GlobalRdrElt -> [ImportSpec]
gre_imp} <- RdrName.GRE
#if MIN_VERSION_ghc(9,7,0)
    {gre_name = gre_name
#else
    {gre_name = (greNamePrintableName -> gre_name)
#endif
    ,gre_par, gre_lcl, gre_imp = (toList -> gre_imp)}

collectHsBindsBinders :: CollectPass p => Bag (XRec p (HsBindLR p idR)) -> [IdP p]
collectHsBindsBinders :: forall p idR.
CollectPass p =>
Bag (XRec p (HsBindLR p idR)) -> [IdP p]
collectHsBindsBinders Bag (XRec p (HsBindLR p idR))
x = CollectFlag p -> Bag (XRec p (HsBindLR p idR)) -> [IdP p]
forall p idR.
CollectPass p =>
CollectFlag p -> LHsBindsLR p idR -> [IdP p]
GHC.collectHsBindsBinders CollectFlag p
forall p. CollectFlag p
CollNoDictBinders Bag (XRec p (HsBindLR p idR))
x



makeSimpleDetails :: HscEnv -> TcGblEnv -> IO ModDetails
makeSimpleDetails :: HscEnv -> TcGblEnv -> IO ModDetails
makeSimpleDetails HscEnv
hsc_env =
  Logger -> TcGblEnv -> IO ModDetails
GHC.makeSimpleDetails
#if MIN_VERSION_ghc(9,3,0)
              (HscEnv -> Logger
hsc_logger HscEnv
hsc_env)
#else
              hsc_env
#endif

mkIfaceTc :: HscEnv -> GHC.SafeHaskellMode -> ModDetails -> ModSummary -> Maybe CoreProgram -> TcGblEnv -> IO ModIface
mkIfaceTc :: HscEnv
-> SafeHaskellMode
-> ModDetails
-> ModSummary
-> Maybe CoreProgram
-> TcGblEnv
-> IO ModIface
mkIfaceTc HscEnv
hscEnv SafeHaskellMode
shm ModDetails
md ModSummary
_ms Maybe CoreProgram
_mcp =
#if MIN_VERSION_ghc(9,5,0)
  HscEnv
-> SafeHaskellMode
-> ModDetails
-> ModSummary
-> Maybe CoreProgram
-> TcGblEnv
-> IO ModIface
GHC.mkIfaceTc HscEnv
hscEnv SafeHaskellMode
shm ModDetails
md ModSummary
_ms Maybe CoreProgram
_mcp -- mcp::Maybe CoreProgram is only used in GHC >= 9.6
#elif MIN_VERSION_ghc(9,3,0)
  GHC.mkIfaceTc hscEnv shm md _ms -- ms::ModSummary is only used in GHC >= 9.4
#else
  GHC.mkIfaceTc hscEnv shm md
#endif

mkBootModDetailsTc :: HscEnv -> TcGblEnv -> IO ModDetails
mkBootModDetailsTc :: HscEnv -> TcGblEnv -> IO ModDetails
mkBootModDetailsTc HscEnv
session = Logger -> TcGblEnv -> IO ModDetails
GHC.mkBootModDetailsTc
#if MIN_VERSION_ghc(9,3,0)
          (HscEnv -> Logger
hsc_logger HscEnv
session)
#else
          session
#endif

#if !MIN_VERSION_ghc(9,3,0)
type TidyOpts = HscEnv
#endif

initTidyOpts :: HscEnv -> IO TidyOpts
initTidyOpts :: HscEnv -> IO TidyOpts
initTidyOpts =
#if MIN_VERSION_ghc(9,3,0)
  HscEnv -> IO TidyOpts
GHC.initTidyOpts
#else
  pure
#endif

#if MIN_VERSION_ghc(9,3,0)
driverNoStop :: StopPhase
driverNoStop :: StopPhase
driverNoStop = StopPhase
NoStop
#else
driverNoStop :: Phase
driverNoStop = StopLn
#endif

#if !MIN_VERSION_ghc(9,3,0)
hscUpdateHPT :: (HomePackageTable -> HomePackageTable) -> HscEnv -> HscEnv
hscUpdateHPT k session = session { hsc_HPT = k (hsc_HPT session) }
#endif

#if !MIN_VERSION_ghc(9,4,0)
pattern HsFieldBind :: XHsRecField id -> id -> arg -> Bool -> HsRecField' id arg
pattern HsFieldBind {hfbAnn, hfbLHS, hfbRHS, hfbPun} <- HsRecField hfbAnn (SrcLoc.unLoc -> hfbLHS) hfbRHS hfbPun where
  HsFieldBind ann lhs rhs pun = HsRecField ann (SrcLoc.noLoc lhs) rhs pun
#endif

#if !MIN_VERSION_ghc_boot_th(9,4,1)
pattern NamedFieldPuns :: Extension
pattern NamedFieldPuns = RecordPuns
#endif

groupOrigin :: MatchGroup GhcRn body -> Origin
#if MIN_VERSION_ghc(9,5,0)
mapLoc :: (a -> b) -> SrcLoc.GenLocated l a -> SrcLoc.GenLocated l b
mapLoc :: forall a b l. (a -> b) -> GenLocated l a -> GenLocated l b
mapLoc = (a -> b) -> GenLocated l a -> GenLocated l b
forall a b. (a -> b) -> GenLocated l a -> GenLocated l b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
groupOrigin :: forall body. MatchGroup GhcRn body -> Origin
groupOrigin = MatchGroup GhcRn body -> XMG GhcRn body
MatchGroup GhcRn body -> Origin
forall p body. MatchGroup p body -> XMG p body
mg_ext
#else
mapLoc :: (a -> b) -> SrcLoc.GenLocated l a -> SrcLoc.GenLocated l b
mapLoc = SrcLoc.mapLoc
groupOrigin = mg_origin
#endif


#if !MIN_VERSION_ghc(9,5,0)
mkCgInteractiveGuts :: CgGuts -> CgGuts
mkCgInteractiveGuts = id

emptyHomeModInfoLinkable :: Maybe Linkable
emptyHomeModInfoLinkable = Nothing

justBytecode :: Linkable -> Maybe Linkable
justBytecode = Just

justObjects :: Linkable -> Maybe Linkable
justObjects = Just

homeModInfoByteCode, homeModInfoObject :: HomeModInfo -> Maybe Linkable
homeModInfoByteCode = hm_linkable
homeModInfoObject = hm_linkable

field_label :: a -> a
field_label = id
#endif

mkSimpleTarget :: DynFlags -> FilePath -> Target
#if MIN_VERSION_ghc(9,3,0)
mkSimpleTarget :: DynFlags -> FilePath -> Target
mkSimpleTarget DynFlags
df FilePath
fp = TargetId
-> Bool -> UnitId -> Maybe (InputFileBuffer, UTCTime) -> Target
Target (FilePath -> Maybe Phase -> TargetId
TargetFile FilePath
fp Maybe Phase
forall a. Maybe a
Nothing) Bool
True (DynFlags -> UnitId
homeUnitId_ DynFlags
df) Maybe (InputFileBuffer, UTCTime)
forall a. Maybe a
Nothing
#else
mkSimpleTarget _ fp = Target (TargetFile fp Nothing) True Nothing
#endif

#if MIN_VERSION_ghc(9,7,0)
lookupGlobalRdrEnv gre_env occ = lookupGRE gre_env (LookupOccName occ AllRelevantGREs)
#endif