diff --git a/patches/ghcide-2.9.0.0.patch b/patches/ghcide-2.9.0.0.patch index f0afd7b3fdcdb6e9534f930fe45e555bb2336a4c..43b3eb2452fe3b0dea3825c1891011dc4d745507 100644 --- a/patches/ghcide-2.9.0.0.patch +++ b/patches/ghcide-2.9.0.0.patch @@ -1,5 +1,5 @@ diff --git a/ghcide.cabal b/ghcide.cabal -index 26b9256..5da5a51 100644 +index 26b9256a..5da5a51f 100644 --- a/ghcide.cabal +++ b/ghcide.cabal @@ -91,6 +91,7 @@ library @@ -11,10 +11,62 @@ index 26b9256..5da5a51 100644 , prettyprinter >=1.7 , prettyprinter-ansi-terminal diff --git a/src/Development/IDE/Core/Compile.hs b/src/Development/IDE/Core/Compile.hs -index af1c97a..29d892c 100644 +index af1c97a4..82b05fbb 100644 --- a/src/Development/IDE/Core/Compile.hs +++ b/src/Development/IDE/Core/Compile.hs -@@ -473,7 +473,14 @@ mkHiFileResultNoCompile session tcm = do +@@ -133,6 +133,10 @@ import GHC.Unit.Module.Warnings + import Development.IDE.Core.FileStore (shareFilePath) + #endif + ++import Development.IDE.Import.DependencyInformation ++import GHC.Driver.Env ( hsc_all_home_unit_ids ) ++import Development.IDE.Import.FindImports ++ + --Simple constants to make sure the source is consistently named + sourceTypecheck :: T.Text + sourceTypecheck = "typecheck" +@@ -164,9 +168,10 @@ computePackageDeps env pkg = do + T.pack $ "unknown package: " ++ show pkg] + Just pkgInfo -> return $ Right $ unitDepends pkgInfo + +-newtype TypecheckHelpers ++data TypecheckHelpers + = TypecheckHelpers + { getLinkables :: [NormalizedFilePath] -> IO [LinkableResult] -- ^ hls-graph action to get linkables for files ++ , getModuleGraph :: IO DependencyInformation + } + + typecheckModule :: IdeDefer +@@ -306,19 +311,24 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do + -- Non det OK as we will put it into maps later anyway + map (Compat.installedModule (homeUnitId_ dflags)) $ nonDetEltsUniqSet mods_transitive + #endif +- +-#if MIN_VERSION_ghc(9,3,0) ++#if MIN_VERSION_ghc(9,11,0) ++ ; moduleLocs <- getModuleGraph ++#elif MIN_VERSION_ghc(9,3,0) + ; moduleLocs <- readIORef (fcModuleCache $ hsc_FC hsc_env) + #else + ; moduleLocs <- readIORef (hsc_FC hsc_env) + #endif +- ; lbs <- getLinkables [toNormalizedFilePath' file ++ ; lbs <- getLinkables [file + | installedMod <- mods_transitive_list ++#if MIN_VERSION_ghc(9,11,0) ++ , let file = fromJust $ lookupModuleFile (installedMod { moduleUnit = RealUnit (Definite $ moduleUnit installedMod) }) moduleLocs ++#else + , let ifr = fromJust $ lookupInstalledModuleEnv moduleLocs installedMod +- file = case ifr of ++ file = toNormalizedFilePath' $ case ifr of + InstalledFound loc _ -> + fromJust $ ml_hs_file loc + _ -> panic "hscCompileCoreExprHook: module not found" ++#endif + ] + ; let hsc_env' = loadModulesHome (map linkableHomeMod lbs) hsc_env + +@@ -473,7 +483,14 @@ mkHiFileResultNoCompile session tcm = do details <- makeSimpleDetails hsc_env_tmp tcGblEnv sf <- finalSafeMode (ms_hspp_opts ms) tcGblEnv iface' <- mkIfaceTc hsc_env_tmp sf details ms Nothing tcGblEnv @@ -30,7 +82,7 @@ index af1c97a..29d892c 100644 pure $! mkHiFileResult ms iface details (tmrRuntimeModules tcm) Nothing mkHiFileResultCompile -@@ -500,6 +507,9 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do +@@ -500,6 +517,9 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do details #if MIN_VERSION_ghc(9,3,0) ms @@ -40,7 +92,7 @@ index af1c97a..29d892c 100644 #endif simplified_guts -@@ -507,7 +517,14 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do +@@ -507,7 +527,14 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do #if MIN_VERSION_ghc(9,4,2) Nothing #endif @@ -56,7 +108,7 @@ index af1c97a..29d892c 100644 -- Write the core file now core_file <- do -@@ -515,7 +532,7 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do +@@ -515,7 +542,7 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do core_file = codeGutsToCoreFile iface_hash guts iface_hash = getModuleHash final_iface core_hash1 <- atomicFileWrite se core_fp $ \fp -> @@ -65,7 +117,7 @@ index af1c97a..29d892c 100644 -- We want to drop references to guts and read in a serialized, compact version -- of the core file from disk (as it is deserialised lazily) -- This is because we don't want to keep the guts in memory for every file in -@@ -828,8 +845,18 @@ generateHieAsts hscEnv tcm = +@@ -828,8 +855,18 @@ generateHieAsts hscEnv tcm = -- These varBinds use unitDataConId but it could be anything as the id name is not used -- during the hie file generation process. It's a workaround for the fact that the hie modules -- don't export an interface which allows for additional information to be added to hie files. @@ -85,7 +137,7 @@ index af1c97a..29d892c 100644 ts = tmrTypechecked tcm :: TcGblEnv top_ev_binds = tcg_ev_binds ts :: Util.Bag EvBind insts = tcg_insts ts :: [ClsInst] -@@ -840,7 +867,7 @@ generateHieAsts hscEnv tcm = +@@ -840,7 +877,7 @@ generateHieAsts hscEnv tcm = #else Just <$> #endif @@ -94,8 +146,104 @@ index af1c97a..29d892c 100644 where dflags = hsc_dflags hscEnv run _ts = -- ts is only used in GHC 9.2 +@@ -1046,9 +1083,52 @@ handleGenerationErrors' dflags source action = + -- Add the current ModSummary to the graph, along with the + -- HomeModInfo's of all direct dependencies (by induction hypothesis all + -- transitive dependencies will be contained in envs) +-mergeEnvs :: HscEnv -> ModuleGraph -> ModSummary -> [HomeModInfo] -> [HscEnv] -> IO HscEnv +-mergeEnvs env mg ms extraMods envs = do +-#if MIN_VERSION_ghc(9,3,0) ++mergeEnvs :: HscEnv ++ -> ModuleGraph ++ -> DependencyInformation ++ -> ModSummary ++ -> [HomeModInfo] ++ -> [HscEnv] ++ -> IO HscEnv ++mergeEnvs env mg dep_info ms extraMods envs = do ++#if MIN_VERSION_ghc(9,11,0) ++ return $! loadModulesHome extraMods $ ++ let newHug = foldl' mergeHUG (hsc_HUG env) (map hsc_HUG envs) in ++ (hscUpdateHUG (const newHug) env){ ++ hsc_mod_graph = mg, ++ hsc_FC = (hsc_FC env) ++ { addToFinderCache = \im val -> ++ if moduleUnit im `elem` hsc_all_home_unit_ids env ++ then pure () ++ else addToFinderCache (hsc_FC env) im val ++ , lookupFinderCache = \im -> ++ if moduleUnit im `elem` hsc_all_home_unit_ids env ++ then case lookupModuleFile (im { moduleUnit = RealUnit (Definite $ moduleUnit im) }) dep_info of ++ Nothing -> pure Nothing ++ Just fs -> let ml = fromJust $ do ++ id <- lookupPathToId (depPathIdMap dep_info) fs ++ artifactModLocation (idToModLocation (depPathIdMap dep_info) id) ++ in pure $ Just $ InstalledFound ml im ++ else lookupFinderCache (hsc_FC env) im ++ {- ++ , lookupFileCache = \fp -> ++ case lookup fp dependentHashes of ++ Just res -> return res ++ Nothing -> lookupFileCache (hsc_FC env) fp ++ -} ++ } ++ } ++ ++ where ++ mergeHUG (UnitEnvGraph a) (UnitEnvGraph b) = UnitEnvGraph $ Map.unionWith mergeHUE a b ++ mergeHUE a b = a { homeUnitEnv_hpt = mergeUDFM (homeUnitEnv_hpt a) (homeUnitEnv_hpt b) } ++ mergeUDFM = plusUDFM_C combineModules ++ ++ combineModules a b ++ | HsSrcFile <- mi_hsc_src (hm_iface a) = a ++ | otherwise = b ++ ++#elif MIN_VERSION_ghc(9,3,0) + let im = Compat.installedModule (toUnitId $ moduleUnit $ ms_mod ms) (moduleName (ms_mod ms)) + ifr = InstalledFound (ms_location ms) im + curFinderCache = Compat.extendInstalledModuleEnv Compat.emptyInstalledModuleEnv im ifr +@@ -1420,6 +1500,7 @@ data RecompilationInfo m + , old_value :: Maybe (HiFileResult, FileVersion) + , get_file_version :: NormalizedFilePath -> m (Maybe FileVersion) + , get_linkable_hashes :: [NormalizedFilePath] -> m [BS.ByteString] ++ , get_module_graph :: m DependencyInformation + , regenerate :: Maybe LinkableType -> m ([FileDiagnostic], Maybe HiFileResult) -- ^ Action to regenerate an interface + } + +@@ -1511,7 +1592,7 @@ loadInterface session ms linkableNeeded RecompilationInfo{..} = do + | not (mi_used_th iface) = emptyModuleEnv + | otherwise = parseRuntimeDeps (md_anns details) + -- Peform the fine grained recompilation check for TH +- maybe_recomp <- checkLinkableDependencies session get_linkable_hashes runtime_deps ++ maybe_recomp <- checkLinkableDependencies session get_linkable_hashes get_module_graph runtime_deps + case maybe_recomp of + Just msg -> do_regenerate msg + Nothing +@@ -1548,8 +1629,12 @@ parseRuntimeDeps anns = mkModuleEnv $ mapMaybe go anns + -- the runtime dependencies of the module, to check if any of them are out of date + -- Hopefully 'runtime_deps' will be empty if the module didn't actually use TH + -- See Note [Recompilation avoidance in the presence of TH] +-checkLinkableDependencies :: MonadIO m => HscEnv -> ([NormalizedFilePath] -> m [BS.ByteString]) -> ModuleEnv BS.ByteString -> m (Maybe RecompileRequired) +-checkLinkableDependencies hsc_env get_linkable_hashes runtime_deps = do ++checkLinkableDependencies :: MonadIO m => HscEnv -> ([NormalizedFilePath] -> m [BS.ByteString]) -> m DependencyInformation -> ModuleEnv BS.ByteString -> m (Maybe RecompileRequired) ++checkLinkableDependencies hsc_env get_linkable_hashes get_module_graph runtime_deps = do ++#if MIN_VERSION_ghc(9,11,0) ++ graph <- get_module_graph ++ let go (mod, hash) = (,hash) <$> lookupModuleFile mod graph ++#else + #if MIN_VERSION_ghc(9,3,0) + moduleLocs <- liftIO $ readIORef (fcModuleCache $ hsc_FC hsc_env) + #else +@@ -1562,6 +1647,7 @@ checkLinkableDependencies hsc_env get_linkable_hashes runtime_deps = do + hs <- ml_hs_file loc + pure (toNormalizedFilePath' hs,hash) + _ -> Nothing ++#endif + hs_files = mapM go (moduleEnvToList runtime_deps) + case hs_files of + Nothing -> error "invalid module graph" diff --git a/src/Development/IDE/Core/RuleTypes.hs b/src/Development/IDE/Core/RuleTypes.hs -index 3d60669..499a7e2 100644 +index 3d60669f..97cf13a1 100644 --- a/src/Development/IDE/Core/RuleTypes.hs +++ b/src/Development/IDE/Core/RuleTypes.hs @@ -24,7 +24,7 @@ import qualified Data.Map as M @@ -107,8 +255,159 @@ index 3d60669..499a7e2 100644 import Development.IDE.GHC.Compat.Util import Development.IDE.GHC.CoreFile import Development.IDE.GHC.Util +@@ -279,6 +279,8 @@ type instance RuleResult GetFileContents = (FileVersion, Maybe Text) + + type instance RuleResult GetFileExists = Bool + ++type instance RuleResult GetFileHash = Fingerprint ++ + type instance RuleResult AddWatchedFile = Bool + + +@@ -334,6 +336,12 @@ data GetFileExists = GetFileExists + instance NFData GetFileExists + instance Hashable GetFileExists + ++data GetFileHash = GetFileHash ++ deriving (Eq, Show, Typeable, Generic) ++ ++instance NFData GetFileHash ++instance Hashable GetFileHash ++ + data FileOfInterestStatus + = OnDisk + | Modified { firstOpen :: !Bool -- ^ was this file just opened +diff --git a/src/Development/IDE/Core/Rules.hs b/src/Development/IDE/Core/Rules.hs +index 13f6db6f..5ad43ead 100644 +--- a/src/Development/IDE/Core/Rules.hs ++++ b/src/Development/IDE/Core/Rules.hs +@@ -630,6 +630,13 @@ knownFilesRule recorder = defineEarlyCutOffNoFile (cmapWithPrio LogShake recorde + fs <- knownTargets + pure (LBS.toStrict $ B.encode $ hash fs, unhashed fs) + ++getFileHashRule :: Recorder (WithPriority Log) -> Rules () ++getFileHashRule recorder = ++ defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetFileHash file -> do ++ void $ use_ GetModificationTime file ++ fileHash <- liftIO $ Util.getFileHash (fromNormalizedFilePath file) ++ return (Just (fingerprintToBS fileHash), ([], Just fileHash)) ++ + getModuleGraphRule :: Recorder (WithPriority Log) -> Rules () + getModuleGraphRule recorder = defineEarlyCutOffNoFile (cmapWithPrio LogShake recorder) $ \GetModuleGraph -> do + fs <- toKnownFiles <$> useNoFile_ GetKnownTargets +@@ -675,6 +682,7 @@ typeCheckRuleDefinition hsc pm = do + unlift <- askUnliftIO + let dets = TypecheckHelpers + { getLinkables = unliftIO unlift . uses_ GetLinkable ++ , getModuleGraph = unliftIO unlift $ useNoFile_ GetModuleGraph + } + addUsageDependencies $ liftIO $ + typecheckModule defer hsc dets pm +@@ -795,7 +803,8 @@ ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do + #endif + liftIO $ evaluate $ liftRnf rwhnf module_graph_nodes + return $ mkModuleGraph module_graph_nodes +- session' <- liftIO $ mergeEnvs hsc mg ms inLoadOrder depSessions ++ de <- useNoFile_ GetModuleGraph ++ session' <- liftIO $ mergeEnvs hsc mg de ms inLoadOrder depSessions + + -- Here we avoid a call to to `newHscEnvEqWithImportPaths`, which creates a new + -- ExportsMap when it is called. We only need to create the ExportsMap once per +@@ -824,9 +833,11 @@ getModIfaceFromDiskRule recorder = defineEarlyCutoff (cmapWithPrio LogShake reco + , old_value = m_old + , get_file_version = use GetModificationTime_{missingFileDiagnostics = False} + , get_linkable_hashes = \fs -> map (snd . fromJust . hirCoreFp) <$> uses_ GetModIface fs ++ , get_module_graph = useNoFile_ GetModuleGraph + , regenerate = regenerateHiFile session f ms + } +- r <- loadInterface (hscEnv session) ms linkableType recompInfo ++ hsc_env' <- setFileCacheHook (hscEnv session) ++ r <- loadInterface hsc_env' ms linkableType recompInfo + case r of + (diags, Nothing) -> return (Nothing, (diags, Nothing)) + (diags, Just x) -> do +@@ -933,8 +944,9 @@ getModSummaryRule displayTHWarning recorder = do + generateCore :: RunSimplifier -> NormalizedFilePath -> Action (IdeResult ModGuts) + generateCore runSimplifier file = do + packageState <- hscEnv <$> use_ GhcSessionDeps file ++ hsc' <- setFileCacheHook packageState + tm <- use_ TypeCheck file +- liftIO $ compileModule runSimplifier packageState (tmrModSummary tm) (tmrTypechecked tm) ++ liftIO $ compileModule runSimplifier hsc' (tmrModSummary tm) (tmrTypechecked tm) + + generateCoreRule :: Recorder (WithPriority Log) -> Rules () + generateCoreRule recorder = +@@ -949,14 +961,15 @@ getModIfaceRule recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder) $ + tmr <- use_ TypeCheck f + linkableType <- getLinkableType f + hsc <- hscEnv <$> use_ GhcSessionDeps f ++ hsc' <- setFileCacheHook hsc + let compile = fmap ([],) $ use GenerateCore f + se <- getShakeExtras +- (diags, !mbHiFile) <- writeCoreFileIfNeeded se hsc linkableType compile tmr ++ (diags, !mbHiFile) <- writeCoreFileIfNeeded se hsc' linkableType compile tmr + let fp = hiFileFingerPrint <$> mbHiFile + hiDiags <- case mbHiFile of + Just hiFile + | OnDisk <- status +- , not (tmrDeferredError tmr) -> liftIO $ writeHiFile se hsc hiFile ++ , not (tmrDeferredError tmr) -> liftIO $ writeHiFile se hsc' hiFile + _ -> pure [] + return (fp, (diags++hiDiags, mbHiFile)) + NotFOI -> do +@@ -980,12 +993,21 @@ incrementRebuildCount = do + count <- getRebuildCountVar <$> getIdeGlobalAction + liftIO $ atomically $ modifyTVar' count (+1) + ++setFileCacheHook :: HscEnv -> Action HscEnv ++setFileCacheHook old_hsc_env = do ++#if MIN_VERSION_ghc(9,11,0) ++ unlift <- askUnliftIO ++ return $ old_hsc_env { hsc_FC = (hsc_FC old_hsc_env) { lookupFileCache = unliftIO unlift . use_ GetFileHash . toNormalizedFilePath' } } ++#else ++ return old_hsc_env ++#endif ++ + -- | Also generates and indexes the `.hie` file, along with the `.o` file if needed + -- Invariant maintained is that if the `.hi` file was successfully written, then the + -- `.hie` and `.o` file (if needed) were also successfully written + regenerateHiFile :: HscEnvEq -> NormalizedFilePath -> ModSummary -> Maybe LinkableType -> Action ([FileDiagnostic], Maybe HiFileResult) + regenerateHiFile sess f ms compNeeded = do +- let hsc = hscEnv sess ++ hsc <- setFileCacheHook (hscEnv sess) + opt <- getIdeOptions + + -- Embed haddocks in the interface file +@@ -1225,12 +1247,13 @@ mainRule recorder RulesConfig{..} = do + reportImportCyclesRule recorder + typeCheckRule recorder + getDocMapRule recorder +- loadGhcSession recorder GhcSessionDepsConfig{fullModuleGraph} ++ loadGhcSession recorder def{fullModuleGraph} + getModIfaceFromDiskRule recorder + getModIfaceFromDiskAndIndexRule recorder + getModIfaceRule recorder + getModSummaryRule templateHaskellWarning recorder + getModuleGraphRule recorder ++ getFileHashRule recorder + knownFilesRule recorder + getClientSettingsRule recorder + getHieAstsRule recorder +diff --git a/src/Development/IDE/Core/Shake.hs b/src/Development/IDE/Core/Shake.hs +index 25493da9..9755e4cd 100644 +--- a/src/Development/IDE/Core/Shake.hs ++++ b/src/Development/IDE/Core/Shake.hs +@@ -1265,7 +1265,7 @@ defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do + (mbBs, (diags, mbRes)) <- actionCatch + (do v <- action staleV; liftIO $ evaluate $ force v) $ + \(e :: SomeException) -> do +- pure (Nothing, ([ideErrorText file $ T.pack $ show e | not $ isBadDependency e],Nothing)) ++ pure (Nothing, ([ideErrorText file $ T.pack $ show key ++ show e | not $ isBadDependency e],Nothing)) + + ver <- estimateFileVersionUnsafely key mbRes file + (bs, res) <- case mbRes of diff --git a/src/Development/IDE/GHC/CPP.hs b/src/Development/IDE/GHC/CPP.hs -index b0ec869..13b1992 100644 +index b0ec869e..13b1992e 100644 --- a/src/Development/IDE/GHC/CPP.hs +++ b/src/Development/IDE/GHC/CPP.hs @@ -38,6 +38,10 @@ import qualified GHC.SysTools.Cpp as Pipeline @@ -123,7 +422,7 @@ index b0ec869..13b1992 100644 addOptP f = alterToolSettings $ \s -> s { toolSettings_opt_P = f : toolSettings_opt_P s diff --git a/src/Development/IDE/GHC/Compat/Core.hs b/src/Development/IDE/GHC/Compat/Core.hs -index 06f798d..04dfcc0 100644 +index 06f798d1..04dfcc08 100644 --- a/src/Development/IDE/GHC/Compat/Core.hs +++ b/src/Development/IDE/GHC/Compat/Core.hs @@ -72,6 +72,11 @@ module Development.IDE.GHC.Compat.Core ( @@ -179,7 +478,7 @@ index 06f798d..04dfcc0 100644 diff --git a/src/Development/IDE/GHC/Compat/Iface.hs b/src/Development/IDE/GHC/Compat/Iface.hs -index 7a5fc10..b38e661 100644 +index 7a5fc100..b38e661f 100644 --- a/src/Development/IDE/GHC/Compat/Iface.hs +++ b/src/Development/IDE/GHC/Compat/Iface.hs @@ -24,7 +24,9 @@ import GHC.Iface.Errors.Types (IfaceMessage) @@ -194,7 +493,7 @@ index 7a5fc10..b38e661 100644 #else writeIfaceFile env fp iface = Iface.writeIface (hsc_logger env) (hsc_dflags env) fp iface diff --git a/src/Development/IDE/GHC/CoreFile.hs b/src/Development/IDE/GHC/CoreFile.hs -index ec210a1..7f6e91c 100644 +index ec210a12..7f6e91c5 100644 --- a/src/Development/IDE/GHC/CoreFile.hs +++ b/src/Development/IDE/GHC/CoreFile.hs @@ -26,6 +26,9 @@ import GHC.CoreToIface @@ -232,7 +531,7 @@ index ec210a1..7f6e91c 100644 -- And send the result to the file writeBinMem bh core_path diff --git a/src/Development/IDE/GHC/Orphans.hs b/src/Development/IDE/GHC/Orphans.hs -index d7a8594..75b3a08 100644 +index d7a85948..75b3a08b 100644 --- a/src/Development/IDE/GHC/Orphans.hs +++ b/src/Development/IDE/GHC/Orphans.hs @@ -71,8 +71,11 @@ instance NFData WholeCoreBindings where @@ -248,8 +547,20 @@ index d7a8594..75b3a08 100644 #endif instance Show PackageFlag where show = unpack . printOutputable +diff --git a/src/Development/IDE/Import/DependencyInformation.hs b/src/Development/IDE/Import/DependencyInformation.hs +index 95478fa2..cc4a1420 100644 +--- a/src/Development/IDE/Import/DependencyInformation.hs ++++ b/src/Development/IDE/Import/DependencyInformation.hs +@@ -20,6 +20,7 @@ module Development.IDE.Import.DependencyInformation + , insertImport + , pathToId + , idToPath ++ , idToModLocation + , reachableModules + , processDependencyInformation + , transitiveDeps diff --git a/src/Development/IDE/Plugin/TypeLenses.hs b/src/Development/IDE/Plugin/TypeLenses.hs -index 51d25e9..1314fb9 100644 +index 51d25e99..1314fb99 100644 --- a/src/Development/IDE/Plugin/TypeLenses.hs +++ b/src/Development/IDE/Plugin/TypeLenses.hs @@ -1,6 +1,7 @@ @@ -272,3 +583,61 @@ index 51d25e9..1314fb9 100644 pure $ GlobalBindingTypeSig name (printName name <> " :: " <> showDoc (pprSigmaType ty)) (name `elemNameSet` exports) patToSig p = do let name = patSynName p +diff --git a/src/Development/IDE/Types/HscEnvEq.hs b/src/Development/IDE/Types/HscEnvEq.hs +index dc2999de..c889e779 100644 +--- a/src/Development/IDE/Types/HscEnvEq.hs ++++ b/src/Development/IDE/Types/HscEnvEq.hs +@@ -1,3 +1,4 @@ ++{-# LANGUAGE CPP #-} + module Development.IDE.Types.HscEnvEq + ( HscEnvEq, + hscEnv, newHscEnvEq, +@@ -28,9 +29,13 @@ import Development.IDE.GHC.Error (catchSrcErrors) + import Development.IDE.GHC.Util (lookupPackageConfig) + import Development.IDE.Graph.Classes + import Development.IDE.Types.Exports (ExportsMap, createExportsMap) +-import Ide.PluginUtils (toAbsolute) + import OpenTelemetry.Eventlog (withSpan) ++import System.Directory (makeAbsolute) + import System.FilePath ++import qualified Data.Map as M ++import Data.IORef ++import GHC.Driver.Env (hsc_all_home_unit_ids) ++import Ide.PluginUtils (toAbsolute) + + -- | An 'HscEnv' with equality. Two values are considered equal + -- if they are created with the same call to 'newHscEnvEq' or +@@ -70,8 +75,31 @@ newHscEnvEq root cradlePath hscEnv0 deps = do + newHscEnvEqWithImportPaths (Just $ Set.fromList importPathsCanon) hscEnv deps + + newHscEnvEqWithImportPaths :: Maybe (Set FilePath) -> HscEnv -> [(UnitId, DynFlags)] -> IO HscEnvEq +-newHscEnvEqWithImportPaths envImportPaths hscEnv deps = do +- ++newHscEnvEqWithImportPaths envImportPaths hscEnv' deps = do ++ ++ mod_cache <- newIORef emptyInstalledModuleEnv ++ file_cache <- newIORef M.empty ++ -- This finder cache is for things which are outside of things which are tracked ++ -- by HLS. For example, non-home modules, dependent object files etc ++#if MIN_VERSION_ghc(9,11,0) ++ let hscEnv = hscEnv' ++ { hsc_FC = FinderCache ++ { flushFinderCaches = \_ -> error "GHC should never call flushFinderCaches outside the driver" ++ , addToFinderCache = \im val -> do ++ if moduleUnit im `elem` hsc_all_home_unit_ids hscEnv' ++ then error "tried to add home module to FC" ++ else atomicModifyIORef' mod_cache $ \c -> (extendInstalledModuleEnv c im val, ()) ++ , lookupFinderCache = \im -> do ++ if moduleUnit im `elem` hsc_all_home_unit_ids hscEnv' ++ then error "tried to lookup home module from FC" ++ else lookupInstalledModuleEnv <$> readIORef mod_cache <*> pure im ++ , lookupFileCache = \fp -> error ("not used by HLS" ++ fp) ++ } ++ } ++ ++#else ++ let hscEnv = hscEnv' ++#endif + let dflags = hsc_dflags hscEnv + + envUnique <- Unique.newUnique