Skip to content

Commit d3b9153

Browse files
committed
session-loader: override old units with new in multi-unit support
1 parent 2158ae4 commit d3b9153

File tree

1 file changed

+14
-13
lines changed

1 file changed

+14
-13
lines changed

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

Lines changed: 14 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -574,8 +574,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
574574
let new_cache = newComponentCache recorder optExtensions hieYaml _cfp hscEnv
575575
all_target_details <- new_cache old_deps new_deps
576576

577-
let new_envs = take (L.length new_deps) all_target_details
578-
all_targets = concatMap fst all_target_details
577+
let all_targets = concatMap fst all_target_details
579578

580579
let this_flags_map = HM.fromList (concatMap toFlagsMap all_targets)
581580

@@ -594,8 +593,8 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
594593

595594
-- Typecheck all files in the project on startup
596595
checkProject <- getCheckProject
597-
unless (null new_envs || not checkProject) $ do
598-
cfps' <- liftIO $ filterM (IO.doesFileExist . fromNormalizedFilePath) (concatMap (concatMap targetLocations) $ fmap fst new_envs)
596+
unless (null new_deps || not checkProject) $ do
597+
cfps' <- liftIO $ filterM (IO.doesFileExist . fromNormalizedFilePath) (concatMap targetLocations all_targets)
599598
void $ shakeEnqueue extras $ mkDelayedAction "InitialLoad" Debug $ void $ do
600599
mmt <- uses GetModificationTime cfps'
601600
let cs_exist = catMaybes (zipWith (<$) cfps' mmt)
@@ -796,24 +795,26 @@ newComponentCache
796795
-> [ComponentInfo]
797796
-> IO [ ([TargetDetails], (IdeResult HscEnvEq, DependencyInfo))]
798797
newComponentCache recorder exts cradlePath cfp hsc_env old_cis new_cis = do
799-
let cis = old_cis ++ new_cis
800-
let uids = map (\ci -> (componentUnitId ci, componentDynFlags ci)) cis
801-
pprTraceM "newComponentCache" $ Compat.ppr (map fst uids)
798+
let cis = Map.union (mkMap new_cis) (mkMap old_cis) -- Left biased so prefer new components over old ones
799+
mkMap = Map.fromList . map (\ci -> (componentUnitId ci, ci))
800+
let dfs = map componentDynFlags $ Map.elems cis
801+
uids = Map.keys cis
802+
pprTraceM "newComponentCache" $ Compat.ppr uids
802803
hscEnv' <- -- Set up a multi component session with the other units on GHC 9.4
803-
Compat.initUnits (map snd uids) hsc_env
804+
Compat.initUnits dfs hsc_env
804805

805806
#if MIN_VERSION_ghc(9,3,0)
806807
let closure_errs = checkHomeUnitsClosed (hsc_unit_env hscEnv') (hsc_all_home_unit_ids hscEnv') pkg_deps
807808
pkg_deps = do
808-
home_unit_id <- map fst uids
809+
home_unit_id <- uids
809810
home_unit_env <- maybeToList $ unitEnv_lookup_maybe home_unit_id $ hsc_HUG hscEnv'
810811
map (home_unit_id,) (map (Compat.toUnitId . fst) $ explicitUnits $ homeUnitEnv_units home_unit_env)
811812

812813
case closure_errs of
813814
errs@(_:_) -> do
814-
let rendered = map (ideErrorWithSource (Just "cradle") (Just DsError) cfp . T.pack . Compat.printWithoutUniques . (, hsc_all_home_unit_ids hscEnv', pprHomeUnitGraph $ ue_home_unit_graph $ hsc_unit_env hscEnv', pkg_deps)) errs
815+
let rendered = map (ideErrorWithSource (Just "cradle") (Just DsError) cfp . T.pack . Compat.printWithoutUniques) errs
815816
res = (rendered,Nothing)
816-
dep_info = foldMap componentDependencyInfo (filter isBad cis)
817+
dep_info = foldMap componentDependencyInfo (filter isBad $ Map.elems cis)
817818
bad_units = OS.fromList $ concat $ do
818819
x <- bagToList $ mapBag errMsgDiagnostic $ unionManyBags $ map Compat.getMessages errs
819820
DriverHomePackagesNotClosed us <- pure x
@@ -838,7 +839,7 @@ newComponentCache recorder exts cradlePath cfp hsc_env old_cis new_cis = do
838839
case res of
839840
Nothing -> pure ()
840841

841-
fmap (addSpecial cfp) $ forM cis $ \ci -> do
842+
fmap (addSpecial cfp) $ forM (Map.elems cis) $ \ci -> do
842843
let df = componentDynFlags ci
843844
let newFunc = maybe newHscEnvEqPreserveImportPaths newHscEnvEq cradlePath
844845
thisEnv <- do
@@ -862,7 +863,7 @@ newComponentCache recorder exts cradlePath cfp hsc_env old_cis new_cis = do
862863
-- getOptions is enough to initialize units on GHC <9.2
863864
pure $ hscSetFlags df hsc_env { hsc_IC = (hsc_IC hsc_env) { ic_dflags = df } }
864865
#endif
865-
henv <- newFunc thisEnv uids
866+
henv <- newFunc thisEnv (zip uids dfs)
866867
let targetEnv = ([], Just henv)
867868
targetDepends = componentDependencyInfo ci
868869
res = ( targetEnv, targetDepends)

0 commit comments

Comments
 (0)