From 58b8b687ad578f1ee305ae0e549a6198928582e3 Mon Sep 17 00:00:00 2001 From: Patrick Date: Sat, 2 Nov 2024 09:44:33 +0800 Subject: [PATCH 01/12] Refactor session loading to manage pending files so we can batch load them to improve performance fix #4381 --- .../session-loader/Development/IDE/Session.hs | 55 +++++++++++-------- 1 file changed, 33 insertions(+), 22 deletions(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index a1d778ab0e..dab01c982f 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -424,7 +424,7 @@ getHieDbLoc dir = do loadSessionWithOptions :: Recorder (WithPriority Log) -> SessionLoadingOptions -> FilePath -> TQueue (IO ()) -> IO (Action IdeGhcSession) loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do let toAbsolutePath = toAbsolute rootDir -- see Note [Root Directory] - cradle_files <- newIORef [] + cradle_files <- newIORef (Set.fromList []) -- Mapping from hie.yaml file to HscEnv, one per hie.yaml file hscEnvs <- newVar Map.empty :: IO (Var HieMap) -- Mapping from a Filepath to HscEnv @@ -434,6 +434,8 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do -- they are inconsistent. So, everywhere you modify 'fileToFlags', -- you have to modify 'filesMap' as well. filesMap <- newVar HM.empty :: IO (Var FilesMap) + pendingFilesTQueue <- newTQueueIO + -- Pending files waiting to be loaded -- Version of the mappings above version <- newVar 0 biosSessionLoadingVar <- newVar Nothing :: IO (Var (Maybe SessionLoadingPreferenceConfig)) @@ -550,7 +552,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do let session :: (Maybe FilePath, NormalizedFilePath, ComponentOptions, FilePath) - -> IO (IdeResult HscEnvEq,[FilePath]) + -> IO ((IdeResult HscEnvEq,[FilePath]), HashSet FilePath) session args@(hieYaml, _cfp, _opts, _libDir) = do (new_deps, old_deps) <- packageSetup args @@ -562,13 +564,15 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do let new_cache = newComponentCache recorder optExtensions _cfp hscEnv all_target_details <- new_cache old_deps new_deps + let flags_map' = HM.fromList (concatMap toFlagsMap all_targets') + all_targets' = concat all_target_details + newLoaded = HM.keys flags_map' this_dep_info <- getDependencyInfo $ maybeToList hieYaml let (all_targets, this_flags_map, this_options) = case HM.lookup _cfp flags_map' of Just this -> (all_targets', flags_map', this) Nothing -> (this_target_details : all_targets', HM.insert _cfp this_flags flags_map', this_flags) - where all_targets' = concat all_target_details - flags_map' = HM.fromList (concatMap toFlagsMap all_targets') + where this_target_details = TargetDetails (TargetFile _cfp) this_error_env this_dep_info [_cfp] this_flags = (this_error_env, this_dep_info) this_error_env = ([this_error], Nothing) @@ -580,27 +584,27 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do void $ modifyVar' fileToFlags $ Map.insert hieYaml this_flags_map void $ modifyVar' filesMap $ flip HM.union (HM.fromList (map ((,hieYaml) . fst) $ concatMap toFlagsMap all_targets)) + -- Typecheck all files in the project on startup + checkProject <- getCheckProject -- The VFS doesn't change on cradle edits, re-use the old one. -- Invalidate all the existing GhcSession build nodes by restarting the Shake session - keys2 <- invalidateShakeCache restartShakeSession VFSUnmodified "new component" [] $ do + keys2 <- invalidateShakeCache keys1 <- extendKnownTargets all_targets + unless (null new_deps || not checkProject) $ do + cfps' <- liftIO $ filterM (IO.doesFileExist . fromNormalizedFilePath) (concatMap targetLocations all_targets) + void $ shakeEnqueue extras $ mkDelayedAction "InitialLoad" Debug $ void $ do + mmt <- uses GetModificationTime cfps' + let cs_exist = catMaybes (zipWith (<$) cfps' mmt) + modIfaces <- uses GetModIface cs_exist + -- update exports map + shakeExtras <- getShakeExtras + let !exportsMap' = createExportsMap $ mapMaybe (fmap hirModIface) modIfaces + liftIO $ atomically $ modifyTVar' (exportsMap shakeExtras) (exportsMap' <>) return [keys1, keys2] - -- Typecheck all files in the project on startup - checkProject <- getCheckProject - unless (null new_deps || not checkProject) $ do - cfps' <- liftIO $ filterM (IO.doesFileExist . fromNormalizedFilePath) (concatMap targetLocations all_targets) - void $ shakeEnqueue extras $ mkDelayedAction "InitialLoad" Debug $ void $ do - mmt <- uses GetModificationTime cfps' - let cs_exist = catMaybes (zipWith (<$) cfps' mmt) - modIfaces <- uses GetModIface cs_exist - -- update exports map - shakeExtras <- getShakeExtras - let !exportsMap' = createExportsMap $ mapMaybe (fmap hirModIface) modIfaces - liftIO $ atomically $ modifyTVar' (exportsMap shakeExtras) (exportsMap' <>) - - return $ second Map.keys this_options + + return $ (second Map.keys this_options, Set.fromList $ fromNormalizedFilePath <$> newLoaded) let consultCradle :: Maybe FilePath -> FilePath -> IO (IdeResult HscEnvEq, [FilePath]) consultCradle hieYaml cfp = do @@ -615,11 +619,13 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do -- Display a user friendly progress message here: They probably don't know what a cradle is let progMsg = "Setting up " <> T.pack (takeBaseName (cradleRootDir cradle)) <> " (for " <> T.pack lfpLog <> ")" + + pendingFiles <- Set.fromList <$> (atomically $ flushTQueue pendingFilesTQueue) eopts <- mRunLspTCallback lspEnv (\act -> withIndefiniteProgress progMsg Nothing NotCancellable (const act)) $ withTrace "Load cradle" $ \addTag -> do addTag "file" lfpLog old_files <- readIORef cradle_files - res <- cradleToOptsAndLibDir recorder (sessionLoading clientConfig) cradle cfp old_files + res <- cradleToOptsAndLibDir recorder (sessionLoading clientConfig) cradle cfp (Set.toList $ pendingFiles <> old_files) addTag "result" (show res) return res @@ -633,8 +639,12 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do [] -> error $ "GHC version could not be parsed: " <> version ((runTime, _):_) | compileTime == runTime -> do - atomicModifyIORef' cradle_files (\xs -> (cfp:xs,())) - session (hieYaml, toNormalizedFilePath' cfp, opts, libDir) + (results, newLoaded) <- session (hieYaml, toNormalizedFilePath' cfp, opts, libDir) + -- put back to pending que if not listed in the results + let remainPendingFiles = Set.delete cfp $ pendingFiles `Set.difference` newLoaded + atomically $ forM_ remainPendingFiles (writeTQueue pendingFilesTQueue) + atomicModifyIORef' cradle_files (\xs -> (pendingFiles `Set.intersection` newLoaded <> xs,())) + return results | otherwise -> return (([renderPackageSetupException cfp GhcVersionMismatch{..}], Nothing),[]) -- Failure case, either a cradle error or the none cradle Left err -> do @@ -708,6 +718,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do return (([renderPackageSetupException file e], Nothing), maybe [] pure hieYaml) returnWithVersion $ \file -> do + atomically $ writeTQueue pendingFilesTQueue $ toAbsolutePath file -- see Note [Serializing runs in separate thread] awaitRunInThread que $ getOptions file From ea002d7ef8f2c8be8663e2689bced7e67b8884ac Mon Sep 17 00:00:00 2001 From: Patrick Date: Sun, 3 Nov 2024 15:28:16 +0800 Subject: [PATCH 02/12] distribute errors to all pending files are being loading --- .../session-loader/Development/IDE/Session.hs | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index dab01c982f..8683b5ada1 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -425,6 +425,7 @@ loadSessionWithOptions :: Recorder (WithPriority Log) -> SessionLoadingOptions - loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do let toAbsolutePath = toAbsolute rootDir -- see Note [Root Directory] cradle_files <- newIORef (Set.fromList []) +-- error_loading_files <- newIORef (Set.fromList []) -- Mapping from hie.yaml file to HscEnv, one per hie.yaml file hscEnvs <- newVar Map.empty :: IO (Var HieMap) -- Mapping from a Filepath to HscEnv @@ -606,6 +607,15 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do return $ (second Map.keys this_options, Set.fromList $ fromNormalizedFilePath <$> newLoaded) + let makeError hieYaml cradle err cfp = do + dep_info <- getDependencyInfo (maybeToList hieYaml) + let ncfp = toNormalizedFilePath' cfp + let res = (map (\err' -> renderCradleError err' cradle ncfp) err, Nothing) + void $ modifyVar' fileToFlags $ + Map.insertWith HM.union hieYaml (HM.singleton ncfp (res, dep_info)) + void $ modifyVar' filesMap $ HM.insert ncfp hieYaml + return (fst res) + let consultCradle :: Maybe FilePath -> FilePath -> IO (IdeResult HscEnvEq, [FilePath]) consultCradle hieYaml cfp = do let lfpLog = makeRelative rootDir cfp @@ -648,13 +658,8 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do | otherwise -> return (([renderPackageSetupException cfp GhcVersionMismatch{..}], Nothing),[]) -- Failure case, either a cradle error or the none cradle Left err -> do - dep_info <- getDependencyInfo (maybeToList hieYaml) - let ncfp = toNormalizedFilePath' cfp - let res = (map (\err' -> renderCradleError err' cradle ncfp) err, Nothing) - void $ modifyVar' fileToFlags $ - Map.insertWith HM.union hieYaml (HM.singleton ncfp (res, dep_info)) - void $ modifyVar' filesMap $ HM.insert ncfp hieYaml - return (res, maybe [] pure hieYaml ++ concatMap cradleErrorDependencies err) + errors <- mapM (makeError hieYaml cradle err) $ Set.toList pendingFiles + return ((concat errors, Nothing), maybe [] pure hieYaml ++ concatMap cradleErrorDependencies err) let -- | We allow users to specify a loading strategy. From c78b197000c093e76f5277b7814b81ec32a85564 Mon Sep 17 00:00:00 2001 From: Patrick Date: Sun, 3 Nov 2024 16:15:57 +0800 Subject: [PATCH 03/12] better filter loading files --- cabal.project | 6 ++++++ ghcide/session-loader/Development/IDE/Session.hs | 5 ++++- .../session-loader/Development/IDE/Session/Diagnostics.hs | 2 +- 3 files changed, 11 insertions(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index 08d743c24e..3cae5e5181 100644 --- a/cabal.project +++ b/cabal.project @@ -6,6 +6,7 @@ packages: ./ghcide ./hls-plugin-api ./hls-test-utils +-- ../hiebios index-state: 2024-10-21T00:00:00Z @@ -46,3 +47,8 @@ constraints: if impl(ghc >= 9.9) -- https://github.com/haskell/haskell-language-server/issues/4324 benchmarks: False + +source-repository-package + type: git + location: https://github.com/soulomoon/hie-bios.git + tag: 7dd19b547ba30b760053b5f796c439cba6ac6a07 diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 8683b5ada1..a4e8678d43 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -658,7 +658,10 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do | otherwise -> return (([renderPackageSetupException cfp GhcVersionMismatch{..}], Nothing),[]) -- Failure case, either a cradle error or the none cradle Left err -> do - errors <- mapM (makeError hieYaml cradle err) $ Set.toList pendingFiles + let failedLoadingFiles = nub $ cfp:concatMap cradleErrorLoadingFiles err + let remainPendingFiles = Set.delete cfp $ pendingFiles `Set.difference` Set.fromList failedLoadingFiles + atomically $ forM_ remainPendingFiles (writeTQueue pendingFilesTQueue) + errors <- mapM (makeError hieYaml cradle err) $ failedLoadingFiles return ((concat errors, Nothing), maybe [] pure hieYaml ++ concatMap cradleErrorDependencies err) let diff --git a/ghcide/session-loader/Development/IDE/Session/Diagnostics.hs b/ghcide/session-loader/Development/IDE/Session/Diagnostics.hs index a8e35e5965..ac18ff2025 100644 --- a/ghcide/session-loader/Development/IDE/Session/Diagnostics.hs +++ b/ghcide/session-loader/Development/IDE/Session/Diagnostics.hs @@ -27,7 +27,7 @@ data CradleErrorDetails = Depicts the cradle error in a user-friendly way. -} renderCradleError :: CradleError -> Cradle a -> NormalizedFilePath -> FileDiagnostic -renderCradleError (CradleError deps _ec ms) cradle nfp +renderCradleError (CradleError deps _ec ms _fps) cradle nfp | HieBios.isCabalCradle cradle = let (fp, showDiag, diag) = ideErrorWithSource (Just "cradle") (Just DiagnosticSeverity_Error) nfp $ T.unlines $ map T.pack userFriendlyMessage in (fp, showDiag, diag{_data_ = Just $ Aeson.toJSON CradleErrorDetails{cabalProjectFiles=absDeps}}) From b87937580e8239024b58d3013cb12f38ec50d0d8 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 4 Nov 2024 21:20:25 +0800 Subject: [PATCH 04/12] fallback to non-batch load --- cabal.project | 6 -- .../session-loader/Development/IDE/Session.hs | 64 ++++++++++++------- .../Development/IDE/Session/Diagnostics.hs | 2 +- 3 files changed, 43 insertions(+), 29 deletions(-) diff --git a/cabal.project b/cabal.project index 3cae5e5181..08d743c24e 100644 --- a/cabal.project +++ b/cabal.project @@ -6,7 +6,6 @@ packages: ./ghcide ./hls-plugin-api ./hls-test-utils --- ../hiebios index-state: 2024-10-21T00:00:00Z @@ -47,8 +46,3 @@ constraints: if impl(ghc >= 9.9) -- https://github.com/haskell/haskell-language-server/issues/4324 benchmarks: False - -source-repository-package - type: git - location: https://github.com/soulomoon/hie-bios.git - tag: 7dd19b547ba30b760053b5f796c439cba6ac6a07 diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index a4e8678d43..1dc4135923 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -146,10 +146,13 @@ data Log | LogNewComponentCache !(([FileDiagnostic], Maybe HscEnvEq), DependencyInfo) | LogHieBios HieBios.Log | LogSessionLoadingChanged + | LogSessionNewLoadedFiles ![FilePath] deriving instance Show Log instance Pretty Log where pretty = \case + LogSessionNewLoadedFiles files -> + "New loaded files:" <+> pretty files LogNoneCradleFound path -> "None cradle found for" <+> pretty path <+> ", ignoring the file" LogSettingInitialDynFlags -> @@ -425,7 +428,7 @@ loadSessionWithOptions :: Recorder (WithPriority Log) -> SessionLoadingOptions - loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do let toAbsolutePath = toAbsolute rootDir -- see Note [Root Directory] cradle_files <- newIORef (Set.fromList []) --- error_loading_files <- newIORef (Set.fromList []) + error_loading_files <- newIORef (Set.fromList []) -- Mapping from hie.yaml file to HscEnv, one per hie.yaml file hscEnvs <- newVar Map.empty :: IO (Var HieMap) -- Mapping from a Filepath to HscEnv @@ -603,19 +606,8 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do let !exportsMap' = createExportsMap $ mapMaybe (fmap hirModIface) modIfaces liftIO $ atomically $ modifyTVar' (exportsMap shakeExtras) (exportsMap' <>) return [keys1, keys2] - - return $ (second Map.keys this_options, Set.fromList $ fromNormalizedFilePath <$> newLoaded) - let makeError hieYaml cradle err cfp = do - dep_info <- getDependencyInfo (maybeToList hieYaml) - let ncfp = toNormalizedFilePath' cfp - let res = (map (\err' -> renderCradleError err' cradle ncfp) err, Nothing) - void $ modifyVar' fileToFlags $ - Map.insertWith HM.union hieYaml (HM.singleton ncfp (res, dep_info)) - void $ modifyVar' filesMap $ HM.insert ncfp hieYaml - return (fst res) - let consultCradle :: Maybe FilePath -> FilePath -> IO (IdeResult HscEnvEq, [FilePath]) consultCradle hieYaml cfp = do let lfpLog = makeRelative rootDir cfp @@ -630,12 +622,19 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do let progMsg = "Setting up " <> T.pack (takeBaseName (cradleRootDir cradle)) <> " (for " <> T.pack lfpLog <> ")" - pendingFiles <- Set.fromList <$> (atomically $ flushTQueue pendingFilesTQueue) + pendingFiles' <- Set.fromList <$> (atomically $ flushTQueue pendingFilesTQueue) + -- remove the file from error loading files + errorFiles <- readIORef error_loading_files + -- remove error files from pending files since error loading need to load one by one + let pendingFiles = pendingFiles' `Set.difference` errorFiles + -- if the file is in error loading files, we fall back to single loading mode + let toLoads = if cfp `Set.member` errorFiles then Set.empty else pendingFiles + eopts <- mRunLspTCallback lspEnv (\act -> withIndefiniteProgress progMsg Nothing NotCancellable (const act)) $ withTrace "Load cradle" $ \addTag -> do addTag "file" lfpLog old_files <- readIORef cradle_files - res <- cradleToOptsAndLibDir recorder (sessionLoading clientConfig) cradle cfp (Set.toList $ pendingFiles <> old_files) + res <- cradleToOptsAndLibDir recorder (sessionLoading clientConfig) cradle cfp (Set.toList $ Set.delete cfp $ toLoads <> old_files) addTag "result" (show res) return res @@ -649,20 +648,37 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do [] -> error $ "GHC version could not be parsed: " <> version ((runTime, _):_) | compileTime == runTime -> do - (results, newLoaded) <- session (hieYaml, toNormalizedFilePath' cfp, opts, libDir) + (results, allNewLoaded) <- session (hieYaml, toNormalizedFilePath' cfp, opts, libDir) -- put back to pending que if not listed in the results - let remainPendingFiles = Set.delete cfp $ pendingFiles `Set.difference` newLoaded + -- delete cfp even if ew report No cradle target found for cfp + let remainPendingFiles = Set.delete cfp $ pendingFiles `Set.difference` allNewLoaded + let newLoadedT = pendingFiles `Set.intersection` allNewLoaded atomically $ forM_ remainPendingFiles (writeTQueue pendingFilesTQueue) - atomicModifyIORef' cradle_files (\xs -> (pendingFiles `Set.intersection` newLoaded <> xs,())) + -- log new loaded files + logWith recorder Info $ LogSessionNewLoadedFiles $ Set.toList newLoadedT + atomicModifyIORef' cradle_files (\xs -> (newLoadedT <> xs,())) + atomicModifyIORef' error_loading_files (\old -> (old `Set.difference` newLoadedT, ())) return results | otherwise -> return (([renderPackageSetupException cfp GhcVersionMismatch{..}], Nothing),[]) -- Failure case, either a cradle error or the none cradle Left err -> do - let failedLoadingFiles = nub $ cfp:concatMap cradleErrorLoadingFiles err - let remainPendingFiles = Set.delete cfp $ pendingFiles `Set.difference` Set.fromList failedLoadingFiles - atomically $ forM_ remainPendingFiles (writeTQueue pendingFilesTQueue) - errors <- mapM (makeError hieYaml cradle err) $ failedLoadingFiles - return ((concat errors, Nothing), maybe [] pure hieYaml ++ concatMap cradleErrorDependencies err) + if (length toLoads > 1) + then do + succLoaded_files <- readIORef cradle_files + -- mark as less loaded files as failedLoadingFiles possible + let failedLoadingFiles = (Set.insert cfp toLoads) `Set.difference` succLoaded_files + atomicModifyIORef' error_loading_files (\xs -> (failedLoadingFiles <> xs,())) + -- retry without other files + atomically $ forM_ pendingFiles (writeTQueue pendingFilesTQueue) + consultCradle hieYaml cfp + else do + dep_info <- getDependencyInfo (maybeToList hieYaml) + let ncfp = toNormalizedFilePath' cfp + let res = (map (\err' -> renderCradleError err' cradle ncfp) err, Nothing) + void $ modifyVar' fileToFlags $ + Map.insertWith HM.union hieYaml (HM.singleton ncfp (res, dep_info)) + void $ modifyVar' filesMap $ HM.insert ncfp hieYaml + return (res, maybe [] pure hieYaml ++ concatMap cradleErrorDependencies err) let -- | We allow users to specify a loading strategy. @@ -703,6 +719,10 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do deps_ok <- checkDependencyInfo old_di if not deps_ok then do + -- todo invoke the action to recompile the file + -- if deps are old, we can try to load the error files again + atomicModifyIORef' error_loading_files (\xs -> (Set.delete file xs,())) + atomicModifyIORef' cradle_files (\xs -> (Set.delete file xs,())) -- If the dependencies are out of date then clear both caches and start -- again. modifyVar_ fileToFlags (const (return Map.empty)) diff --git a/ghcide/session-loader/Development/IDE/Session/Diagnostics.hs b/ghcide/session-loader/Development/IDE/Session/Diagnostics.hs index ac18ff2025..a8e35e5965 100644 --- a/ghcide/session-loader/Development/IDE/Session/Diagnostics.hs +++ b/ghcide/session-loader/Development/IDE/Session/Diagnostics.hs @@ -27,7 +27,7 @@ data CradleErrorDetails = Depicts the cradle error in a user-friendly way. -} renderCradleError :: CradleError -> Cradle a -> NormalizedFilePath -> FileDiagnostic -renderCradleError (CradleError deps _ec ms _fps) cradle nfp +renderCradleError (CradleError deps _ec ms) cradle nfp | HieBios.isCabalCradle cradle = let (fp, showDiag, diag) = ideErrorWithSource (Just "cradle") (Just DiagnosticSeverity_Error) nfp $ T.unlines $ map T.pack userFriendlyMessage in (fp, showDiag, diag{_data_ = Just $ Aeson.toJSON CradleErrorDetails{cabalProjectFiles=absDeps}}) From 8953aec8f4eac9f8c87b6ddf955eeb383ebcf959 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 4 Nov 2024 21:23:51 +0800 Subject: [PATCH 05/12] typo --- ghcide/session-loader/Development/IDE/Session.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 1dc4135923..9eac2ce279 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -665,7 +665,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do if (length toLoads > 1) then do succLoaded_files <- readIORef cradle_files - -- mark as less loaded files as failedLoadingFiles possible + -- mark as less loaded files as failedLoadingFiles as possible let failedLoadingFiles = (Set.insert cfp toLoads) `Set.difference` succLoaded_files atomicModifyIORef' error_loading_files (\xs -> (failedLoadingFiles <> xs,())) -- retry without other files From 4bdc2c87c8aead0b14a988e9c0b19b8d2d735558 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 4 Nov 2024 21:24:59 +0800 Subject: [PATCH 06/12] update inline doc --- ghcide/session-loader/Development/IDE/Session.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 9eac2ce279..7df8fc0240 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -623,7 +623,6 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do <> " (for " <> T.pack lfpLog <> ")" pendingFiles' <- Set.fromList <$> (atomically $ flushTQueue pendingFilesTQueue) - -- remove the file from error loading files errorFiles <- readIORef error_loading_files -- remove error files from pending files since error loading need to load one by one let pendingFiles = pendingFiles' `Set.difference` errorFiles @@ -656,6 +655,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do atomically $ forM_ remainPendingFiles (writeTQueue pendingFilesTQueue) -- log new loaded files logWith recorder Info $ LogSessionNewLoadedFiles $ Set.toList newLoadedT + -- remove the file from error loading files atomicModifyIORef' cradle_files (\xs -> (newLoadedT <> xs,())) atomicModifyIORef' error_loading_files (\old -> (old `Set.difference` newLoadedT, ())) return results From c4bb53a267c5173394ce330f33e84d6da497541a Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 4 Nov 2024 21:26:22 +0800 Subject: [PATCH 07/12] update inline doc --- ghcide/session-loader/Development/IDE/Session.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 7df8fc0240..70a882b337 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -438,8 +438,8 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do -- they are inconsistent. So, everywhere you modify 'fileToFlags', -- you have to modify 'filesMap' as well. filesMap <- newVar HM.empty :: IO (Var FilesMap) - pendingFilesTQueue <- newTQueueIO -- Pending files waiting to be loaded + pendingFilesTQueue <- newTQueueIO -- Version of the mappings above version <- newVar 0 biosSessionLoadingVar <- newVar Nothing :: IO (Var (Maybe SessionLoadingPreferenceConfig)) From 112bc951555bf0c1e542ad05586457d351e079af Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 4 Nov 2024 21:36:03 +0800 Subject: [PATCH 08/12] add LogSessionReloadOnError to log errors during file reloads; cleanup error loading and cradle files --- ghcide/session-loader/Development/IDE/Session.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 70a882b337..793c6b3669 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -147,10 +147,13 @@ data Log | LogHieBios HieBios.Log | LogSessionLoadingChanged | LogSessionNewLoadedFiles ![FilePath] + | LogSessionReloadOnError FilePath ![FilePath] deriving instance Show Log instance Pretty Log where pretty = \case + LogSessionReloadOnError path files -> + "Reloading file due to error in" <+> pretty path <+> "with files:" <+> pretty files LogSessionNewLoadedFiles files -> "New loaded files:" <+> pretty files LogNoneCradleFound path -> @@ -649,14 +652,14 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do | compileTime == runTime -> do (results, allNewLoaded) <- session (hieYaml, toNormalizedFilePath' cfp, opts, libDir) -- put back to pending que if not listed in the results - -- delete cfp even if ew report No cradle target found for cfp + -- delete cfp even if we report No cradle target found for the cfp let remainPendingFiles = Set.delete cfp $ pendingFiles `Set.difference` allNewLoaded let newLoadedT = pendingFiles `Set.intersection` allNewLoaded atomically $ forM_ remainPendingFiles (writeTQueue pendingFilesTQueue) -- log new loaded files logWith recorder Info $ LogSessionNewLoadedFiles $ Set.toList newLoadedT - -- remove the file from error loading files atomicModifyIORef' cradle_files (\xs -> (newLoadedT <> xs,())) + -- remove the file from error loading files atomicModifyIORef' error_loading_files (\old -> (old `Set.difference` newLoadedT, ())) return results | otherwise -> return (([renderPackageSetupException cfp GhcVersionMismatch{..}], Nothing),[]) @@ -711,6 +714,9 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do modifyVar_ filesMap (const (return HM.empty)) -- Don't even keep the name cache, we start from scratch here! modifyVar_ hscEnvs (const (return Map.empty)) + -- cleanup error loading files and cradle files + atomicModifyIORef' error_loading_files (\_ -> (Set.empty,())) + atomicModifyIORef' cradle_files (\_ -> (Set.empty,())) v <- Map.findWithDefault HM.empty hieYaml <$> readVar fileToFlags let cfp = toAbsolutePath file From 6e04d289fe57145153128b44bf1aacb42992456b Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 4 Nov 2024 23:35:57 +0800 Subject: [PATCH 09/12] refactor loadSessionWithOptions to improve error handling and clarify variable names --- ghcide/session-loader/Development/IDE/Session.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 793c6b3669..bcf29f85b4 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -630,13 +630,13 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do -- remove error files from pending files since error loading need to load one by one let pendingFiles = pendingFiles' `Set.difference` errorFiles -- if the file is in error loading files, we fall back to single loading mode - let toLoads = if cfp `Set.member` errorFiles then Set.empty else pendingFiles + let extraToLoads = if cfp `Set.member` errorFiles then Set.empty else pendingFiles eopts <- mRunLspTCallback lspEnv (\act -> withIndefiniteProgress progMsg Nothing NotCancellable (const act)) $ withTrace "Load cradle" $ \addTag -> do addTag "file" lfpLog old_files <- readIORef cradle_files - res <- cradleToOptsAndLibDir recorder (sessionLoading clientConfig) cradle cfp (Set.toList $ Set.delete cfp $ toLoads <> old_files) + res <- cradleToOptsAndLibDir recorder (sessionLoading clientConfig) cradle cfp (Set.toList $ Set.delete cfp $ extraToLoads <> old_files) addTag "result" (show res) return res @@ -660,16 +660,16 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do logWith recorder Info $ LogSessionNewLoadedFiles $ Set.toList newLoadedT atomicModifyIORef' cradle_files (\xs -> (newLoadedT <> xs,())) -- remove the file from error loading files - atomicModifyIORef' error_loading_files (\old -> (old `Set.difference` newLoadedT, ())) + atomicModifyIORef' error_loading_files (\old -> (old `Set.difference` allNewLoaded, ())) return results | otherwise -> return (([renderPackageSetupException cfp GhcVersionMismatch{..}], Nothing),[]) -- Failure case, either a cradle error or the none cradle Left err -> do - if (length toLoads > 1) + if (not $ null extraToLoads) then do succLoaded_files <- readIORef cradle_files -- mark as less loaded files as failedLoadingFiles as possible - let failedLoadingFiles = (Set.insert cfp toLoads) `Set.difference` succLoaded_files + let failedLoadingFiles = (Set.insert cfp extraToLoads) `Set.difference` succLoaded_files atomicModifyIORef' error_loading_files (\xs -> (failedLoadingFiles <> xs,())) -- retry without other files atomically $ forM_ pendingFiles (writeTQueue pendingFilesTQueue) @@ -681,6 +681,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do void $ modifyVar' fileToFlags $ Map.insertWith HM.union hieYaml (HM.singleton ncfp (res, dep_info)) void $ modifyVar' filesMap $ HM.insert ncfp hieYaml + atomicModifyIORef' error_loading_files (\xs -> (Set.insert cfp xs,())) return (res, maybe [] pure hieYaml ++ concatMap cradleErrorDependencies err) let From 67aebc42b01d46c9f699cd4a4f045c548c0960c2 Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 5 Nov 2024 02:03:00 +0800 Subject: [PATCH 10/12] refactor loadSessionWithOptions to improve pending file handling and error management --- .../session-loader/Development/IDE/Session.hs | 22 +++++++++---------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index bcf29f85b4..cb2571e046 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -625,17 +625,18 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do let progMsg = "Setting up " <> T.pack (takeBaseName (cradleRootDir cradle)) <> " (for " <> T.pack lfpLog <> ")" - pendingFiles' <- Set.fromList <$> (atomically $ flushTQueue pendingFilesTQueue) + pendingFiles <- Set.insert cfp . Set.fromList <$> (atomically $ flushTQueue pendingFilesTQueue) errorFiles <- readIORef error_loading_files - -- remove error files from pending files since error loading need to load one by one - let pendingFiles = pendingFiles' `Set.difference` errorFiles + old_files <- readIORef cradle_files -- if the file is in error loading files, we fall back to single loading mode - let extraToLoads = if cfp `Set.member` errorFiles then Set.empty else pendingFiles + let extraToLoads = if cfp `Set.member` errorFiles + then Set.empty + -- remove error files from pending files since error loading need to load one by one + else Set.delete cfp $ pendingFiles `Set.difference` errorFiles eopts <- mRunLspTCallback lspEnv (\act -> withIndefiniteProgress progMsg Nothing NotCancellable (const act)) $ withTrace "Load cradle" $ \addTag -> do addTag "file" lfpLog - old_files <- readIORef cradle_files res <- cradleToOptsAndLibDir recorder (sessionLoading clientConfig) cradle cfp (Set.toList $ Set.delete cfp $ extraToLoads <> old_files) addTag "result" (show res) return res @@ -654,22 +655,21 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do -- put back to pending que if not listed in the results -- delete cfp even if we report No cradle target found for the cfp let remainPendingFiles = Set.delete cfp $ pendingFiles `Set.difference` allNewLoaded - let newLoadedT = pendingFiles `Set.intersection` allNewLoaded + let newLoaded = pendingFiles `Set.intersection` allNewLoaded atomically $ forM_ remainPendingFiles (writeTQueue pendingFilesTQueue) -- log new loaded files - logWith recorder Info $ LogSessionNewLoadedFiles $ Set.toList newLoadedT - atomicModifyIORef' cradle_files (\xs -> (newLoadedT <> xs,())) - -- remove the file from error loading files + logWith recorder Info $ LogSessionNewLoadedFiles $ Set.toList newLoaded + -- remove all new loaded file from error loading files atomicModifyIORef' error_loading_files (\old -> (old `Set.difference` allNewLoaded, ())) + atomicModifyIORef' cradle_files (\xs -> (newLoaded <> xs,())) return results | otherwise -> return (([renderPackageSetupException cfp GhcVersionMismatch{..}], Nothing),[]) -- Failure case, either a cradle error or the none cradle Left err -> do if (not $ null extraToLoads) then do - succLoaded_files <- readIORef cradle_files -- mark as less loaded files as failedLoadingFiles as possible - let failedLoadingFiles = (Set.insert cfp extraToLoads) `Set.difference` succLoaded_files + let failedLoadingFiles = (Set.insert cfp extraToLoads) `Set.difference` old_files atomicModifyIORef' error_loading_files (\xs -> (failedLoadingFiles <> xs,())) -- retry without other files atomically $ forM_ pendingFiles (writeTQueue pendingFilesTQueue) From 98ae44677d0f4295ed2e461b838f5f938e1f4a50 Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 5 Nov 2024 02:25:56 +0800 Subject: [PATCH 11/12] add doc about limitation --- ghcide/session-loader/Development/IDE/Session.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index cb2571e046..127af00f2d 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -669,6 +669,10 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do if (not $ null extraToLoads) then do -- mark as less loaded files as failedLoadingFiles as possible + -- limitation is that when we are loading files, and the dependencies of old_files + -- are changed, and old_files are not valid anymore. + -- but they will still be in the old_files, and will not move to error_loading_files. + -- And make other files failed to load in batch mode. let failedLoadingFiles = (Set.insert cfp extraToLoads) `Set.difference` old_files atomicModifyIORef' error_loading_files (\xs -> (failedLoadingFiles <> xs,())) -- retry without other files @@ -726,7 +730,6 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do deps_ok <- checkDependencyInfo old_di if not deps_ok then do - -- todo invoke the action to recompile the file -- if deps are old, we can try to load the error files again atomicModifyIORef' error_loading_files (\xs -> (Set.delete file xs,())) atomicModifyIORef' cradle_files (\xs -> (Set.delete file xs,())) From f3eb580d1217f8fde81d2dc334df22482b6588a3 Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 5 Nov 2024 16:51:10 +0800 Subject: [PATCH 12/12] absolute file at the beginning --- ghcide/session-loader/Development/IDE/Session.hs | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 127af00f2d..57c9a73024 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -677,6 +677,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do atomicModifyIORef' error_loading_files (\xs -> (failedLoadingFiles <> xs,())) -- retry without other files atomically $ forM_ pendingFiles (writeTQueue pendingFilesTQueue) + logWith recorder Info $ LogSessionReloadOnError cfp (Set.toList pendingFiles) consultCradle hieYaml cfp else do dep_info <- getDependencyInfo (maybeToList hieYaml) @@ -724,8 +725,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do atomicModifyIORef' cradle_files (\_ -> (Set.empty,())) v <- Map.findWithDefault HM.empty hieYaml <$> readVar fileToFlags - let cfp = toAbsolutePath file - case HM.lookup (toNormalizedFilePath' cfp) v of + case HM.lookup (toNormalizedFilePath' file) v of Just (opts, old_di) -> do deps_ok <- checkDependencyInfo old_di if not deps_ok @@ -739,9 +739,9 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do modifyVar_ filesMap (const (return HM.empty)) -- Keep the same name cache modifyVar_ hscEnvs (return . Map.adjust (const []) hieYaml ) - consultCradle hieYaml cfp + consultCradle hieYaml file else return (opts, Map.keys old_di) - Nothing -> consultCradle hieYaml cfp + Nothing -> consultCradle hieYaml file -- The main function which gets options for a file. We only want one of these running -- at a time. Therefore the IORef contains the currently running cradle, if we try @@ -749,16 +749,17 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do -- before attempting to do so. let getOptions :: FilePath -> IO (IdeResult HscEnvEq, [FilePath]) getOptions file = do - let ncfp = toNormalizedFilePath' (toAbsolutePath file) + let ncfp = toNormalizedFilePath' file cachedHieYamlLocation <- HM.lookup ncfp <$> readVar filesMap hieYaml <- cradleLoc file sessionOpts (join cachedHieYamlLocation <|> hieYaml, file) `Safe.catch` \e -> return (([renderPackageSetupException file e], Nothing), maybe [] pure hieYaml) returnWithVersion $ \file -> do - atomically $ writeTQueue pendingFilesTQueue $ toAbsolutePath file + let absFile = toAbsolutePath file + atomically $ writeTQueue pendingFilesTQueue absFile -- see Note [Serializing runs in separate thread] - awaitRunInThread que $ getOptions file + awaitRunInThread que $ getOptions absFile -- | Run the specific cradle on a specific FilePath via hie-bios. -- This then builds dependencies or whatever based on the cradle, gets the