-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0

{-# LANGUAGE CPP               #-}
{-# LANGUAGE ConstraintKinds   #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PatternSynonyms   #-}
{-# OPTIONS -Wno-incomplete-uni-patterns -Wno-dodgy-imports #-}

-- | Attempt at hiding the GHC version differences we can.
module Development.IDE.GHC.Compat(
    NameCacheUpdater(..),
    hPutStringBuffer,
    addIncludePathsQuote,
    getModuleHash,
    setUpTypedHoles,
    upNameCache,
    disableWarningsAsErrors,
    reLoc,
    reLocA,
    getMessages',
    pattern PFailedWithErrorMessages,
    isObjectLinkable,

#if !MIN_VERSION_ghc(9,0,1)
    RefMap,
#endif

#if MIN_VERSION_ghc(9,2,0)
    extendModSummaryNoDeps,
    emsModSummary,
    myCoreToStgExpr,
#endif

    nodeInfo',
    getNodeIds,
    nodeInfoFromSource,
    isAnnotationInNodeInfo,
    mkAstNode,
    combineRealSrcSpans,

    isQualifiedImport,
    GhcVersion(..),
    ghcVersion,
    ghcVersionStr,
    -- * HIE Compat
    HieFileResult(..),
    HieFile(..),
    hieExportNames,
    mkHieFile',
    enrichHie,
    writeHieFile,
    readHieFile,
    supportsHieFiles,
    setHieDir,
    dontWriteHieFiles,
    module Compat.HieTypes,
    module Compat.HieUtils,
    -- * Compat modules
    module Development.IDE.GHC.Compat.Core,
    module Development.IDE.GHC.Compat.Env,
    module Development.IDE.GHC.Compat.ExactPrint,
    module Development.IDE.GHC.Compat.Iface,
    module Development.IDE.GHC.Compat.Logger,
    module Development.IDE.GHC.Compat.Outputable,
    module Development.IDE.GHC.Compat.Parser,
    module Development.IDE.GHC.Compat.Plugins,
    module Development.IDE.GHC.Compat.Units,
    -- * Extras that rely on compat modules
    -- * SysTools
    Option (..),
    runUnlit,
    runPp,

    -- * Recompilation avoidance
    hscCompileCoreExprHook,
    CoreExpr,
    simplifyExpr,
    tidyExpr,
    emptyTidyEnv,
    corePrepExpr,
    lintInteractiveExpr,
    icInteractiveModule,
    HomePackageTable,
    lookupHpt,
    Dependencies(dep_mods),
    bcoFreeNames,
    ModIfaceAnnotation,
    pattern Annotation,
    AnnTarget(ModuleTarget),
    extendAnnEnvList,
    module UniqDSet,
    module UniqSet,
    module UniqDFM,
    getDependentMods,
#if MIN_VERSION_ghc(9,2,0)
    loadExpr,
    byteCodeGen,
    bc_bcos,
    loadDecls,
    hscInterp,
    expectJust,
#else
    coreExprToBCOs,
    linkExpr,
#endif
    ) where

import           Development.IDE.GHC.Compat.Core
import           Development.IDE.GHC.Compat.Env
import           Development.IDE.GHC.Compat.ExactPrint
import           Development.IDE.GHC.Compat.Iface
import           Development.IDE.GHC.Compat.Logger
import           Development.IDE.GHC.Compat.Outputable
import           Development.IDE.GHC.Compat.Parser
import           Development.IDE.GHC.Compat.Plugins
import           Development.IDE.GHC.Compat.Units
import           Development.IDE.GHC.Compat.Util
import           GHC                                   hiding (HasSrcSpan,
                                                        ModLocation,
                                                        RealSrcSpan, getLoc,
                                                        lookupName, exprType)
#if MIN_VERSION_ghc(9,0,0)
import GHC.Driver.Hooks (hscCompileCoreExprHook)
import GHC.Core (CoreExpr, CoreProgram)
import qualified GHC.Core.Opt.Pipeline as GHC
import GHC.Core.Tidy (tidyExpr)
import GHC.Types.Var.Env (emptyTidyEnv)
import qualified GHC.CoreToStg.Prep as GHC
import GHC.Core.Lint (lintInteractiveExpr)
#if MIN_VERSION_ghc(9,2,0)
import GHC.Unit.Home.ModInfo (lookupHpt, HomePackageTable)
import GHC.Runtime.Context (icInteractiveModule)
import GHC.Unit.Module.Deps (Dependencies(dep_mods))
import GHC.Linker.Types (isObjectLinkable)
import GHC.Linker.Loader (loadExpr)
#else
import GHC.CoreToByteCode (coreExprToBCOs)
import GHC.Driver.Types (Dependencies(dep_mods), icInteractiveModule, lookupHpt, HomePackageTable)
import GHC.Runtime.Linker (linkExpr)
#endif
import GHC.ByteCode.Asm (bcoFreeNames)
import GHC.Types.Annotations (Annotation(..), AnnTarget(ModuleTarget), extendAnnEnvList)
import GHC.Types.Unique.DSet as UniqDSet
import GHC.Types.Unique.Set as UniqSet
import GHC.Types.Unique.DFM  as UniqDFM
#else
import Hooks (hscCompileCoreExprHook)
import CoreSyn (CoreExpr)
import qualified SimplCore as GHC
import CoreTidy (tidyExpr)
import VarEnv (emptyTidyEnv)
import CorePrep (corePrepExpr)
import CoreLint (lintInteractiveExpr)
import ByteCodeGen (coreExprToBCOs)
import HscTypes (icInteractiveModule, HomePackageTable, lookupHpt, Dependencies(dep_mods))
import Linker (linkExpr)
import ByteCodeAsm (bcoFreeNames)
import Annotations (Annotation(..), AnnTarget(ModuleTarget), extendAnnEnvList)
import UniqDSet
import UniqSet
import UniqDFM
#endif

#if MIN_VERSION_ghc(9,0,0)
import           GHC.Data.StringBuffer
import           GHC.Driver.Session                    hiding (ExposePackage)
import qualified GHC.Types.SrcLoc                      as SrcLoc
import           GHC.Utils.Error
#if MIN_VERSION_ghc(9,2,0)
import           Data.Bifunctor
import           GHC.Driver.Env                        as Env
import           GHC.Unit.Module.ModIface
import           GHC.Unit.Module.ModSummary
#else
import           GHC.Driver.Types
#endif
import           GHC.Iface.Env
import           GHC.Iface.Make                        (mkIfaceExports)
import qualified GHC.SysTools.Tasks                    as SysTools
import qualified GHC.Types.Avail                       as Avail
#else
import qualified Avail
import           DynFlags                              hiding (ExposePackage)
import           HscTypes
import           MkIface                               hiding (writeIfaceFile)

#if MIN_VERSION_ghc(8,8,0)
import           StringBuffer                          (hPutStringBuffer)
#endif
import qualified SysTools

#if !MIN_VERSION_ghc(8,8,0)
import qualified EnumSet
import           SrcLoc                                (RealLocated)

import           Foreign.ForeignPtr
import           System.IO
#endif
#endif

import           Compat.HieAst                         (enrichHie)
import           Compat.HieBin
import           Compat.HieTypes
import           Compat.HieUtils
import qualified Data.ByteString                       as BS
import           Data.IORef

import           Data.List                             (foldl')
import qualified Data.Map                              as Map
import qualified Data.Set                              as Set

#if MIN_VERSION_ghc(9,0,0)
import qualified Data.Set                              as S
#endif

#if !MIN_VERSION_ghc(8,10,0)
import           Bag                                   (unitBag)
#endif

#if MIN_VERSION_ghc(9,2,0)
import GHC.Types.CostCentre
import GHC.Stg.Syntax
import GHC.Types.IPE
import GHC.Stg.Syntax
import GHC.Types.IPE
import GHC.Types.CostCentre
import GHC.Core
import GHC.Builtin.Uniques
import GHC.Runtime.Interpreter
import GHC.StgToByteCode
import GHC.Stg.Pipeline
import GHC.ByteCode.Types
import GHC.Linker.Loader (loadDecls)
import GHC.Data.Maybe
import GHC.CoreToStg
#endif

type ModIfaceAnnotation = Annotation

#if MIN_VERSION_ghc(9,2,0)
myCoreToStgExpr :: Logger -> DynFlags -> InteractiveContext
                -> Module -> ModLocation -> CoreExpr
                -> IO ( Id
                      , [StgTopBinding]
                      , InfoTableProvMap
                      , CollectedCCs )
myCoreToStgExpr logger dflags ictxt this_mod ml prepd_expr = do
    {- Create a temporary binding (just because myCoreToStg needs a
       binding for the stg2stg step) -}
    let bco_tmp_id = mkSysLocal (fsLit "BCO_toplevel")
                                (mkPseudoUniqueE 0)
                                Many
                                (exprType prepd_expr)
    (stg_binds, prov_map, collected_ccs) <-
       myCoreToStg logger
                   dflags
                   ictxt
                   this_mod
                   ml
                   [NonRec bco_tmp_id prepd_expr]
    return (bco_tmp_id, stg_binds, prov_map, collected_ccs)

myCoreToStg :: Logger -> DynFlags -> InteractiveContext
            -> Module -> ModLocation -> CoreProgram
            -> IO ( [StgTopBinding] -- output program
                  , InfoTableProvMap
                  , CollectedCCs )  -- CAF cost centre info (declared and used)
myCoreToStg logger dflags ictxt this_mod ml prepd_binds = do
    let (stg_binds, denv, cost_centre_info)
         = {-# SCC "Core2Stg" #-}
           coreToStg dflags this_mod ml prepd_binds

    stg_binds2
        <- {-# SCC "Stg2Stg" #-}
           stg2stg logger dflags ictxt this_mod stg_binds

    return (stg_binds2, denv, cost_centre_info)
#endif


#if !MIN_VERSION_ghc(9,2,0)
reLoc :: Located a -> Located a
reLoc :: Located a -> Located a
reLoc = Located a -> Located a
forall a. a -> a
id

reLocA :: Located a -> Located a
reLocA :: Located a -> Located a
reLocA = Located a -> Located a
forall a. a -> a
id
#endif

getDependentMods :: ModIface -> [ModuleName]
#if MIN_VERSION_ghc(9,0,0)
getDependentMods = map gwib_mod . dep_mods . mi_deps
#else
getDependentMods :: ModIface -> [ModuleName]
getDependentMods = ((ModuleName, IsBootInterface) -> ModuleName)
-> [(ModuleName, IsBootInterface)] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName, IsBootInterface) -> ModuleName
forall a b. (a, b) -> a
fst ([(ModuleName, IsBootInterface)] -> [ModuleName])
-> (ModIface -> [(ModuleName, IsBootInterface)])
-> ModIface
-> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependencies -> [(ModuleName, IsBootInterface)]
dep_mods (Dependencies -> [(ModuleName, IsBootInterface)])
-> (ModIface -> Dependencies)
-> ModIface
-> [(ModuleName, IsBootInterface)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModIface -> Dependencies
forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps
#endif

simplifyExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr
#if MIN_VERSION_ghc(9,0,0)
simplifyExpr _ = GHC.simplifyExpr

corePrepExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr
corePrepExpr _ = GHC.corePrepExpr
#else
simplifyExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr
simplifyExpr DynFlags
df HscEnv
_ = DynFlags -> CoreExpr -> IO CoreExpr
GHC.simplifyExpr DynFlags
df
#endif

#if !MIN_VERSION_ghc(8,8,0)
hPutStringBuffer :: Handle -> StringBuffer -> IO ()
hPutStringBuffer hdl (StringBuffer buf len cur)
    = withForeignPtr (plusForeignPtr buf cur) $ \ptr ->
             hPutBuf hdl ptr len
#endif

#if MIN_VERSION_ghc(9,2,0)
type ErrMsg  = MsgEnvelope DecoratedSDoc
#endif

getMessages' :: PState -> DynFlags -> (Bag WarnMsg, Bag ErrMsg)
getMessages' :: PState -> DynFlags -> (Bag WarnMsg, Bag WarnMsg)
getMessages' PState
pst DynFlags
dflags =
#if MIN_VERSION_ghc(9,2,0)
                 bimap (fmap pprWarning) (fmap pprError) $
#endif
                 PState -> DynFlags -> (Bag WarnMsg, Bag WarnMsg)
getMessages PState
pst
#if !MIN_VERSION_ghc(9,2,0)
                   DynFlags
dflags
#endif

#if MIN_VERSION_ghc(9,2,0)
pattern PFailedWithErrorMessages :: forall a b. (b -> Bag (MsgEnvelope DecoratedSDoc)) -> ParseResult a
pattern PFailedWithErrorMessages msgs
     <- PFailed (const . fmap pprError . getErrorMessages -> msgs)
#elif MIN_VERSION_ghc(8,10,0)
pattern PFailedWithErrorMessages :: (DynFlags -> ErrorMessages) -> ParseResult a
pattern $mPFailedWithErrorMessages :: forall r a.
ParseResult a
-> ((DynFlags -> Bag WarnMsg) -> r) -> (Void# -> r) -> r
PFailedWithErrorMessages msgs
     <- PFailed (getErrorMessages -> msgs)
#else
pattern PFailedWithErrorMessages :: (DynFlags -> ErrorMessages) -> ParseResult a
pattern PFailedWithErrorMessages msgs
     <- ((fmap.fmap) unitBag . mkPlainErrMsgIfPFailed -> Just msgs)

mkPlainErrMsgIfPFailed (PFailed _ pst err) = Just (\dflags -> mkPlainErrMsg dflags pst err)
mkPlainErrMsgIfPFailed _ = Nothing
#endif
{-# COMPLETE PFailedWithErrorMessages #-}

supportsHieFiles :: Bool
supportsHieFiles :: IsBootInterface
supportsHieFiles = IsBootInterface
True

hieExportNames :: HieFile -> [(SrcSpan, Name)]
hieExportNames :: HieFile -> [(SrcSpan, Name)]
hieExportNames = [AvailInfo] -> [(SrcSpan, Name)]
nameListFromAvails ([AvailInfo] -> [(SrcSpan, Name)])
-> (HieFile -> [AvailInfo]) -> HieFile -> [(SrcSpan, Name)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieFile -> [AvailInfo]
hie_exports


upNameCache :: IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c
#if MIN_VERSION_ghc(8,8,0)
upNameCache :: IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c
upNameCache = IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c
forall c. IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c
updNameCache
#else
upNameCache ref upd_fn
  = atomicModifyIORef' ref upd_fn
#endif

#if !MIN_VERSION_ghc(9,0,1)
type RefMap a = Map.Map Identifier [(Span, IdentifierDetails a)]
#endif

mkHieFile' :: ModSummary
           -> [Avail.AvailInfo]
           -> HieASTs Type
           -> BS.ByteString
           -> Hsc HieFile
mkHieFile' :: ModSummary
-> [AvailInfo] -> HieASTs Type -> ByteString -> Hsc HieFile
mkHieFile' ModSummary
ms [AvailInfo]
exports HieASTs Type
asts ByteString
src = do
  let Just FilePath
src_file = ModLocation -> Maybe FilePath
ml_hs_file (ModLocation -> Maybe FilePath) -> ModLocation -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ ModSummary -> ModLocation
ms_location ModSummary
ms
      (HieASTs TypeIndex
asts',Array TypeIndex HieTypeFlat
arr) = HieASTs Type -> (HieASTs TypeIndex, Array TypeIndex HieTypeFlat)
compressTypes HieASTs Type
asts
  HieFile -> Hsc HieFile
forall (m :: * -> *) a. Monad m => a -> m a
return (HieFile -> Hsc HieFile) -> HieFile -> Hsc HieFile
forall a b. (a -> b) -> a -> b
$ HieFile :: FilePath
-> Module
-> Array TypeIndex HieTypeFlat
-> HieASTs TypeIndex
-> [AvailInfo]
-> ByteString
-> HieFile
HieFile
      { hie_hs_file :: FilePath
hie_hs_file = FilePath
src_file
      , hie_module :: Module
hie_module = ModSummary -> Module
ms_mod ModSummary
ms
      , hie_types :: Array TypeIndex HieTypeFlat
hie_types = Array TypeIndex HieTypeFlat
arr
      , hie_asts :: HieASTs TypeIndex
hie_asts = HieASTs TypeIndex
asts'
      -- mkIfaceExports sorts the AvailInfos for stability
      , hie_exports :: [AvailInfo]
hie_exports = [AvailInfo] -> [AvailInfo]
mkIfaceExports [AvailInfo]
exports
      , hie_hs_src :: ByteString
hie_hs_src = ByteString
src
      }

addIncludePathsQuote :: FilePath -> DynFlags -> DynFlags
addIncludePathsQuote :: FilePath -> DynFlags -> DynFlags
addIncludePathsQuote FilePath
path DynFlags
x = DynFlags
x{includePaths :: IncludeSpecs
includePaths = IncludeSpecs -> IncludeSpecs
f (IncludeSpecs -> IncludeSpecs) -> IncludeSpecs -> IncludeSpecs
forall a b. (a -> b) -> a -> b
$ DynFlags -> IncludeSpecs
includePaths DynFlags
x}
    where f :: IncludeSpecs -> IncludeSpecs
f IncludeSpecs
i = IncludeSpecs
i{includePathsQuote :: [FilePath]
includePathsQuote = FilePath
path FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: IncludeSpecs -> [FilePath]
includePathsQuote IncludeSpecs
i}

setHieDir :: FilePath -> DynFlags -> DynFlags
setHieDir :: FilePath -> DynFlags -> DynFlags
setHieDir FilePath
_f DynFlags
d =
#if MIN_VERSION_ghc(8,8,0)
    DynFlags
d { hieDir :: Maybe FilePath
hieDir     = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
_f}
#else
    d
#endif

dontWriteHieFiles :: DynFlags -> DynFlags
dontWriteHieFiles :: DynFlags -> DynFlags
dontWriteHieFiles DynFlags
d =
#if MIN_VERSION_ghc(8,8,0)
    DynFlags -> GeneralFlag -> DynFlags
gopt_unset DynFlags
d GeneralFlag
Opt_WriteHie
#else
    d
#endif

setUpTypedHoles ::DynFlags -> DynFlags
setUpTypedHoles :: DynFlags -> DynFlags
setUpTypedHoles DynFlags
df
  = (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_AbstractRefHoleFits    -- too spammy
#if MIN_VERSION_ghc(8,8,0)
  (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_ShowDocsOfHoleFits     -- not used
#endif
  (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_ShowMatchesOfHoleFits  -- nice but broken (forgets module qualifiers)
  (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_ShowProvOfHoleFits     -- not used
  (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_ShowTypeAppOfHoleFits  -- not used
  (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_ShowTypeAppVarsOfHoleFits -- not used
  (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_ShowTypeOfHoleFits     -- massively simplifies parsing
  (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_set   GeneralFlag
Opt_SortBySubsumHoleFits   -- very nice and fast enough in most cases
  (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_SortValidHoleFits
  (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_UnclutterValidHoleFits
  (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ DynFlags
df
  { refLevelHoleFits :: Maybe TypeIndex
refLevelHoleFits = TypeIndex -> Maybe TypeIndex
forall a. a -> Maybe a
Just TypeIndex
1   -- becomes slow at higher levels
  , maxRefHoleFits :: Maybe TypeIndex
maxRefHoleFits   = TypeIndex -> Maybe TypeIndex
forall a. a -> Maybe a
Just TypeIndex
10  -- quantity does not impact speed
  , maxValidHoleFits :: Maybe TypeIndex
maxValidHoleFits = Maybe TypeIndex
forall a. Maybe a
Nothing  -- quantity does not impact speed
  }


nameListFromAvails :: [Avail.AvailInfo] -> [(SrcSpan, Name)]
nameListFromAvails :: [AvailInfo] -> [(SrcSpan, Name)]
nameListFromAvails [AvailInfo]
as =
  (Name -> (SrcSpan, Name)) -> [Name] -> [(SrcSpan, Name)]
forall a b. (a -> b) -> [a] -> [b]
map (\Name
n -> (Name -> SrcSpan
nameSrcSpan Name
n, Name
n)) ((AvailInfo -> [Name]) -> [AvailInfo] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AvailInfo -> [Name]
Avail.availNames [AvailInfo]
as)


getModuleHash :: ModIface -> Fingerprint
#if MIN_VERSION_ghc(8,10,0)
getModuleHash :: ModIface -> Fingerprint
getModuleHash = ModIfaceBackend -> Fingerprint
mi_mod_hash (ModIfaceBackend -> Fingerprint)
-> (ModIface -> ModIfaceBackend) -> ModIface -> Fingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModIface -> ModIfaceBackend
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts
#else
getModuleHash = mi_mod_hash
#endif


disableWarningsAsErrors :: DynFlags -> DynFlags
disableWarningsAsErrors :: DynFlags -> DynFlags
disableWarningsAsErrors DynFlags
df =
    (DynFlags -> GeneralFlag -> DynFlags)
-> GeneralFlag -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip DynFlags -> GeneralFlag -> DynFlags
gopt_unset GeneralFlag
Opt_WarnIsError (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ (DynFlags -> WarningFlag -> DynFlags)
-> DynFlags -> [WarningFlag] -> DynFlags
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' DynFlags -> WarningFlag -> DynFlags
wopt_unset_fatal DynFlags
df [TypeIndex -> WarningFlag
forall a. Enum a => TypeIndex -> a
toEnum TypeIndex
0 ..]

#if !MIN_VERSION_ghc(8,8,0)
wopt_unset_fatal :: DynFlags -> WarningFlag -> DynFlags
wopt_unset_fatal dfs f
    = dfs { fatalWarningFlags = EnumSet.delete f (fatalWarningFlags dfs) }
#endif

isQualifiedImport :: ImportDecl a -> Bool
#if MIN_VERSION_ghc(8,10,0)
isQualifiedImport :: ImportDecl a -> IsBootInterface
isQualifiedImport ImportDecl{ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified = ImportDeclQualifiedStyle
NotQualified} = IsBootInterface
False
isQualifiedImport ImportDecl{}                              = IsBootInterface
True
#else
isQualifiedImport ImportDecl{ideclQualified}                = ideclQualified
#endif
isQualifiedImport ImportDecl a
_                                         = IsBootInterface
False



#if MIN_VERSION_ghc(9,0,0)
getNodeIds :: HieAST a -> Map.Map Identifier (IdentifierDetails a)
getNodeIds = Map.foldl' combineNodeIds Map.empty . getSourcedNodeInfo . sourcedNodeInfo

combineNodeIds :: Map.Map Identifier (IdentifierDetails a)
                        -> NodeInfo a -> Map.Map Identifier (IdentifierDetails a)
ad `combineNodeIds` (NodeInfo _ _ bd) = Map.unionWith (<>) ad bd

--  Copied from GHC and adjusted to accept TypeIndex instead of Type
-- nodeInfo' :: Ord a => HieAST a -> NodeInfo a
nodeInfo' :: HieAST TypeIndex -> NodeInfo TypeIndex
nodeInfo' = Map.foldl' combineNodeInfo' emptyNodeInfo . getSourcedNodeInfo . sourcedNodeInfo

combineNodeInfo' :: Ord a => NodeInfo a -> NodeInfo a -> NodeInfo a
(NodeInfo as ai ad) `combineNodeInfo'` (NodeInfo bs bi bd) =
  NodeInfo (S.union as bs) (mergeSorted ai bi) (Map.unionWith (<>) ad bd)
  where
    mergeSorted :: Ord a => [a] -> [a] -> [a]
    mergeSorted la@(a:as) lb@(b:bs) = case compare a b of
                                        LT -> a : mergeSorted as lb
                                        EQ -> a : mergeSorted as bs
                                        GT -> b : mergeSorted la bs
    mergeSorted as [] = as
    mergeSorted [] bs = bs

#else

getNodeIds :: HieAST a -> NodeIdentifiers a
getNodeIds :: HieAST a -> NodeIdentifiers a
getNodeIds = NodeInfo a -> NodeIdentifiers a
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers (NodeInfo a -> NodeIdentifiers a)
-> (HieAST a -> NodeInfo a) -> HieAST a -> NodeIdentifiers a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST a -> NodeInfo a
forall a. HieAST a -> NodeInfo a
nodeInfo
-- import qualified FastString as FS

-- nodeInfo' :: HieAST TypeIndex -> NodeInfo TypeIndex
nodeInfo' :: Ord a => HieAST a -> NodeInfo a
nodeInfo' :: HieAST a -> NodeInfo a
nodeInfo' = HieAST a -> NodeInfo a
forall a. HieAST a -> NodeInfo a
nodeInfo
-- type Unit = UnitId
-- moduleUnit :: Module -> Unit
-- moduleUnit = moduleUnitId
-- unhelpfulSpanFS :: FS.FastString -> FS.FastString
-- unhelpfulSpanFS = id
#endif

nodeInfoFromSource :: HieAST a -> Maybe (NodeInfo a)
#if MIN_VERSION_ghc(9,0,0)
nodeInfoFromSource = Map.lookup SourceInfo . getSourcedNodeInfo . sourcedNodeInfo
#else
nodeInfoFromSource :: HieAST a -> Maybe (NodeInfo a)
nodeInfoFromSource = NodeInfo a -> Maybe (NodeInfo a)
forall a. a -> Maybe a
Just (NodeInfo a -> Maybe (NodeInfo a))
-> (HieAST a -> NodeInfo a) -> HieAST a -> Maybe (NodeInfo a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST a -> NodeInfo a
forall a. HieAST a -> NodeInfo a
nodeInfo
#endif

data GhcVersion
  = GHC86
  | GHC88
  | GHC810
  | GHC90
  | GHC92
  deriving (GhcVersion -> GhcVersion -> IsBootInterface
(GhcVersion -> GhcVersion -> IsBootInterface)
-> (GhcVersion -> GhcVersion -> IsBootInterface) -> Eq GhcVersion
forall a.
(a -> a -> IsBootInterface) -> (a -> a -> IsBootInterface) -> Eq a
/= :: GhcVersion -> GhcVersion -> IsBootInterface
$c/= :: GhcVersion -> GhcVersion -> IsBootInterface
== :: GhcVersion -> GhcVersion -> IsBootInterface
$c== :: GhcVersion -> GhcVersion -> IsBootInterface
Eq, Eq GhcVersion
Eq GhcVersion
-> (GhcVersion -> GhcVersion -> Ordering)
-> (GhcVersion -> GhcVersion -> IsBootInterface)
-> (GhcVersion -> GhcVersion -> IsBootInterface)
-> (GhcVersion -> GhcVersion -> IsBootInterface)
-> (GhcVersion -> GhcVersion -> IsBootInterface)
-> (GhcVersion -> GhcVersion -> GhcVersion)
-> (GhcVersion -> GhcVersion -> GhcVersion)
-> Ord GhcVersion
GhcVersion -> GhcVersion -> IsBootInterface
GhcVersion -> GhcVersion -> Ordering
GhcVersion -> GhcVersion -> GhcVersion
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> IsBootInterface)
-> (a -> a -> IsBootInterface)
-> (a -> a -> IsBootInterface)
-> (a -> a -> IsBootInterface)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GhcVersion -> GhcVersion -> GhcVersion
$cmin :: GhcVersion -> GhcVersion -> GhcVersion
max :: GhcVersion -> GhcVersion -> GhcVersion
$cmax :: GhcVersion -> GhcVersion -> GhcVersion
>= :: GhcVersion -> GhcVersion -> IsBootInterface
$c>= :: GhcVersion -> GhcVersion -> IsBootInterface
> :: GhcVersion -> GhcVersion -> IsBootInterface
$c> :: GhcVersion -> GhcVersion -> IsBootInterface
<= :: GhcVersion -> GhcVersion -> IsBootInterface
$c<= :: GhcVersion -> GhcVersion -> IsBootInterface
< :: GhcVersion -> GhcVersion -> IsBootInterface
$c< :: GhcVersion -> GhcVersion -> IsBootInterface
compare :: GhcVersion -> GhcVersion -> Ordering
$ccompare :: GhcVersion -> GhcVersion -> Ordering
$cp1Ord :: Eq GhcVersion
Ord, TypeIndex -> GhcVersion -> ShowS
[GhcVersion] -> ShowS
GhcVersion -> FilePath
(TypeIndex -> GhcVersion -> ShowS)
-> (GhcVersion -> FilePath)
-> ([GhcVersion] -> ShowS)
-> Show GhcVersion
forall a.
(TypeIndex -> a -> ShowS)
-> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [GhcVersion] -> ShowS
$cshowList :: [GhcVersion] -> ShowS
show :: GhcVersion -> FilePath
$cshow :: GhcVersion -> FilePath
showsPrec :: TypeIndex -> GhcVersion -> ShowS
$cshowsPrec :: TypeIndex -> GhcVersion -> ShowS
Show)

ghcVersionStr :: String
ghcVersionStr :: FilePath
ghcVersionStr = VERSION_ghc

ghcVersion :: GhcVersion
#if MIN_VERSION_GLASGOW_HASKELL(9,2,0,0)
ghcVersion = GHC92
#elif MIN_VERSION_GLASGOW_HASKELL(9,0,0,0)
ghcVersion = GHC90
#elif MIN_VERSION_GLASGOW_HASKELL(8,10,0,0)
ghcVersion :: GhcVersion
ghcVersion = GhcVersion
GHC810
#elif MIN_VERSION_GLASGOW_HASKELL(8,8,0,0)
ghcVersion = GHC88
#elif MIN_VERSION_GLASGOW_HASKELL(8,6,0,0)
ghcVersion = GHC86
#endif

runUnlit :: Logger -> DynFlags -> [Option] -> IO ()
runUnlit :: Logger -> DynFlags -> [Option] -> IO ()
runUnlit =
#if MIN_VERSION_ghc(9,2,0)
    SysTools.runUnlit
#else
    (DynFlags -> [Option] -> IO ())
-> Logger -> DynFlags -> [Option] -> IO ()
forall a b. a -> b -> a
const DynFlags -> [Option] -> IO ()
SysTools.runUnlit
#endif

runPp :: Logger -> DynFlags -> [Option] -> IO ()
runPp :: Logger -> DynFlags -> [Option] -> IO ()
runPp =
#if MIN_VERSION_ghc(9,2,0)
    SysTools.runPp
#else
    (DynFlags -> [Option] -> IO ())
-> Logger -> DynFlags -> [Option] -> IO ()
forall a b. a -> b -> a
const DynFlags -> [Option] -> IO ()
SysTools.runPp
#endif

isAnnotationInNodeInfo :: (FastString, FastString) -> NodeInfo a -> Bool
#if MIN_VERSION_ghc(9,2,0)
isAnnotationInNodeInfo (ctor, typ) = Set.member (NodeAnnotation ctor typ) . nodeAnnotations
#else
isAnnotationInNodeInfo :: (FastString, FastString) -> NodeInfo a -> IsBootInterface
isAnnotationInNodeInfo (FastString, FastString)
p = (FastString, FastString)
-> Set (FastString, FastString) -> IsBootInterface
forall a. Ord a => a -> Set a -> IsBootInterface
Set.member (FastString, FastString)
p (Set (FastString, FastString) -> IsBootInterface)
-> (NodeInfo a -> Set (FastString, FastString))
-> NodeInfo a
-> IsBootInterface
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo a -> Set (FastString, FastString)
forall a. NodeInfo a -> Set (FastString, FastString)
nodeAnnotations
#endif

mkAstNode :: NodeInfo a -> Span -> [HieAST a] -> HieAST a
#if MIN_VERSION_ghc(9,0,0)
mkAstNode n = Node (SourcedNodeInfo $ Map.singleton GeneratedInfo n)
#else
mkAstNode :: NodeInfo a -> Span -> [HieAST a] -> HieAST a
mkAstNode = NodeInfo a -> Span -> [HieAST a] -> HieAST a
forall a. NodeInfo a -> Span -> [HieAST a] -> HieAST a
Node
#endif

combineRealSrcSpans :: RealSrcSpan -> RealSrcSpan -> RealSrcSpan
#if MIN_VERSION_ghc(9,2,0)
combineRealSrcSpans = SrcLoc.combineRealSrcSpans
#else
combineRealSrcSpans :: Span -> Span -> Span
combineRealSrcSpans Span
span1 Span
span2
  = RealSrcLoc -> RealSrcLoc -> Span
mkRealSrcSpan (FastString -> TypeIndex -> TypeIndex -> RealSrcLoc
mkRealSrcLoc FastString
file TypeIndex
line_start TypeIndex
col_start) (FastString -> TypeIndex -> TypeIndex -> RealSrcLoc
mkRealSrcLoc FastString
file TypeIndex
line_end TypeIndex
col_end)
  where
    (TypeIndex
line_start, TypeIndex
col_start) = (TypeIndex, TypeIndex)
-> (TypeIndex, TypeIndex) -> (TypeIndex, TypeIndex)
forall a. Ord a => a -> a -> a
min (Span -> TypeIndex
srcSpanStartLine Span
span1, Span -> TypeIndex
srcSpanStartCol Span
span1)
                                  (Span -> TypeIndex
srcSpanStartLine Span
span2, Span -> TypeIndex
srcSpanStartCol Span
span2)
    (TypeIndex
line_end, TypeIndex
col_end)     = (TypeIndex, TypeIndex)
-> (TypeIndex, TypeIndex) -> (TypeIndex, TypeIndex)
forall a. Ord a => a -> a -> a
max (Span -> TypeIndex
srcSpanEndLine Span
span1, Span -> TypeIndex
srcSpanEndCol Span
span1)
                                  (Span -> TypeIndex
srcSpanEndLine Span
span2, Span -> TypeIndex
srcSpanEndCol Span
span2)
    file :: FastString
file = Span -> FastString
srcSpanFile Span
span1
#endif