Remove pre-multi component junk for GHC <= 9.2

ghcide/session-loader/Development/IDE/Session.hs

@@ -62,8 +62,7 @@ import           Development.IDE.Graph               (Action)
 import qualified Development.IDE.Session.Implicit    as GhcIde
 import           Development.IDE.Types.Diagnostics
 import           Development.IDE.Types.Exports
-import           Development.IDE.Types.HscEnvEq      (HscEnvEq, newHscEnvEq,
-                                                      newHscEnvEqPreserveImportPaths)
+import           Development.IDE.Types.HscEnvEq      (HscEnvEq, newHscEnvEq)
 import           Development.IDE.Types.Location
 import           Development.IDE.Types.Options
 import           GHC.ResponseFile
@@ -569,8 +568,8 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
           -- For GHC's supporting multi component sessions, we create a shared
           -- HscEnv but set the active component accordingly
           hscEnv <- emptyHscEnv ideNc _libDir
-          let new_cache = newComponentCache recorder optExtensions hieYaml _cfp hscEnv
-          all_target_details <- new_cache old_deps new_deps rootDir
+          let new_cache = newComponentCache recorder optExtensions _cfp hscEnv
+          all_target_details <- new_cache old_deps new_deps
 
           this_dep_info <- getDependencyInfo $ maybeToList hieYaml
           let (all_targets, this_flags_map, this_options)
@@ -761,10 +760,6 @@ emptyHscEnv nc libDir = do
     -- We need to do this before we call initUnits.
     env <- runGhc (Just libDir) $
       getSessionDynFlags >>= setSessionDynFlags >> getSession
-    -- On GHC 9.2 calling setSessionDynFlags caches the unit databases
-    -- for an empty environment. This prevents us from reading the
-    -- package database subsequently. So clear the unit db cache in
-    -- hsc_unit_dbs
     pure $ setNameCache nc (hscSetFlags ((hsc_dflags env){useUnicode = True }) env)
 
 data TargetDetails = TargetDetails
@@ -870,14 +865,12 @@ checkHomeUnitsClosed' ue home_id_set
 newComponentCache
          :: Recorder (WithPriority Log)
          -> [String]           -- ^ File extensions to consider
-         -> Maybe FilePath     -- ^ Path to cradle
          -> NormalizedFilePath -- ^ Path to file that caused the creation of this component
          -> HscEnv             -- ^ An empty HscEnv
          -> [ComponentInfo]    -- ^ New components to be loaded
          -> [ComponentInfo]    -- ^ old, already existing components
-         -> FilePath           -- ^ root dir, see Note [Root Directory]
          -> IO [ [TargetDetails] ]
-newComponentCache recorder exts cradlePath _cfp hsc_env old_cis new_cis dir = do
+newComponentCache recorder exts _cfp hsc_env old_cis new_cis = do
     let cis = Map.unionWith unionCIs (mkMap new_cis) (mkMap old_cis)
         -- When we have multiple components with the same uid,
         -- prefer the new one over the old.
@@ -917,13 +910,12 @@ newComponentCache recorder exts cradlePath _cfp hsc_env old_cis new_cis dir = do
 
     forM (Map.elems cis) $ \ci -> do
       let df = componentDynFlags ci
-      let createHscEnvEq = maybe newHscEnvEqPreserveImportPaths (newHscEnvEq dir) cradlePath
       thisEnv <- do
             -- In GHC 9.4 we have multi component support, and we have initialised all the units
             -- above.
             -- We just need to set the current unit here
             pure $ hscSetActiveUnitId (homeUnitId_ df) hscEnv'
-      henv <- createHscEnvEq thisEnv (zip uids dfs)
+      henv <- newHscEnvEq thisEnv
       let targetEnv = (if isBad ci then multi_errs else [], Just henv)
           targetDepends = componentDependencyInfo ci
       logWith recorder Debug $ LogNewComponentCache (targetEnv, targetDepends)
@@ -1185,14 +1177,7 @@ setOptions cfp (ComponentOptions theOpts compRoot _) dflags rootDir = do
               Compat.setUpTypedHoles $
               makeDynFlagsAbsolute compRoot -- makeDynFlagsAbsolute already accounts for workingDirectory
               dflags''
-        -- initPackages parses the -package flags and
-        -- sets up the visibility for each component.
-        -- Throws if a -package flag cannot be satisfied.
-        -- This only works for GHC <9.2
-        -- For GHC >= 9.2, we need to modify the unit env in the hsc_dflags, which
-        -- is done later in newComponentCache
-        final_flags <- liftIO $ wrapPackageSetupException $ Compat.oldInitUnits dflags'''
-        return (final_flags, targets)
+        return (dflags''', targets)
 
 setIgnoreInterfacePragmas :: DynFlags -> DynFlags
 setIgnoreInterfacePragmas df =

ghcide/src/Development/IDE.hs

@@ -50,7 +50,6 @@ import           Development.IDE.Graph                 as X (Action, RuleResult,
 import           Development.IDE.Plugin                as X
 import           Development.IDE.Types.Diagnostics     as X
 import           Development.IDE.Types.HscEnvEq        as X (HscEnvEq (..),
-                                                             hscEnv,
-                                                             hscEnvWithImportPaths)
+                                                             hscEnv)
 import           Development.IDE.Types.Location        as X
 import           Ide.Logger                            as X

ghcide/src/Development/IDE/Core/Rules.hs

@@ -319,18 +319,11 @@ getLocatedImportsRule recorder =
         (KnownTargets targets targetsMap) <- useNoFile_ GetKnownTargets
         let imports = [(False, imp) | imp <- ms_textual_imps ms] ++ [(True, imp) | imp <- ms_srcimps ms]
         env_eq <- use_ GhcSession file
-        let env = hscEnvWithImportPaths env_eq
-        let import_dirs = deps env_eq
+        let env = hscEnv env_eq
+        let import_dirs = map (second homeUnitEnv_dflags) $ hugElts $ hsc_HUG env
         let dflags = hsc_dflags env
-            isImplicitCradle = isNothing $ envImportPaths env_eq
-        let dflags' = if isImplicitCradle
-                    then addRelativeImport file (moduleName $ ms_mod ms) dflags
-                    else dflags
         opt <- getIdeOptions
         let getTargetFor modName nfp
-                | isImplicitCradle = do
-                    itExists <- getFileExists nfp
-                    return $ if itExists then Just nfp else Nothing
                 | Just (TargetFile nfp') <- HM.lookup (TargetFile nfp) targetsMap = do
                     -- reuse the existing NormalizedFilePath in order to maximize sharing
                     itExists <- getFileExists nfp'
@@ -341,10 +334,11 @@ getLocatedImportsRule recorder =
                         nfp' = HM.lookupDefault nfp nfp ttmap
                     itExists <- getFileExists nfp'
                     return $ if itExists then Just nfp' else Nothing
-                | otherwise
-                = return Nothing
+                | otherwise = do
+                    itExists <- getFileExists nfp
+                    return $ if itExists then Just nfp else Nothing
         (diags, imports') <- fmap unzip $ forM imports $ \(isSource, (mbPkgName, modName)) -> do
-            diagOrImp <- locateModule (hscSetFlags dflags' env) import_dirs (optExtensions opt) getTargetFor modName mbPkgName isSource
+            diagOrImp <- locateModule (hscSetFlags dflags env) import_dirs (optExtensions opt) getTargetFor modName mbPkgName isSource
             case diagOrImp of
                 Left diags              -> pure (diags, Just (modName, Nothing))
                 Right (FileImport path) -> pure ([], Just (modName, Just path))

ghcide/src/Development/IDE/GHC/Compat/Units.hs

@@ -5,7 +5,6 @@ module Development.IDE.GHC.Compat.Units (
     -- * UnitState
     UnitState,
     initUnits,
-    oldInitUnits,
     unitState,
     getUnitName,
     explicitUnits,
@@ -127,12 +126,6 @@ initUnits unitDflags env = do
   pure $ hscSetFlags dflags1 $ hscSetUnitEnv unit_env env
 
 
--- | oldInitUnits only needs to modify DynFlags for GHC <9.2
--- For GHC >= 9.2, we need to set the hsc_unit_env also, that is
--- done later by initUnits
-oldInitUnits :: DynFlags -> IO DynFlags
-oldInitUnits = pure
-
 explicitUnits :: UnitState -> [Unit]
 explicitUnits ue =
   map fst $ State.explicitUnits ue

ghcide/src/Development/IDE/Types/HscEnvEq.hs

@@ -1,25 +1,18 @@
 module Development.IDE.Types.HscEnvEq
 (   HscEnvEq,
     hscEnv, newHscEnvEq,
-    hscEnvWithImportPaths,
-    newHscEnvEqPreserveImportPaths,
-    newHscEnvEqWithImportPaths,
     updateHscEnvEq,
-    envImportPaths,
     envPackageExports,
     envVisibleModuleNames,
-    deps
 ) where
 
 
 import           Control.Concurrent.Async        (Async, async, waitCatch)
 import           Control.Concurrent.Strict       (modifyVar, newVar)
-import           Control.DeepSeq                 (force)
+import           Control.DeepSeq                 (force, rwhnf)
 import           Control.Exception               (evaluate, mask, throwIO)
 import           Control.Monad.Extra             (eitherM, join, mapMaybeM)
 import           Data.Either                     (fromRight)
-import           Data.Set                        (Set)
-import qualified Data.Set                        as Set
 import           Data.Unique                     (Unique)
 import qualified Data.Unique                     as Unique
 import           Development.IDE.GHC.Compat      hiding (newUnique)
@@ -28,9 +21,7 @@ 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.FilePath
 
 -- | An 'HscEnv' with equality. Two values are considered equal
 --   if they are created with the same call to 'newHscEnvEq' or
@@ -38,13 +29,6 @@ import           System.FilePath
 data HscEnvEq = HscEnvEq
     { envUnique             :: !Unique
     , hscEnv                :: !HscEnv
-    , deps                  :: [(UnitId, DynFlags)]
-               -- ^ In memory components for this HscEnv
-               -- This is only used at the moment for the import dirs in
-               -- the DynFlags
-    , envImportPaths        :: Maybe (Set FilePath)
-        -- ^ If Just, import dirs originally configured in this env
-        --   If Nothing, the env import dirs are unaltered
     , envPackageExports     :: IO ExportsMap
     , envVisibleModuleNames :: IO (Maybe [ModuleName])
         -- ^ 'listVisibleModuleNames' is a pure function,
@@ -59,19 +43,8 @@ updateHscEnvEq oldHscEnvEq newHscEnv = do
   update <$> Unique.newUnique
 
 -- | Wrap an 'HscEnv' into an 'HscEnvEq'.
-newHscEnvEq :: FilePath -> FilePath -> HscEnv -> [(UnitId, DynFlags)] -> IO HscEnvEq
-newHscEnvEq root cradlePath hscEnv0 deps = do
-    let relativeToCradle = (takeDirectory cradlePath </>)
-        hscEnv = removeImportPaths hscEnv0
-
-    -- Make Absolute since targets are also absolute
-    let importPathsCanon = toAbsolute root . relativeToCradle <$> importPaths (hsc_dflags hscEnv0)
-
-    newHscEnvEqWithImportPaths (Just $ Set.fromList importPathsCanon) hscEnv deps
-
-newHscEnvEqWithImportPaths :: Maybe (Set FilePath) -> HscEnv -> [(UnitId, DynFlags)] -> IO HscEnvEq
-newHscEnvEqWithImportPaths envImportPaths hscEnv deps = do
-
+newHscEnvEq :: HscEnv -> IO HscEnvEq
+newHscEnvEq hscEnv = do
     let dflags = hsc_dflags hscEnv
 
     envUnique <- Unique.newUnique
@@ -112,23 +85,6 @@ newHscEnvEqWithImportPaths envImportPaths hscEnv deps = do
 
     return HscEnvEq{..}
 
--- | Wrap an 'HscEnv' into an 'HscEnvEq'.
-newHscEnvEqPreserveImportPaths
-    :: HscEnv -> [(UnitId, DynFlags)] -> IO HscEnvEq
-newHscEnvEqPreserveImportPaths = newHscEnvEqWithImportPaths Nothing
-
--- | Unwrap the 'HscEnv' with the original import paths.
---   Used only for locating imports
-hscEnvWithImportPaths :: HscEnvEq -> HscEnv
-hscEnvWithImportPaths HscEnvEq{..}
-    | Just imps <- envImportPaths
-    = hscSetFlags (setImportPaths (Set.toList imps) (hsc_dflags hscEnv)) hscEnv
-    | otherwise
-    = hscEnv
-
-removeImportPaths :: HscEnv -> HscEnv
-removeImportPaths hsc = hscSetFlags (setImportPaths [] (hsc_dflags hsc)) hsc
-
 instance Show HscEnvEq where
   show HscEnvEq{envUnique} = "HscEnvEq " ++ show (Unique.hashUnique envUnique)
 
@@ -136,9 +92,9 @@ instance Eq HscEnvEq where
   a == b = envUnique a == envUnique b
 
 instance NFData HscEnvEq where
-  rnf (HscEnvEq a b c d _ _) =
+  rnf (HscEnvEq a b _ _) =
       -- deliberately skip the package exports map and visible module names
-      rnf (Unique.hashUnique a) `seq` b `seq` c `seq` rnf d
+      rnf (Unique.hashUnique a) `seq` rwhnf b
 
 instance Hashable HscEnvEq where
   hashWithSalt s = hashWithSalt s . envUnique

plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs

@@ -38,7 +38,7 @@ import           Development.IDE                      (GetParsedModule (GetParse
                                                        Priority (Debug),
                                                        Recorder, WithPriority,
                                                        colon, evalGhcEnv,
-                                                       hscEnvWithImportPaths,
+                                                       hscEnv,
                                                        logWith,
                                                        realSrcSpanToRange,
                                                        rootDir, runAction,
@@ -140,7 +140,7 @@ pathModuleNames recorder state normFilePath filePath
   | firstLetter isLower $ takeFileName filePath = return ["Main"]
   | otherwise = do
       (session, _) <- runActionE "ModuleName.ghcSession" state $ useWithStaleE GhcSession normFilePath
-      srcPaths <- liftIO $ evalGhcEnv (hscEnvWithImportPaths session) $ importPaths <$> getSessionDynFlags
+      srcPaths <- liftIO $ evalGhcEnv (hscEnv session) $ importPaths <$> getSessionDynFlags
       logWith recorder Debug (SrcPaths srcPaths)
 
       -- Append a `pathSeparator` to make the path looks like a directory,

plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs

@@ -210,7 +210,7 @@ setupHscEnv ideState fp pm = do
     hscEnvEq <- runActionE "expandTHSplice.fallback.ghcSessionDeps" ideState $
                     useE GhcSessionDeps fp
     let ps = annotateParsedSource pm
-        hscEnv0 = hscEnvWithImportPaths hscEnvEq
+        hscEnv0 = hscEnv hscEnvEq
         modSum = pm_mod_summary pm
     hscEnv <- liftIO $ setupDynFlagsForGHCiLike hscEnv0 $ ms_hspp_opts modSum
     pure (ps, hscEnv, hsc_dflags hscEnv)