@@ -54,7 +54,7 @@ import DynFlags (gopt_set, gopt_unset,
5454 updOptLevel )
5555import DynFlags (PackageFlag (.. ), PackageArg (.. ))
5656import GHC hiding (def )
57- import GHC.Check (runTimeVersion , compileTimeVersionFromLibdir )
57+ import GHC.Check ( VersionCheck ( .. ), makeGhcVersionChecker )
5858-- import GhcMonad
5959import HIE.Bios.Cradle
6060import HIE.Bios.Environment (addCmdOpts , makeDynFlagsAbsolute )
@@ -267,12 +267,12 @@ cradleToSessionOpts cradle file = do
267267 CradleNone -> fail " 'none' cradle is not yet supported"
268268 pure opts
269269
270- emptyHscEnv :: IO HscEnv
271- emptyHscEnv = do
270+ emptyHscEnv :: IORef NameCache -> IO HscEnv
271+ emptyHscEnv nc = do
272272 libdir <- getLibdir
273273 env <- runGhc (Just libdir) getSession
274274 initDynLinker env
275- pure env
275+ pure $ setNameCache nc env
276276
277277-- Convert a target to a list of potential absolute paths.
278278-- A TargetModule can be anywhere listed by the supplied include
@@ -295,7 +295,9 @@ setNameCache nc hsc = hsc { hsc_NC = nc }
295295-- components mapping to the same hie,yaml file are mapped to the same
296296-- HscEnv which is updated as new components are discovered.
297297loadSession :: FilePath -> Action (FilePath -> Action HscEnvEq )
298- loadSession dir = liftIO $ do
298+ loadSession dir = do
299+ nc <- ideNc <$> getShakeExtras
300+ liftIO $ do
299301 -- Mapping from hie.yaml file to HscEnv, one per hie.yaml file
300302 hscEnvs <- newVar Map. empty
301303 -- Mapping from a filepath to HscEnv
@@ -316,7 +318,7 @@ loadSession dir = liftIO $ do
316318 -- which contains both.
317319 packageSetup <- return $ \ (hieYaml, cfp, opts) -> do
318320 -- Parse DynFlags for the newly discovered component
319- hscEnv <- emptyHscEnv
321+ hscEnv <- emptyHscEnv nc
320322 (df, targets) <- evalGhcEnv hscEnv $ do
321323 setOptions opts (hsc_dflags hscEnv)
322324 dep_info <- getDependencyInfo (componentDependencies opts)
@@ -347,21 +349,19 @@ loadSession dir = liftIO $ do
347349 -- It's important to keep the same NameCache though for reasons
348350 -- that I do not fully understand
349351 print (" Making new HscEnv" ++ (show inplace))
350- hscEnv <- case oldDeps of
351- Nothing -> emptyHscEnv
352- Just (old_hsc, _) -> setNameCache (hsc_NC old_hsc) <$> emptyHscEnv
352+ hscEnv <- emptyHscEnv nc
353353 newHscEnv <-
354354 -- Add the options for the current component to the HscEnv
355355 evalGhcEnv hscEnv $ do
356356 _ <- setSessionDynFlags df
357357 getSession
358358 -- Modify the map so the hieYaml now maps to the newly created
359359 -- HscEnv
360- -- Returns:
361- -- * The new HscEnv so it can be used to modify the
360+ -- Returns
361+ -- * the new HscEnv so it can be used to modify the
362362 -- FilePath -> HscEnv map
363- -- * The information for the new component which caused this cache miss
364- -- * The modified information (without -inplace flags) for
363+ -- * The information for the new component which caused this cache miss
364+ -- * The modified information (without -inplace flags) for
365365 -- existing packages
366366 pure (Map. insert hieYaml (newHscEnv, new_deps) m, (newHscEnv, head new_deps', tail new_deps'))
367367
@@ -382,7 +382,7 @@ loadSession dir = liftIO $ do
382382 let hscEnv' = hscEnv { hsc_dflags = df
383383 , hsc_IC = (hsc_IC hscEnv) { ic_dflags = df } }
384384
385- versionMismatch <- evalGhcEnv hscEnv' checkGhcVersion
385+ versionMismatch <- checkGhcVersion
386386 henv <- case versionMismatch of
387387 Just mismatch -> return mismatch
388388 Nothing -> newHscEnvEq hscEnv' uids
@@ -590,12 +590,17 @@ getCacheDir opts = IO.getXdgDirectory IO.XdgCache (cacheDir </> opts_hash)
590590cacheDir :: String
591591cacheDir = " ghcide"
592592
593- compileTimeGhcVersion :: Version
594- compileTimeGhcVersion = $$ (compileTimeVersionFromLibdir getLibdir)
593+ ghcVersionChecker :: IO VersionCheck
594+ ghcVersionChecker = $$ (makeGhcVersionChecker ( pure <$> getLibdir) )
595595
596- checkGhcVersion :: Ghc (Maybe HscEnvEq )
596+ checkGhcVersion :: IO Maybe HscEnvEq )
597597checkGhcVersion = do
598- v <- runTimeVersion
599- return $ if v == Just compileTimeGhcVersion
600- then Nothing
601- else Just GhcVersionMismatch {compileTime = compileTimeGhcVersion, runTime = v}
598+ res <- ghcVersionChecker
599+ case res of
600+ Failure err -> do
601+ putStrLn $ " Error while checking GHC version: " ++ show err
602+ return Nothing
603+ Mismatch {.. } ->
604+ return $ Just GhcVersionMismatch {.. }
605+ _ ->
606+ return Nothing
0 commit comments