From eda42272e12a789fc1baa2a2720ef61b6f5089b6 Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 21 May 2024 22:38:40 +0800 Subject: [PATCH] cleanup --- .../session-loader/Development/IDE/Session.hs | 45 ++++++++++++------- ghcide/src/Development/IDE/Core/RuleTypes.hs | 5 +++ 2 files changed, 33 insertions(+), 17 deletions(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index fccbab6688..05529021c1 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -61,7 +61,7 @@ import qualified Development.IDE.GHC.Compat.Core as GHC import Development.IDE.GHC.Compat.Env hiding (Logger) import Development.IDE.GHC.Compat.Units (UnitId) import Development.IDE.GHC.Util -import Development.IDE.Graph (Action) +import Development.IDE.Graph (Action, alwaysRerun) import qualified Development.IDE.Session.Implicit as GhcIde import Development.IDE.Session.VersionCheck import Development.IDE.Types.Diagnostics @@ -134,6 +134,7 @@ import GHC.Unit.State import Language.LSP.Protocol.Types (NormalizedUri (NormalizedUri), toNormalizedFilePath) #endif +import Development.IDE (RuleResult) import qualified Development.IDE.Core.Shake as SHake data Log @@ -448,6 +449,9 @@ getHieDbLoc dir = do loadSession :: Recorder (WithPriority Log) -> FilePath -> IO (Rules (), Action IdeGhcSession) loadSession recorder = loadSessionWithOptions recorder def +type instance RuleResult HieYaml = (HashMap + NormalizedFilePath (IdeResult HscEnvEq, DependencyInfo)) + loadSessionWithOptions :: Recorder (WithPriority Log) -> SessionLoadingOptions -> FilePath -> IO (Rules (), Action IdeGhcSession) loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir = do let toAbsolutePath = toAbsolute rootDir @@ -461,6 +465,12 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir = do -- they are inconsistent. So, everywhere you modify 'fileToFlags', -- you have to modify 'filesMap' as well. filesMap <- newVar HM.empty :: IO (Var FilesMap) + + let clearCache = do + modifyVar_ hscEnvs $ \_ -> pure Map.empty + modifyVar_ fileToFlags $ \_ -> pure Map.empty + modifyVar_ filesMap $ \_ -> pure HM.empty + -- Version of the mappings above version <- newVar 0 cradleLock <- newMVar () @@ -468,6 +478,12 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir = do biosSessionLoadingVar <- newVar Nothing :: IO (Var (Maybe SessionLoadingPreferenceConfig)) let returnWithVersion fun = IdeGhcSession fun <$> liftIO (readVar version) + let hieYamlRule :: Rules () + hieYamlRule = defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \HieYaml hieYaml -> do + alwaysRerun + v <- Map.findWithDefault HM.empty (Just $ fromNormalizedFilePath hieYaml) <$> (liftIO $ readVar fileToFlags) + return $ Just v + let cradleLocRule :: Rules () cradleLocRule = defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \CradleLoc file -> do res <- liftIO $ HieBios.findCradle $ fromNormalizedFilePath file @@ -477,19 +493,21 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir = do -- todo make it absolute return $ Just (normalise . toAbsolutePath <$> res) - return $ (cradleLocRule, do - clientConfig <- getClientConfigAction - extras@ShakeExtras{restartShakeSession, ideNc, knownTargetsVar, lspEnv - } <- getShakeExtras - let invalidateShakeCache = do + let invalidateShakeCache = do void $ modifyVar' version succ return $ toNoFileKey GhcSessionIO + return $ (cradleLocRule <> hieYamlRule, do + clientConfig <- getClientConfigAction + ShakeExtras{restartShakeSession, ideNc, knownTargetsVar, lspEnv + } <- getShakeExtras + IdeOptions{ optTesting = IdeTesting optTesting , optCheckProject = getCheckProject , optExtensions } <- getIdeOptions + -- relatively stand alone -- populate the knownTargetsVar with all the -- files in the project so that `knownFiles` can learn about them and -- we can generate a complete module graph @@ -722,28 +740,21 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir = do let hieYaml = fromMaybe cachedHieYamlLocation (Just hieYamlOld) -- this cased a recompilation of the whole project -- this can be turned in to shake - liftIO$Extra.whenM didSessionLoadingPreferenceConfigChange $ do + liftIO $ Extra.whenM didSessionLoadingPreferenceConfigChange $ do logWith recorder Info LogSessionLoadingChanged -- If the dependencies are out of date then clear both caches and start -- again. - liftIO$ modifyVar_ fileToFlags (const (return Map.empty)) - liftIO$modifyVar_ filesMap (const (return HM.empty)) - -- Don't even keep the name cache, we start from scratch here! - liftIO$modifyVar_ hscEnvs (const (return Map.empty)) - + clearCache -- fileToFlags is caching v <- Map.findWithDefault HM.empty hieYaml <$> (liftIO$readVar fileToFlags) case HM.lookup file v of Just (opts, old_di) -> do - deps_ok <- liftIO$checkDependencyInfo old_di + deps_ok <- liftIO $ checkDependencyInfo old_di if not deps_ok then do -- If the dependencies are out of date then clear both caches and start -- again. - liftIO$modifyVar_ fileToFlags (const (return Map.empty)) - liftIO$modifyVar_ filesMap (const (return HM.empty)) - -- Keep the same name cache - liftIO$modifyVar_ hscEnvs (return . Map.adjust (const []) hieYaml ) + liftIO $ clearCache consultCradle file else return (opts, Map.keys old_di) Nothing -> consultCradle file diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index 68664facd2..8790e6ae29 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs @@ -497,6 +497,11 @@ instance Hashable CradleLoc instance NFData CradleLoc type instance RuleResult CradleLoc = Maybe FilePath +data HieYaml = HieYaml deriving (Eq, Show, Typeable, Generic) +instance Hashable HieYaml +instance NFData HieYaml + + -- A local rule type to get caching. We want to use newCache, but it has -- thread killed exception issues, so we lift it to a full rule. -- https://github.com/digital-asset/daml/pull/2808#issuecomment-529639547