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

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

-- | Attempt at hiding the GHC version differences we can.
module Development.IDE.GHC.Compat(
    hPutStringBuffer,
    addIncludePathsQuote,
    getModuleHash,
    setUpTypedHoles,
    lookupNameCache,
    disableWarningsAsErrors,
    reLoc,
    reLocA,
    renderMessages,
    pattern PFailedWithErrorMessages,
    myCoreToStgExpr,
    Usage(..),
    FastStringCompat,
    bytesFS,
    mkFastStringByteString,
    nodeInfo',
    getNodeIds,
    getSourceNodeIds,
    sourceNodeInfo,
    generatedNodeInfo,
    simpleNodeInfoCompat,
    isAnnotationInNodeInfo,
    nodeAnnotations,
    mkAstNode,
    combineRealSrcSpans,
    isQualifiedImport,
    GhcVersion(..),
    ghcVersion,
    ghcVersionStr,
    -- * HIE Compat
    HieFileResult(..),
    HieFile(..),
    hieExportNames,
    mkHieFile',
    enrichHie,
    writeHieFile,
    readHieFile,
    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.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,
    corePrepPgm,
    lintInteractiveExpr,
    icInteractiveModule,
    HomePackageTable,
    lookupHpt,
    loadModulesHome,
    bcoFreeNames,
    ModIfaceAnnotation,
    pattern Annotation,
    AnnTarget(ModuleTarget),
    extendAnnEnvList,
    module UniqDSet,
    module UniqSet,
    module UniqDFM,
    getDependentMods,
    flattenBinds,
    mkRnEnv2,
    emptyInScopeSet,
    Unfolding(..),
    noUnfolding,
    loadExpr,
    byteCodeGen,
    bc_bcos,
    loadDecls,
    hscInterp,
    expectJust,
    extract_cons,
    recDotDot,

#if !MIN_VERSION_ghc(9,3,0)
    Dependencies(dep_mods),
    NameCacheUpdater(NCU),
    extendModSummaryNoDeps,
    emsModSummary,
    nonDetNameEnvElts,
    nonDetOccEnvElts,
    upNameCache,
#endif

#if MIN_VERSION_ghc(9,3,0)
    Dependencies(dep_direct_mods),
    NameCacheUpdater,
#endif

#if MIN_VERSION_ghc(9,5,0)
    XModulePs(..),
#endif

#if !MIN_VERSION_ghc(9,7,0)
    liftZonkM,
    nonDetFoldOccEnv,
#endif

#if MIN_VERSION_ghc(9,7,0)
    tcInitTidyEnv,
#endif
    ) where

import           Compat.HieAst                           (enrichHie)
import           Compat.HieBin
import           Compat.HieTypes                         hiding
                                                         (nodeAnnotations)
import qualified Compat.HieTypes                         as GHC (nodeAnnotations)
import           Compat.HieUtils
import           Control.Applicative                     ((<|>))
import qualified Data.ByteString                         as BS
import           Data.Coerce                             (coerce)
import           Data.List                               (foldl')
import qualified Data.Map                                as Map
import qualified Data.Set                                as S
import           Data.String                             (IsString (fromString))
import           Development.IDE.GHC.Compat.Core
import           Development.IDE.GHC.Compat.Env
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 (ModLocation,
                                                          RealSrcSpan, exprType,
                                                          getLoc, lookupName)
import           Prelude                                 hiding (mod)

import qualified GHC.Core.Opt.Pipeline                   as GHC
import           GHC.Core.Tidy                           (tidyExpr)
import           GHC.CoreToStg.Prep                      (corePrepPgm)
import qualified GHC.CoreToStg.Prep                      as GHC
import           GHC.Driver.Hooks                        (hscCompileCoreExprHook)

import           GHC.ByteCode.Asm                        (bcoFreeNames)
import           GHC.Core
import           GHC.Data.FastString
import           GHC.Data.StringBuffer
import           GHC.Driver.Session                      hiding (ExposePackage)
import           GHC.Iface.Make                          (mkIfaceExports)
import           GHC.SysTools.Tasks                      (runPp, runUnlit)
import           GHC.Types.Annotations                   (AnnTarget (ModuleTarget),
                                                          Annotation (..),
                                                          extendAnnEnvList)
import qualified GHC.Types.Avail                         as Avail
import           GHC.Types.Unique.DFM                    as UniqDFM
import           GHC.Types.Unique.DSet                   as UniqDSet
import           GHC.Types.Unique.Set                    as UniqSet
import           GHC.Types.Var.Env

import           GHC.Builtin.Uniques
import           GHC.ByteCode.Types
import           GHC.CoreToStg
import           GHC.Data.Maybe
import           GHC.Driver.Env                          as Env
import           GHC.Iface.Env
import           GHC.Linker.Loader                       (loadDecls, loadExpr)
import           GHC.Runtime.Context                     (icInteractiveModule)
import           GHC.Stg.Pipeline
import           GHC.Stg.Syntax
import           GHC.StgToByteCode
import           GHC.Types.CostCentre
import           GHC.Types.IPE
import           GHC.Types.SrcLoc                        (combineRealSrcSpans)
import           GHC.Unit.Home.ModInfo                   (HomePackageTable,
                                                          lookupHpt)
import           GHC.Unit.Module.ModIface

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

#if !MIN_VERSION_ghc(9,3,0)
import           Data.IORef
import           GHC.Runtime.Interpreter
import           GHC.Unit.Module.Deps                    (Dependencies (dep_mods),
                                                          Usage (..))
import           GHC.Unit.Module.ModSummary
#endif

#if MIN_VERSION_ghc(9,3,0)
import           GHC.Driver.Config.Stg.Pipeline
import           GHC.Unit.Module.Deps                    (Dependencies (dep_direct_mods),
                                                          Usage (..))
#endif

#if !MIN_VERSION_ghc(9,5,0)
import           GHC.Core.Lint                           (lintInteractiveExpr)
#endif

#if MIN_VERSION_ghc(9,5,0)
import           GHC.Core.Lint.Interactive               (interactiveInScope)
import           GHC.Driver.Config.Core.Lint.Interactive (lintInteractiveExpr)
import           GHC.Driver.Config.Core.Opt.Simplify     (initSimplifyExprOpts)
import           GHC.Driver.Config.CoreToStg             (initCoreToStgOpts)
import           GHC.Driver.Config.CoreToStg.Prep        (initCorePrepConfig)
#endif

#if MIN_VERSION_ghc(9,7,0)
import           GHC.Tc.Zonk.TcType                      (tcInitTidyEnv)
#endif

#if !MIN_VERSION_ghc(9,7,0)
liftZonkM :: a -> a
liftZonkM :: forall a. a -> a
liftZonkM = a -> a
forall a. a -> a
id

nonDetFoldOccEnv :: (a -> b -> b) -> b -> OccEnv a -> b
nonDetFoldOccEnv :: forall a b. (a -> b -> b) -> b -> OccEnv a -> b
nonDetFoldOccEnv = (a -> b -> b) -> b -> OccEnv a -> b
forall a b. (a -> b -> b) -> b -> OccEnv a -> b
foldOccEnv
#endif

#if !MIN_VERSION_ghc(9,3,0)
nonDetOccEnvElts :: OccEnv a -> [a]
nonDetOccEnvElts = occEnvElts
#endif

type ModIfaceAnnotation = Annotation

#if !MIN_VERSION_ghc(9,3,0)
nonDetNameEnvElts :: NameEnv a -> [a]
nonDetNameEnvElts = nameEnvElts
#endif

myCoreToStgExpr :: Logger -> DynFlags -> InteractiveContext
#if MIN_VERSION_ghc(9,3,0)
            -> Bool
#endif
                -> Module -> ModLocation -> CoreExpr
                -> IO ( Id
#if MIN_VERSION_ghc(9,3,0)
                      ,[CgStgTopBinding] -- output program
#else
                      ,[StgTopBinding] -- output program
#endif
                      , InfoTableProvMap
                      , CollectedCCs )
myCoreToStgExpr :: Logger
-> DynFlags
-> InteractiveContext
-> Bool
-> Module
-> ModLocation
-> CoreExpr
-> IO (Id, [CgStgTopBinding], InfoTableProvMap, CollectedCCs)
myCoreToStgExpr Logger
logger DynFlags
dflags InteractiveContext
ictxt
#if MIN_VERSION_ghc(9,3,0)
                Bool
for_bytecode
#endif
                Module
this_mod ModLocation
ml CoreExpr
prepd_expr = do
    {- Create a temporary binding (just because myCoreToStg needs a
       binding for the stg2stg step) -}
    let bco_tmp_id :: Id
bco_tmp_id = FastString -> Unique -> Mult -> Mult -> Id
mkSysLocal (String -> FastString
fsLit String
"BCO_toplevel")
                                (Int -> Unique
mkPseudoUniqueE Int
0)
#if MIN_VERSION_ghc(9,5,0)
                                Mult
ManyTy
#else
                                Many
#endif
                                ((() :: Constraint) => CoreExpr -> Mult
CoreExpr -> Mult
exprType CoreExpr
prepd_expr)
    ([CgStgTopBinding]
stg_binds, InfoTableProvMap
prov_map, CollectedCCs
collected_ccs) <-
       Logger
-> DynFlags
-> InteractiveContext
-> Bool
-> Module
-> ModLocation
-> CoreProgram
-> IO ([CgStgTopBinding], InfoTableProvMap, CollectedCCs)
myCoreToStg Logger
logger
                   DynFlags
dflags
                   InteractiveContext
ictxt
#if MIN_VERSION_ghc(9,3,0)
                   Bool
for_bytecode
#endif
                   Module
this_mod
                   ModLocation
ml
                   [Id -> CoreExpr -> Bind Id
forall b. b -> Expr b -> Bind b
NonRec Id
bco_tmp_id CoreExpr
prepd_expr]
    (Id, [CgStgTopBinding], InfoTableProvMap, CollectedCCs)
-> IO (Id, [CgStgTopBinding], InfoTableProvMap, CollectedCCs)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Id
bco_tmp_id, [CgStgTopBinding]
stg_binds, InfoTableProvMap
prov_map, CollectedCCs
collected_ccs)

myCoreToStg :: Logger -> DynFlags -> InteractiveContext
#if MIN_VERSION_ghc(9,3,0)
            -> Bool
#endif
            -> Module -> ModLocation -> CoreProgram
#if MIN_VERSION_ghc(9,3,0)
            -> IO ( [CgStgTopBinding] -- output program
#else
            -> IO ( [StgTopBinding] -- output program
#endif
                  , InfoTableProvMap
                  , CollectedCCs )  -- CAF cost centre info (declared and used)
myCoreToStg :: Logger
-> DynFlags
-> InteractiveContext
-> Bool
-> Module
-> ModLocation
-> CoreProgram
-> IO ([CgStgTopBinding], InfoTableProvMap, CollectedCCs)
myCoreToStg Logger
logger DynFlags
dflags InteractiveContext
ictxt
#if MIN_VERSION_ghc(9,3,0)
            Bool
for_bytecode
#endif
            Module
this_mod ModLocation
ml CoreProgram
prepd_binds = do
    let ([StgTopBinding]
stg_binds, InfoTableProvMap
denv, CollectedCCs
cost_centre_info)
         = {-# SCC "Core2Stg" #-}
           CoreToStgOpts
-> Module
-> ModLocation
-> CoreProgram
-> ([StgTopBinding], InfoTableProvMap, CollectedCCs)
coreToStg
#if MIN_VERSION_ghc(9,5,0)
             (DynFlags -> CoreToStgOpts
initCoreToStgOpts DynFlags
dflags)
#else
             dflags
#endif
             Module
this_mod ModLocation
ml CoreProgram
prepd_binds

#if MIN_VERSION_ghc(9,8,0)
    (unzip -> (stg_binds2,_),_)
#elif MIN_VERSION_ghc(9,4,2)
    ([CgStgTopBinding]
stg_binds2,StgCgInfos
_)
#else
    stg_binds2
#endif
        <- {-# SCC "Stg2Stg" #-}
#if MIN_VERSION_ghc(9,3,0)
           Logger
-> [Id]
-> StgPipelineOpts
-> Module
-> [StgTopBinding]
-> IO ([CgStgTopBinding], StgCgInfos)
stg2stg Logger
logger
#if MIN_VERSION_ghc(9,5,0)
                   (InteractiveContext -> [Id]
interactiveInScope InteractiveContext
ictxt)
#else
                   ictxt
#endif
                   (DynFlags -> Bool -> StgPipelineOpts
initStgPipelineOpts DynFlags
dflags Bool
for_bytecode) Module
this_mod [StgTopBinding]
stg_binds
#else
           stg2stg logger dflags ictxt this_mod stg_binds
#endif

    ([CgStgTopBinding], InfoTableProvMap, CollectedCCs)
-> IO ([CgStgTopBinding], InfoTableProvMap, CollectedCCs)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([CgStgTopBinding]
stg_binds2, InfoTableProvMap
denv, CollectedCCs
cost_centre_info)

#if MIN_VERSION_ghc(9,9,0)
reLocA :: (HasLoc (GenLocated a e), HasAnnotation b)
      => GenLocated a e -> GenLocated b e
reLocA = reLoc
#endif

getDependentMods :: ModIface -> [ModuleName]
#if MIN_VERSION_ghc(9,3,0)
getDependentMods :: ModIface -> [ModuleName]
getDependentMods = ((UnitId, GenWithIsBoot ModuleName) -> ModuleName)
-> [(UnitId, GenWithIsBoot ModuleName)] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (GenWithIsBoot ModuleName -> ModuleName
forall mod. GenWithIsBoot mod -> mod
gwib_mod (GenWithIsBoot ModuleName -> ModuleName)
-> ((UnitId, GenWithIsBoot ModuleName) -> GenWithIsBoot ModuleName)
-> (UnitId, GenWithIsBoot ModuleName)
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnitId, GenWithIsBoot ModuleName) -> GenWithIsBoot ModuleName
forall a b. (a, b) -> b
snd) ([(UnitId, GenWithIsBoot ModuleName)] -> [ModuleName])
-> (ModIface -> [(UnitId, GenWithIsBoot ModuleName)])
-> ModIface
-> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (UnitId, GenWithIsBoot ModuleName)
-> [(UnitId, GenWithIsBoot ModuleName)]
forall a. Set a -> [a]
S.toList (Set (UnitId, GenWithIsBoot ModuleName)
 -> [(UnitId, GenWithIsBoot ModuleName)])
-> (ModIface -> Set (UnitId, GenWithIsBoot ModuleName))
-> ModIface
-> [(UnitId, GenWithIsBoot ModuleName)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependencies -> Set (UnitId, GenWithIsBoot ModuleName)
dep_direct_mods (Dependencies -> Set (UnitId, GenWithIsBoot ModuleName))
-> (ModIface -> Dependencies)
-> ModIface
-> Set (UnitId, GenWithIsBoot ModuleName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModIface -> Dependencies
forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps
#else
getDependentMods = map gwib_mod . dep_mods . mi_deps
#endif

simplifyExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr
#if MIN_VERSION_ghc(9,5,0)
simplifyExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr
simplifyExpr DynFlags
_ HscEnv
env = Logger
-> ExternalUnitCache -> SimplifyExprOpts -> CoreExpr -> IO CoreExpr
GHC.simplifyExpr (HscEnv -> Logger
Development.IDE.GHC.Compat.Env.hsc_logger HscEnv
env) (UnitEnv -> ExternalUnitCache
ue_eps (HscEnv -> UnitEnv
Development.IDE.GHC.Compat.Env.hsc_unit_env HscEnv
env)) (DynFlags -> InteractiveContext -> SimplifyExprOpts
initSimplifyExprOpts (HscEnv -> DynFlags
hsc_dflags HscEnv
env) (HscEnv -> InteractiveContext
hsc_IC HscEnv
env))
#else
simplifyExpr _ = GHC.simplifyExpr
#endif

corePrepExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr
#if MIN_VERSION_ghc(9,5,0)
corePrepExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr
corePrepExpr DynFlags
_ HscEnv
env CoreExpr
expr = do
  CorePrepConfig
cfg <- HscEnv -> IO CorePrepConfig
initCorePrepConfig HscEnv
env
  Logger -> CorePrepConfig -> CoreExpr -> IO CoreExpr
GHC.corePrepExpr (HscEnv -> Logger
Development.IDE.GHC.Compat.Env.hsc_logger HscEnv
env) CorePrepConfig
cfg CoreExpr
expr
#else
corePrepExpr _ = GHC.corePrepExpr
#endif

renderMessages :: PsMessages -> (Bag WarnMsg, Bag ErrMsg)
renderMessages :: PsMessages -> (Bag WarnMsg, Bag WarnMsg)
renderMessages PsMessages
msgs =
#if MIN_VERSION_ghc(9,3,0)
  let renderMsgs :: (PsMessages -> Messages a) -> Bag WarnMsg
renderMsgs PsMessages -> Messages a
extractor = ((MsgEnvelope a -> WarnMsg) -> Bag (MsgEnvelope a) -> Bag WarnMsg
forall a b. (a -> b) -> Bag a -> Bag b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((MsgEnvelope a -> WarnMsg) -> Bag (MsgEnvelope a) -> Bag WarnMsg)
-> ((a -> DecoratedSDoc) -> MsgEnvelope a -> WarnMsg)
-> (a -> DecoratedSDoc)
-> Bag (MsgEnvelope a)
-> Bag WarnMsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> DecoratedSDoc) -> MsgEnvelope a -> WarnMsg
forall a b. (a -> b) -> MsgEnvelope a -> MsgEnvelope b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) a -> DecoratedSDoc
forall a. Diagnostic a => a -> DecoratedSDoc
renderDiagnosticMessageWithHints (Bag (MsgEnvelope a) -> Bag WarnMsg)
-> (Messages a -> Bag (MsgEnvelope a)) -> Messages a -> Bag WarnMsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Messages a -> Bag (MsgEnvelope a)
forall e. Messages e -> Bag (MsgEnvelope e)
getMessages (Messages a -> Bag WarnMsg) -> Messages a -> Bag WarnMsg
forall a b. (a -> b) -> a -> b
$ PsMessages -> Messages a
extractor PsMessages
msgs
  in ((PsMessages -> Messages PsWarning) -> Bag WarnMsg
forall {a}.
Diagnostic a =>
(PsMessages -> Messages a) -> Bag WarnMsg
renderMsgs PsMessages -> Messages PsWarning
psWarnings, (PsMessages -> Messages PsWarning) -> Bag WarnMsg
forall {a}.
Diagnostic a =>
(PsMessages -> Messages a) -> Bag WarnMsg
renderMsgs PsMessages -> Messages PsWarning
psErrors)
#else
  msgs
#endif

pattern PFailedWithErrorMessages :: forall a b. (b -> Bag (MsgEnvelope DecoratedSDoc)) -> ParseResult a
pattern $mPFailedWithErrorMessages :: forall {r} {a} {b}.
ParseResult a -> ((b -> Bag WarnMsg) -> r) -> ((# #) -> r) -> r
PFailedWithErrorMessages msgs
#if MIN_VERSION_ghc(9,3,0)
     <- PFailed (const . fmap (fmap renderDiagnosticMessageWithHints) . getMessages . getPsErrorMessages -> msgs)
#else
     <- PFailed (const . fmap pprError . getErrorMessages -> msgs)
#endif
{-# COMPLETE POk, PFailedWithErrorMessages #-}

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

#if MIN_VERSION_ghc(9,3,0)
type NameCacheUpdater = NameCache
#else

lookupNameCache :: Module -> OccName -> NameCache -> (NameCache, Name)
-- Lookup up the (Module,OccName) in the NameCache
-- If you find it, return it; if not, allocate a fresh original name and extend
-- the NameCache.
-- Reason: this may the first occurrence of (say) Foo.bar we have encountered.
-- If we need to explore its value we will load Foo.hi; but meanwhile all we
-- need is a Name for it.
lookupNameCache mod occ name_cache =
  case lookupOrigNameCache (nsNames name_cache) mod occ of {
    Just name -> (name_cache, name);
    Nothing   ->
        case takeUniqFromSupply (nsUniqs name_cache) of {
          (uniq, us) ->
              let
                name      = mkExternalName uniq mod occ noSrcSpan
                new_cache = extendNameCache (nsNames name_cache) mod occ name
              in (name_cache{ nsUniqs = us, nsNames = new_cache }, name) }}

upNameCache :: IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c
upNameCache = updNameCache
#endif

mkHieFile' :: ModSummary
           -> [Avail.AvailInfo]
           -> HieASTs Type
           -> BS.ByteString
           -> Hsc HieFile
mkHieFile' :: ModSummary
-> [AvailInfo] -> HieASTs Mult -> ByteString -> Hsc HieFile
mkHieFile' ModSummary
ms [AvailInfo]
exports HieASTs Mult
asts ByteString
src = do
  let Just String
src_file = ModLocation -> Maybe String
ml_hs_file (ModLocation -> Maybe String) -> ModLocation -> Maybe String
forall a b. (a -> b) -> a -> b
$ ModSummary -> ModLocation
ms_location ModSummary
ms
      (HieASTs Int
asts',Array Int HieTypeFlat
arr) = HieASTs Mult -> (HieASTs Int, Array Int HieTypeFlat)
compressTypes HieASTs Mult
asts
  HieFile -> Hsc HieFile
forall a. a -> Hsc a
forall (m :: * -> *) a. Monad m => a -> m a
return (HieFile -> Hsc HieFile) -> HieFile -> Hsc HieFile
forall a b. (a -> b) -> a -> b
$ HieFile
      { hie_hs_file :: String
hie_hs_file = String
src_file
      , hie_module :: Module
hie_module = ModSummary -> Module
ms_mod ModSummary
ms
      , hie_types :: Array Int HieTypeFlat
hie_types = Array Int HieTypeFlat
arr
      , hie_asts :: HieASTs Int
hie_asts = HieASTs Int
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 :: String -> DynFlags -> DynFlags
addIncludePathsQuote String
path DynFlags
x = DynFlags
x{includePaths = f $ includePaths x}
    where f :: IncludeSpecs -> IncludeSpecs
f IncludeSpecs
i = IncludeSpecs
i{includePathsQuote = path : includePathsQuote i}

setHieDir :: FilePath -> DynFlags -> DynFlags
setHieDir :: String -> DynFlags -> DynFlags
setHieDir String
_f DynFlags
d = DynFlags
d { hieDir = Just _f}

dontWriteHieFiles :: DynFlags -> DynFlags
dontWriteHieFiles :: DynFlags -> DynFlags
dontWriteHieFiles DynFlags
d = DynFlags -> GeneralFlag -> DynFlags
gopt_unset DynFlags
d GeneralFlag
Opt_WriteHie

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
  (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
  (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 = refLevelHoleFits df <|> Just 1   -- becomes slow at higher levels

   -- Sometimes GHC can emit a lot of hole fits, this causes editors to be slow
   -- or just crash, we limit the hole fits to 10. The number was chosen
   -- arbirtarily by the author.
  , maxRefHoleFits   = maxRefHoleFits df <|> Just 10
  , maxValidHoleFits = maxValidHoleFits df <|> Just 10
  }


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
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 -> IfaceBackendExts 'ModIfaceFinal
ModIface -> ModIfaceBackend
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts


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 b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' DynFlags -> WarningFlag -> DynFlags
wopt_unset_fatal DynFlags
df [Int -> WarningFlag
forall a. Enum a => Int -> a
toEnum Int
0 ..]

isQualifiedImport :: ImportDecl a -> Bool
isQualifiedImport :: forall a. ImportDecl a -> Bool
isQualifiedImport ImportDecl{ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified = ImportDeclQualifiedStyle
NotQualified} = Bool
False
isQualifiedImport ImportDecl{}                              = Bool
True
isQualifiedImport ImportDecl a
_                                         = Bool
False

-- | Like getNodeIds but with generated node removed
getSourceNodeIds :: HieAST a -> Map.Map Identifier (IdentifierDetails a)
getSourceNodeIds :: forall a. HieAST a -> Map Identifier (IdentifierDetails a)
getSourceNodeIds = (Map Identifier (IdentifierDetails a)
 -> NodeInfo a -> Map Identifier (IdentifierDetails a))
-> Map Identifier (IdentifierDetails a)
-> Map NodeOrigin (NodeInfo a)
-> Map Identifier (IdentifierDetails a)
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' Map Identifier (IdentifierDetails a)
-> NodeInfo a -> Map Identifier (IdentifierDetails a)
forall a.
Map Identifier (IdentifierDetails a)
-> NodeInfo a -> Map Identifier (IdentifierDetails a)
combineNodeIds Map Identifier (IdentifierDetails a)
forall k a. Map k a
Map.empty (Map NodeOrigin (NodeInfo a)
 -> Map Identifier (IdentifierDetails a))
-> (HieAST a -> Map NodeOrigin (NodeInfo a))
-> HieAST a
-> Map Identifier (IdentifierDetails a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeOrigin -> NodeInfo a -> Bool)
-> Map NodeOrigin (NodeInfo a) -> Map NodeOrigin (NodeInfo a)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\NodeOrigin
k NodeInfo a
_ -> NodeOrigin
k NodeOrigin -> NodeOrigin -> Bool
forall a. Eq a => a -> a -> Bool
== NodeOrigin
SourceInfo) (Map NodeOrigin (NodeInfo a) -> Map NodeOrigin (NodeInfo a))
-> (HieAST a -> Map NodeOrigin (NodeInfo a))
-> HieAST a
-> Map NodeOrigin (NodeInfo a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
forall a. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
getSourcedNodeInfo (SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a))
-> (HieAST a -> SourcedNodeInfo a)
-> HieAST a
-> Map NodeOrigin (NodeInfo a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST a -> SourcedNodeInfo a
forall a. HieAST a -> SourcedNodeInfo a
sourcedNodeInfo

getNodeIds :: HieAST a -> Map.Map Identifier (IdentifierDetails a)
getNodeIds :: forall a. HieAST a -> Map Identifier (IdentifierDetails a)
getNodeIds = (Map Identifier (IdentifierDetails a)
 -> NodeInfo a -> Map Identifier (IdentifierDetails a))
-> Map Identifier (IdentifierDetails a)
-> Map NodeOrigin (NodeInfo a)
-> Map Identifier (IdentifierDetails a)
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' Map Identifier (IdentifierDetails a)
-> NodeInfo a -> Map Identifier (IdentifierDetails a)
forall a.
Map Identifier (IdentifierDetails a)
-> NodeInfo a -> Map Identifier (IdentifierDetails a)
combineNodeIds Map Identifier (IdentifierDetails a)
forall k a. Map k a
Map.empty (Map NodeOrigin (NodeInfo a)
 -> Map Identifier (IdentifierDetails a))
-> (HieAST a -> Map NodeOrigin (NodeInfo a))
-> HieAST a
-> Map Identifier (IdentifierDetails a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
forall a. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
getSourcedNodeInfo (SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a))
-> (HieAST a -> SourcedNodeInfo a)
-> HieAST a
-> Map NodeOrigin (NodeInfo a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST a -> SourcedNodeInfo a
forall a. HieAST a -> SourcedNodeInfo a
sourcedNodeInfo

combineNodeIds :: Map.Map Identifier (IdentifierDetails a)
                        -> NodeInfo a -> Map.Map Identifier (IdentifierDetails a)
Map Identifier (IdentifierDetails a)
ad combineNodeIds :: forall a.
Map Identifier (IdentifierDetails a)
-> NodeInfo a -> Map Identifier (IdentifierDetails a)
`combineNodeIds` (NodeInfo Set NodeAnnotation
_ [a]
_ Map Identifier (IdentifierDetails a)
bd) = (IdentifierDetails a -> IdentifierDetails a -> IdentifierDetails a)
-> Map Identifier (IdentifierDetails a)
-> Map Identifier (IdentifierDetails a)
-> Map Identifier (IdentifierDetails a)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith IdentifierDetails a -> IdentifierDetails a -> IdentifierDetails a
forall a. Semigroup a => a -> a -> a
(<>) Map Identifier (IdentifierDetails a)
ad Map Identifier (IdentifierDetails a)
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' :: HieAST Int -> NodeInfo Int
nodeInfo' = (NodeInfo Int -> NodeInfo Int -> NodeInfo Int)
-> NodeInfo Int -> Map NodeOrigin (NodeInfo Int) -> NodeInfo Int
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' NodeInfo Int -> NodeInfo Int -> NodeInfo Int
forall a. Ord a => NodeInfo a -> NodeInfo a -> NodeInfo a
combineNodeInfo' NodeInfo Int
forall a. NodeInfo a
emptyNodeInfo (Map NodeOrigin (NodeInfo Int) -> NodeInfo Int)
-> (HieAST Int -> Map NodeOrigin (NodeInfo Int))
-> HieAST Int
-> NodeInfo Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcedNodeInfo Int -> Map NodeOrigin (NodeInfo Int)
forall a. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
getSourcedNodeInfo (SourcedNodeInfo Int -> Map NodeOrigin (NodeInfo Int))
-> (HieAST Int -> SourcedNodeInfo Int)
-> HieAST Int
-> Map NodeOrigin (NodeInfo Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST Int -> SourcedNodeInfo Int
forall a. HieAST a -> SourcedNodeInfo a
sourcedNodeInfo

combineNodeInfo' :: Ord a => NodeInfo a -> NodeInfo a -> NodeInfo a
(NodeInfo Set NodeAnnotation
as [a]
ai NodeIdentifiers a
ad) combineNodeInfo' :: forall a. Ord a => NodeInfo a -> NodeInfo a -> NodeInfo a
`combineNodeInfo'` (NodeInfo Set NodeAnnotation
bs [a]
bi NodeIdentifiers a
bd) =
  Set NodeAnnotation -> [a] -> NodeIdentifiers a -> NodeInfo a
forall a.
Set NodeAnnotation -> [a] -> NodeIdentifiers a -> NodeInfo a
NodeInfo (Set NodeAnnotation -> Set NodeAnnotation -> Set NodeAnnotation
forall a. Ord a => Set a -> Set a -> Set a
S.union Set NodeAnnotation
as Set NodeAnnotation
bs) ([a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
mergeSorted [a]
ai [a]
bi) ((IdentifierDetails a -> IdentifierDetails a -> IdentifierDetails a)
-> NodeIdentifiers a -> NodeIdentifiers a -> NodeIdentifiers a
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith IdentifierDetails a -> IdentifierDetails a -> IdentifierDetails a
forall a. Semigroup a => a -> a -> a
(<>) NodeIdentifiers a
ad NodeIdentifiers a
bd)
  where
    mergeSorted :: Ord a => [a] -> [a] -> [a]
    mergeSorted :: forall a. Ord a => [a] -> [a] -> [a]
mergeSorted la :: [a]
la@(a
a:[a]
axs) lb :: [a]
lb@(a
b:[a]
bxs) = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b of
                                        Ordering
LT -> a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
mergeSorted [a]
axs [a]
lb
                                        Ordering
EQ -> a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
mergeSorted [a]
axs [a]
bxs
                                        Ordering
GT -> a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
mergeSorted [a]
la [a]
bxs
    mergeSorted [a]
axs [] = [a]
axs
    mergeSorted [] [a]
bxs = [a]
bxs

sourceNodeInfo :: HieAST a -> Maybe (NodeInfo a)
sourceNodeInfo :: forall a. HieAST a -> Maybe (NodeInfo a)
sourceNodeInfo = NodeOrigin -> Map NodeOrigin (NodeInfo a) -> Maybe (NodeInfo a)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NodeOrigin
SourceInfo (Map NodeOrigin (NodeInfo a) -> Maybe (NodeInfo a))
-> (HieAST a -> Map NodeOrigin (NodeInfo a))
-> HieAST a
-> Maybe (NodeInfo a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
forall a. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
getSourcedNodeInfo (SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a))
-> (HieAST a -> SourcedNodeInfo a)
-> HieAST a
-> Map NodeOrigin (NodeInfo a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST a -> SourcedNodeInfo a
forall a. HieAST a -> SourcedNodeInfo a
sourcedNodeInfo

generatedNodeInfo :: HieAST a -> Maybe (NodeInfo a)
generatedNodeInfo :: forall a. HieAST a -> Maybe (NodeInfo a)
generatedNodeInfo = NodeOrigin -> Map NodeOrigin (NodeInfo a) -> Maybe (NodeInfo a)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NodeOrigin
GeneratedInfo (Map NodeOrigin (NodeInfo a) -> Maybe (NodeInfo a))
-> (HieAST a -> Map NodeOrigin (NodeInfo a))
-> HieAST a
-> Maybe (NodeInfo a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
forall a. SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a)
getSourcedNodeInfo (SourcedNodeInfo a -> Map NodeOrigin (NodeInfo a))
-> (HieAST a -> SourcedNodeInfo a)
-> HieAST a
-> Map NodeOrigin (NodeInfo a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST a -> SourcedNodeInfo a
forall a. HieAST a -> SourcedNodeInfo a
sourcedNodeInfo

data GhcVersion
  = GHC92
  | GHC94
  | GHC96
  | GHC98
  | GHC910
  deriving (GhcVersion -> GhcVersion -> Bool
(GhcVersion -> GhcVersion -> Bool)
-> (GhcVersion -> GhcVersion -> Bool) -> Eq GhcVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GhcVersion -> GhcVersion -> Bool
== :: GhcVersion -> GhcVersion -> Bool
$c/= :: GhcVersion -> GhcVersion -> Bool
/= :: GhcVersion -> GhcVersion -> Bool
Eq, Eq GhcVersion
Eq GhcVersion =>
(GhcVersion -> GhcVersion -> Ordering)
-> (GhcVersion -> GhcVersion -> Bool)
-> (GhcVersion -> GhcVersion -> Bool)
-> (GhcVersion -> GhcVersion -> Bool)
-> (GhcVersion -> GhcVersion -> Bool)
-> (GhcVersion -> GhcVersion -> GhcVersion)
-> (GhcVersion -> GhcVersion -> GhcVersion)
-> Ord GhcVersion
GhcVersion -> GhcVersion -> Bool
GhcVersion -> GhcVersion -> Ordering
GhcVersion -> GhcVersion -> GhcVersion
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GhcVersion -> GhcVersion -> Ordering
compare :: GhcVersion -> GhcVersion -> Ordering
$c< :: GhcVersion -> GhcVersion -> Bool
< :: GhcVersion -> GhcVersion -> Bool
$c<= :: GhcVersion -> GhcVersion -> Bool
<= :: GhcVersion -> GhcVersion -> Bool
$c> :: GhcVersion -> GhcVersion -> Bool
> :: GhcVersion -> GhcVersion -> Bool
$c>= :: GhcVersion -> GhcVersion -> Bool
>= :: GhcVersion -> GhcVersion -> Bool
$cmax :: GhcVersion -> GhcVersion -> GhcVersion
max :: GhcVersion -> GhcVersion -> GhcVersion
$cmin :: GhcVersion -> GhcVersion -> GhcVersion
min :: GhcVersion -> GhcVersion -> GhcVersion
Ord, Int -> GhcVersion -> ShowS
[GhcVersion] -> ShowS
GhcVersion -> String
(Int -> GhcVersion -> ShowS)
-> (GhcVersion -> String)
-> ([GhcVersion] -> ShowS)
-> Show GhcVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GhcVersion -> ShowS
showsPrec :: Int -> GhcVersion -> ShowS
$cshow :: GhcVersion -> String
show :: GhcVersion -> String
$cshowList :: [GhcVersion] -> ShowS
showList :: [GhcVersion] -> ShowS
Show, Int -> GhcVersion
GhcVersion -> Int
GhcVersion -> [GhcVersion]
GhcVersion -> GhcVersion
GhcVersion -> GhcVersion -> [GhcVersion]
GhcVersion -> GhcVersion -> GhcVersion -> [GhcVersion]
(GhcVersion -> GhcVersion)
-> (GhcVersion -> GhcVersion)
-> (Int -> GhcVersion)
-> (GhcVersion -> Int)
-> (GhcVersion -> [GhcVersion])
-> (GhcVersion -> GhcVersion -> [GhcVersion])
-> (GhcVersion -> GhcVersion -> [GhcVersion])
-> (GhcVersion -> GhcVersion -> GhcVersion -> [GhcVersion])
-> Enum GhcVersion
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: GhcVersion -> GhcVersion
succ :: GhcVersion -> GhcVersion
$cpred :: GhcVersion -> GhcVersion
pred :: GhcVersion -> GhcVersion
$ctoEnum :: Int -> GhcVersion
toEnum :: Int -> GhcVersion
$cfromEnum :: GhcVersion -> Int
fromEnum :: GhcVersion -> Int
$cenumFrom :: GhcVersion -> [GhcVersion]
enumFrom :: GhcVersion -> [GhcVersion]
$cenumFromThen :: GhcVersion -> GhcVersion -> [GhcVersion]
enumFromThen :: GhcVersion -> GhcVersion -> [GhcVersion]
$cenumFromTo :: GhcVersion -> GhcVersion -> [GhcVersion]
enumFromTo :: GhcVersion -> GhcVersion -> [GhcVersion]
$cenumFromThenTo :: GhcVersion -> GhcVersion -> GhcVersion -> [GhcVersion]
enumFromThenTo :: GhcVersion -> GhcVersion -> GhcVersion -> [GhcVersion]
Enum)

ghcVersionStr :: String
ghcVersionStr :: String
ghcVersionStr = VERSION_ghc

ghcVersion :: GhcVersion
#if MIN_VERSION_GLASGOW_HASKELL(9,10,0,0)
ghcVersion = GHC910
#elif MIN_VERSION_GLASGOW_HASKELL(9,8,0,0)
ghcVersion = GHC98
#elif MIN_VERSION_GLASGOW_HASKELL(9,6,0,0)
ghcVersion :: GhcVersion
ghcVersion = GhcVersion
GHC96
#elif MIN_VERSION_GLASGOW_HASKELL(9,4,0,0)
ghcVersion = GHC94
#elif MIN_VERSION_GLASGOW_HASKELL(9,2,0,0)
ghcVersion = GHC92
#endif

simpleNodeInfoCompat :: FastStringCompat -> FastStringCompat -> NodeInfo a
simpleNodeInfoCompat :: forall a. FastStringCompat -> FastStringCompat -> NodeInfo a
simpleNodeInfoCompat FastStringCompat
ctor FastStringCompat
typ = FastString -> FastString -> NodeInfo a
forall a. FastString -> FastString -> NodeInfo a
simpleNodeInfo (FastStringCompat -> FastString
forall a b. Coercible a b => a -> b
coerce FastStringCompat
ctor) (FastStringCompat -> FastString
forall a b. Coercible a b => a -> b
coerce FastStringCompat
typ)

isAnnotationInNodeInfo :: (FastStringCompat, FastStringCompat) -> NodeInfo a -> Bool
isAnnotationInNodeInfo :: forall a.
(FastStringCompat, FastStringCompat) -> NodeInfo a -> Bool
isAnnotationInNodeInfo (FastStringCompat, FastStringCompat)
p = (FastStringCompat, FastStringCompat)
-> Set (FastStringCompat, FastStringCompat) -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member (FastStringCompat, FastStringCompat)
p (Set (FastStringCompat, FastStringCompat) -> Bool)
-> (NodeInfo a -> Set (FastStringCompat, FastStringCompat))
-> NodeInfo a
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo a -> Set (FastStringCompat, FastStringCompat)
forall a. NodeInfo a -> Set (FastStringCompat, FastStringCompat)
nodeAnnotations

nodeAnnotations :: NodeInfo a -> S.Set (FastStringCompat, FastStringCompat)
nodeAnnotations :: forall a. NodeInfo a -> Set (FastStringCompat, FastStringCompat)
nodeAnnotations = (NodeAnnotation -> (FastStringCompat, FastStringCompat))
-> Set NodeAnnotation -> Set (FastStringCompat, FastStringCompat)
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (\(NodeAnnotation FastString
ctor FastString
typ) -> (FastString -> FastStringCompat
forall a b. Coercible a b => a -> b
coerce FastString
ctor, FastString -> FastStringCompat
forall a b. Coercible a b => a -> b
coerce FastString
typ)) (Set NodeAnnotation -> Set (FastStringCompat, FastStringCompat))
-> (NodeInfo a -> Set NodeAnnotation)
-> NodeInfo a
-> Set (FastStringCompat, FastStringCompat)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo a -> Set NodeAnnotation
forall a. NodeInfo a -> Set NodeAnnotation
GHC.nodeAnnotations

newtype FastStringCompat = FastStringCompat LexicalFastString
    deriving (Int -> FastStringCompat -> ShowS
[FastStringCompat] -> ShowS
FastStringCompat -> String
(Int -> FastStringCompat -> ShowS)
-> (FastStringCompat -> String)
-> ([FastStringCompat] -> ShowS)
-> Show FastStringCompat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FastStringCompat -> ShowS
showsPrec :: Int -> FastStringCompat -> ShowS
$cshow :: FastStringCompat -> String
show :: FastStringCompat -> String
$cshowList :: [FastStringCompat] -> ShowS
showList :: [FastStringCompat] -> ShowS
Show, FastStringCompat -> FastStringCompat -> Bool
(FastStringCompat -> FastStringCompat -> Bool)
-> (FastStringCompat -> FastStringCompat -> Bool)
-> Eq FastStringCompat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FastStringCompat -> FastStringCompat -> Bool
== :: FastStringCompat -> FastStringCompat -> Bool
$c/= :: FastStringCompat -> FastStringCompat -> Bool
/= :: FastStringCompat -> FastStringCompat -> Bool
Eq, Eq FastStringCompat
Eq FastStringCompat =>
(FastStringCompat -> FastStringCompat -> Ordering)
-> (FastStringCompat -> FastStringCompat -> Bool)
-> (FastStringCompat -> FastStringCompat -> Bool)
-> (FastStringCompat -> FastStringCompat -> Bool)
-> (FastStringCompat -> FastStringCompat -> Bool)
-> (FastStringCompat -> FastStringCompat -> FastStringCompat)
-> (FastStringCompat -> FastStringCompat -> FastStringCompat)
-> Ord FastStringCompat
FastStringCompat -> FastStringCompat -> Bool
FastStringCompat -> FastStringCompat -> Ordering
FastStringCompat -> FastStringCompat -> FastStringCompat
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FastStringCompat -> FastStringCompat -> Ordering
compare :: FastStringCompat -> FastStringCompat -> Ordering
$c< :: FastStringCompat -> FastStringCompat -> Bool
< :: FastStringCompat -> FastStringCompat -> Bool
$c<= :: FastStringCompat -> FastStringCompat -> Bool
<= :: FastStringCompat -> FastStringCompat -> Bool
$c> :: FastStringCompat -> FastStringCompat -> Bool
> :: FastStringCompat -> FastStringCompat -> Bool
$c>= :: FastStringCompat -> FastStringCompat -> Bool
>= :: FastStringCompat -> FastStringCompat -> Bool
$cmax :: FastStringCompat -> FastStringCompat -> FastStringCompat
max :: FastStringCompat -> FastStringCompat -> FastStringCompat
$cmin :: FastStringCompat -> FastStringCompat -> FastStringCompat
min :: FastStringCompat -> FastStringCompat -> FastStringCompat
Ord)

instance IsString FastStringCompat where
    fromString :: String -> FastStringCompat
fromString = LexicalFastString -> FastStringCompat
FastStringCompat (LexicalFastString -> FastStringCompat)
-> (String -> LexicalFastString) -> String -> FastStringCompat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> LexicalFastString
LexicalFastString (FastString -> LexicalFastString)
-> (String -> FastString) -> String -> LexicalFastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
forall a. IsString a => String -> a
fromString

mkAstNode :: NodeInfo a -> Span -> [HieAST a] -> HieAST a
mkAstNode :: forall a. NodeInfo a -> Span -> [HieAST a] -> HieAST a
mkAstNode NodeInfo a
n = SourcedNodeInfo a -> Span -> [HieAST a] -> HieAST a
forall a. SourcedNodeInfo a -> Span -> [HieAST a] -> HieAST a
Node (Map NodeOrigin (NodeInfo a) -> SourcedNodeInfo a
forall a. Map NodeOrigin (NodeInfo a) -> SourcedNodeInfo a
SourcedNodeInfo (Map NodeOrigin (NodeInfo a) -> SourcedNodeInfo a)
-> Map NodeOrigin (NodeInfo a) -> SourcedNodeInfo a
forall a b. (a -> b) -> a -> b
$ NodeOrigin -> NodeInfo a -> Map NodeOrigin (NodeInfo a)
forall k a. k -> a -> Map k a
Map.singleton NodeOrigin
GeneratedInfo NodeInfo a
n)

-- | Load modules, quickly. Input doesn't need to be desugared.
-- A module must be loaded before dependent modules can be typechecked.
-- This variant of loadModuleHome will *never* cause recompilation, it just
-- modifies the session.
-- The order modules are loaded is important when there are hs-boot files.
-- In particular you should make sure to load the .hs version of a file after the
-- .hs-boot version.
loadModulesHome
    :: [HomeModInfo]
    -> HscEnv
    -> HscEnv
loadModulesHome :: [HomeModInfo] -> HscEnv -> HscEnv
loadModulesHome [HomeModInfo]
mod_infos HscEnv
e =
#if MIN_VERSION_ghc(9,3,0)
  (HomeUnitGraph -> HomeUnitGraph) -> HscEnv -> HscEnv
hscUpdateHUG (\HomeUnitGraph
hug -> (HomeUnitGraph -> HomeModInfo -> HomeUnitGraph)
-> HomeUnitGraph -> [HomeModInfo] -> HomeUnitGraph
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((HomeModInfo -> HomeUnitGraph -> HomeUnitGraph)
-> HomeUnitGraph -> HomeModInfo -> HomeUnitGraph
forall a b c. (a -> b -> c) -> b -> a -> c
flip HomeModInfo -> HomeUnitGraph -> HomeUnitGraph
addHomeModInfoToHug) HomeUnitGraph
hug [HomeModInfo]
mod_infos) (HscEnv
e { hsc_type_env_vars = emptyKnotVars })
#else
  let !new_modules = addListToHpt (hsc_HPT e) [(mod_name x, x) | x <- mod_infos]
  in e { hsc_HPT = new_modules
       , hsc_type_env_var = Nothing
       }
    where
      mod_name = moduleName . mi_module . hm_iface
#endif

recDotDot :: HsRecFields (GhcPass p) arg -> Maybe Int
recDotDot :: forall (p :: Pass) arg. HsRecFields (GhcPass p) arg -> Maybe Int
recDotDot HsRecFields (GhcPass p) arg
x =
#if MIN_VERSION_ghc(9,5,0)
            RecFieldsDotDot -> Int
unRecFieldsDotDot (RecFieldsDotDot -> Int)
-> (GenLocated SrcSpan RecFieldsDotDot -> RecFieldsDotDot)
-> GenLocated SrcSpan RecFieldsDotDot
-> Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
#endif
            GenLocated SrcSpan RecFieldsDotDot -> RecFieldsDotDot
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpan RecFieldsDotDot -> Int)
-> Maybe (GenLocated SrcSpan RecFieldsDotDot) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsRecFields (GhcPass p) arg
-> Maybe (XRec (GhcPass p) RecFieldsDotDot)
forall p arg. HsRecFields p arg -> Maybe (XRec p RecFieldsDotDot)
rec_dotdot HsRecFields (GhcPass p) arg
x

#if MIN_VERSION_ghc(9,5,0)
extract_cons :: DataDefnCons a -> [a]
extract_cons (NewTypeCon a
x) = [a
x]
extract_cons (DataTypeCons Bool
_ [a]
xs) = [a]
xs
#else
extract_cons = id
#endif