From 036a5373e3b885b1e67adf7dec67be03793bdb22 Mon Sep 17 00:00:00 2001 From: Fendor Date: Thu, 11 Apr 2024 21:49:50 +0200 Subject: [PATCH] Allow users to specify whether to use `cabal`'s multi-repl feature We add an option to `Config` that allows clients to specify how HLS should load components. We support two loading strategies: * SessionLoadSingleComponent: Always load only a single component when a new component is discovered. * SessionLoadMultipleComponents: Always allow the cradle to load multiple components at once. This might not be always possible, e.g., if the tool doesn't support multiple components loading. The cradle decides how to handle these situations. By default, we use the conservative `SessionLoadSingleComponent` mode. Additionally, changing the config at run-time leads to a reload of the GHC session, allowing users to switch between the modes without restarting the full server. --- cabal.project | 2 +- ghcide/ghcide.cabal | 2 +- .../session-loader/Development/IDE/Session.hs | 60 ++++++++++++++++--- ghcide/src/Development/IDE/Core/Rules.hs | 13 +++- haskell-language-server.cabal | 2 +- hls-plugin-api/src/Ide/Plugin/Config.hs | 1 + hls-plugin-api/src/Ide/Types.hs | 39 +++++++++++- stack-lts21.yaml | 2 +- stack.yaml | 1 + .../schema/ghc92/default-config.golden.json | 3 +- .../schema/ghc94/default-config.golden.json | 3 +- .../schema/ghc96/default-config.golden.json | 3 +- .../schema/ghc98/default-config.golden.json | 3 +- 13 files changed, 115 insertions(+), 19 deletions(-) diff --git a/cabal.project b/cabal.project index e2b5c04dc1..b5d8d0ff1e 100644 --- a/cabal.project +++ b/cabal.project @@ -8,7 +8,7 @@ packages: ./hls-plugin-api ./hls-test-utils -index-state: 2024-03-09T08:17:00Z +index-state: 2024-04-23T12:00:00Z tests: True test-show-details: direct diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 2e314cce04..57f2b28770 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -78,7 +78,7 @@ library , Glob , haddock-library >=1.8 && <1.12 , hashable - , hie-bios ==0.13.1 + , hie-bios ^>=0.14.0 , hie-compat ^>=0.3.0.0 , hiedb ^>= 0.6.0.0 , hls-graph == 2.7.0.0 diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 2ee4cbcedc..a0d870d590 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -25,7 +25,7 @@ import Control.Concurrent.Async import Control.Concurrent.Strict import Control.Exception.Safe as Safe import Control.Monad -import Control.Monad.Extra +import Control.Monad.Extra as Extra import Control.Monad.IO.Class import qualified Crypto.Hash.SHA1 as H import Data.Aeson hiding (Error) @@ -52,13 +52,13 @@ import Development.IDE.Core.RuleTypes import Development.IDE.Core.Shake hiding (Log, Priority, knownTargets, withHieDb) import qualified Development.IDE.GHC.Compat as Compat -import qualified Development.IDE.GHC.Compat.Util as Compat import Development.IDE.GHC.Compat.Core hiding (Target, TargetFile, TargetModule, Var, Warning, getOptions) 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 qualified Development.IDE.GHC.Compat.Util as Compat import Development.IDE.GHC.Util import Development.IDE.Graph (Action) import Development.IDE.Session.VersionCheck @@ -70,6 +70,7 @@ import Development.IDE.Types.Location import Development.IDE.Types.Options import GHC.Check import qualified HIE.Bios as HieBios +import qualified HIE.Bios.Cradle as HieBios import HIE.Bios.Environment hiding (getCacheDir) import HIE.Bios.Types hiding (Log) import qualified HIE.Bios.Types as HieBios @@ -80,6 +81,8 @@ import Ide.Logger (Pretty (pretty), nest, toCologActionWithPrio, vcat, viaShow, (<+>)) +import Ide.Types (SessionLoadingPreferenceConfig (..), + sessionLoading) import Language.LSP.Protocol.Message import Language.LSP.Server import System.Directory @@ -123,7 +126,8 @@ import GHC.Data.Bag import GHC.Driver.Env (hsc_all_home_unit_ids) import GHC.Driver.Errors.Types import GHC.Driver.Make (checkHomeUnitsClosed) -import GHC.Types.Error (errMsgDiagnostic, singleMessage) +import GHC.Types.Error (errMsgDiagnostic, + singleMessage) import GHC.Unit.State #endif @@ -149,6 +153,7 @@ data Log | LogNoneCradleFound FilePath | LogNewComponentCache !(([FileDiagnostic], Maybe HscEnvEq), DependencyInfo) | LogHieBios HieBios.Log + | LogSessionLoadingChanged deriving instance Show Log instance Pretty Log where @@ -219,6 +224,8 @@ instance Pretty Log where LogNewComponentCache componentCache -> "New component cache HscEnvEq:" <+> viaShow componentCache LogHieBios msg -> pretty msg + LogSessionLoadingChanged -> + "Session Loading config changed, reloading the full session." -- | Bump this version number when making changes to the format of the data stored in hiedb hiedbDataVersion :: String @@ -449,6 +456,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do filesMap <- newVar HM.empty :: IO (Var FilesMap) -- Version of the mappings above version <- newVar 0 + biosSessionLoadingVar <- newVar Nothing :: IO (Var (Maybe SessionLoadingPreferenceConfig)) let returnWithVersion fun = IdeGhcSession fun <$> liftIO (readVar version) -- This caches the mapping from Mod.hs -> hie.yaml cradleLoc <- liftIO $ memoIO $ \v -> do @@ -463,6 +471,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do runningCradle <- newVar dummyAs :: IO (Var (Async (IdeResult HscEnvEq,[FilePath]))) return $ do + clientConfig <- getClientConfigAction extras@ShakeExtras{restartShakeSession, ideNc, knownTargetsVar, lspEnv } <- getShakeExtras let invalidateShakeCache :: IO () @@ -653,7 +662,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do withTrace "Load cradle" $ \addTag -> do addTag "file" lfp old_files <- readIORef cradle_files - res <- cradleToOptsAndLibDir recorder cradle cfp old_files + res <- cradleToOptsAndLibDir recorder (sessionLoading clientConfig) cradle cfp old_files addTag "result" (show res) return res @@ -681,11 +690,38 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do void $ modifyVar' filesMap $ HM.insert ncfp hieYaml return (res, maybe [] pure hieYaml ++ concatMap cradleErrorDependencies err) + let + -- | We allow users to specify a loading strategy. + -- Check whether this config was changed since the last time we have loaded + -- a session. + -- + -- If the loading configuration changed, we likely should restart the session + -- in its entirety. + didSessionLoadingPreferenceConfigChange :: IO Bool + didSessionLoadingPreferenceConfigChange = do + mLoadingConfig <- readVar biosSessionLoadingVar + case mLoadingConfig of + Nothing -> do + writeVar biosSessionLoadingVar (Just (sessionLoading clientConfig)) + pure False + Just loadingConfig -> do + writeVar biosSessionLoadingVar (Just (sessionLoading clientConfig)) + pure (loadingConfig /= sessionLoading clientConfig) + -- This caches the mapping from hie.yaml + Mod.hs -> [String] -- Returns the Ghc session and the cradle dependencies let sessionOpts :: (Maybe FilePath, FilePath) -> IO (IdeResult HscEnvEq, [FilePath]) sessionOpts (hieYaml, file) = do + Extra.whenM didSessionLoadingPreferenceConfigChange $ do + logWith recorder Info LogSessionLoadingChanged + -- If the dependencies are out of date then clear both caches and start + -- again. + modifyVar_ fileToFlags (const (return Map.empty)) + modifyVar_ filesMap (const (return HM.empty)) + -- Don't even keep the name cache, we start from scratch here! + modifyVar_ hscEnvs (const (return Map.empty)) + v <- Map.findWithDefault HM.empty hieYaml <$> readVar fileToFlags cfp <- makeAbsolute file case HM.lookup (toNormalizedFilePath' cfp) v of @@ -696,6 +732,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do -- If the dependencies are out of date then clear both caches and start -- again. modifyVar_ fileToFlags (const (return Map.empty)) + modifyVar_ filesMap (const (return HM.empty)) -- Keep the same name cache modifyVar_ hscEnvs (return . Map.adjust (const []) hieYaml ) consultCradle hieYaml cfp @@ -715,7 +752,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do return (([renderPackageSetupException file e], Nothing), maybe [] pure hieYaml) returnWithVersion $ \file -> do - opts <- liftIO $ join $ mask_ $ modifyVar runningCradle $ \as -> do + opts <- join $ mask_ $ modifyVar runningCradle $ \as -> do -- If the cradle is not finished, then wait for it to finish. void $ wait as asyncRes <- async $ getOptions file @@ -725,14 +762,14 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do -- | Run the specific cradle on a specific FilePath via hie-bios. -- This then builds dependencies or whatever based on the cradle, gets the -- GHC options/dynflags needed for the session and the GHC library directory -cradleToOptsAndLibDir :: Recorder (WithPriority Log) -> Cradle Void -> FilePath -> [FilePath] +cradleToOptsAndLibDir :: Recorder (WithPriority Log) -> SessionLoadingPreferenceConfig -> Cradle Void -> FilePath -> [FilePath] -> IO (Either [CradleError] (ComponentOptions, FilePath)) -cradleToOptsAndLibDir recorder cradle file old_files = do +cradleToOptsAndLibDir recorder loadConfig cradle file old_fps = do -- let noneCradleFoundMessage :: FilePath -> T.Text -- noneCradleFoundMessage f = T.pack $ "none cradle found for " <> f <> ", ignoring the file" -- Start off by getting the session options logWith recorder Debug $ LogCradle cradle - cradleRes <- HieBios.getCompilerOptions file old_files cradle + cradleRes <- HieBios.getCompilerOptions file loadStyle cradle case cradleRes of CradleSuccess r -> do -- Now get the GHC lib dir @@ -750,6 +787,11 @@ cradleToOptsAndLibDir recorder cradle file old_files = do logWith recorder Info $ LogNoneCradleFound file return (Left []) + where + loadStyle = case loadConfig of + PreferSingleComponentLoading -> LoadFile + PreferMultiComponentLoading -> LoadWithContext old_fps + #if MIN_VERSION_ghc(9,3,0) emptyHscEnv :: NameCache -> FilePath -> IO HscEnv #else @@ -1150,7 +1192,7 @@ setOptions cfp (ComponentOptions theOpts compRoot _) dflags = do -- component to be created. In case the cradle doesn't list all the targets for -- the component, in which case things will be horribly broken anyway. -- - -- When we have a single component that is caused to be loaded due to a + -- When we have a singleComponent that is caused to be loaded due to a -- file, we assume the file is part of that component. This is useful -- for bare GHC sessions, such as many of the ones used in the testsuite -- diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 6242ccff50..1e96a99f2b 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -701,9 +701,20 @@ loadGhcSession recorder ghcSessionDepsConfig = do defineEarlyCutOffNoFile (cmapWithPrio LogShake recorder) $ \GhcSessionIO -> do alwaysRerun opts <- getIdeOptions + config <- getClientConfigAction res <- optGhcSession opts - let fingerprint = LBS.toStrict $ B.encode $ hash (sessionVersion res) + let fingerprint = LBS.toStrict $ LBS.concat + [ B.encode (hash (sessionVersion res)) + -- When the session version changes, reload all session + -- hsc env sessions + , B.encode (show (sessionLoading config)) + -- The loading config affects session loading. + -- Invalidate all build nodes. + -- Changing the session loading config will increment + -- the 'sessionVersion', thus we don't generate the same fingerprint + -- twice by accident. + ] return (fingerprint, res) defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GhcSession file -> do diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 440b6aeaac..1c52e437a8 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -822,7 +822,7 @@ test-suite hls-stan-plugin-tests , lens , lsp-types , text - default-extensions: + default-extensions: OverloadedStrings ----------------------------- diff --git a/hls-plugin-api/src/Ide/Plugin/Config.hs b/hls-plugin-api/src/Ide/Plugin/Config.hs index 519c328c90..24c1b0c376 100644 --- a/hls-plugin-api/src/Ide/Plugin/Config.hs +++ b/hls-plugin-api/src/Ide/Plugin/Config.hs @@ -42,6 +42,7 @@ parseConfig idePlugins defValue = A.withObject "settings" $ \o -> <*> o .:? "formattingProvider" .!= formattingProvider defValue <*> o .:? "cabalFormattingProvider" .!= cabalFormattingProvider defValue <*> o .:? "maxCompletions" .!= maxCompletions defValue + <*> o .:? "sessionLoading" .!= sessionLoading defValue <*> A.explicitParseFieldMaybe (parsePlugins idePlugins) o "plugin" .!= plugins defValue -- | Parse the 'PluginConfig'. diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index 9ed6fd19b9..5212b2c6da 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -22,7 +22,7 @@ module Ide.Types , IdeNotification(..) , IdePlugins(IdePlugins, ipMap) , DynFlagsModifications(..) -, Config(..), PluginConfig(..), CheckParents(..) +, Config(..), PluginConfig(..), CheckParents(..), SessionLoadingPreferenceConfig(..) , ConfigDescriptor(..), defaultConfigDescriptor, configForPlugin , CustomConfig(..), mkCustomConfig , FallbackCodeActionParams(..) @@ -65,6 +65,7 @@ import Control.Monad.Error.Class (MonadError (throwError)) import Control.Monad.Trans.Class (MonadTrans (lift)) import Control.Monad.Trans.Except (ExceptT, runExceptT) import Data.Aeson hiding (Null, defaultOptions) +import qualified Data.Aeson.Types as A import Data.Default import Data.Dependent.Map (DMap) import qualified Data.Dependent.Map as DMap @@ -170,6 +171,7 @@ data Config = , formattingProvider :: !T.Text , cabalFormattingProvider :: !T.Text , maxCompletions :: !Int + , sessionLoading :: !SessionLoadingPreferenceConfig , plugins :: !(Map.Map PluginId PluginConfig) } deriving (Show,Eq) @@ -180,6 +182,7 @@ instance ToJSON Config where , "formattingProvider" .= formattingProvider , "cabalFormattingProvider" .= cabalFormattingProvider , "maxCompletions" .= maxCompletions + , "sessionLoading" .= sessionLoading , "plugin" .= Map.mapKeysMonotonic (\(PluginId p) -> p) plugins ] @@ -194,6 +197,7 @@ instance Default Config where -- , cabalFormattingProvider = "cabal-fmt" -- this string value needs to kept in sync with the value provided in HlsPlugins , maxCompletions = 40 + , sessionLoading = PreferSingleComponentLoading , plugins = mempty } @@ -206,6 +210,39 @@ data CheckParents deriving stock (Eq, Ord, Show, Generic) deriving anyclass (FromJSON, ToJSON) + +data SessionLoadingPreferenceConfig + = PreferSingleComponentLoading + -- ^ Always load only a singleComponent when a new component + -- is discovered. + | PreferMultiComponentLoading + -- ^ Always prefer loading multiple components in the cradle + -- at once. This might not be always possible, if the tool doesn't + -- support multiple components loading. + -- + -- The cradle can decide how to handle these situations, and whether + -- to honour the preference at all. + deriving stock (Eq, Ord, Show, Generic) + +instance Pretty SessionLoadingPreferenceConfig where + pretty PreferSingleComponentLoading = "Prefer Single Component Loading" + pretty PreferMultiComponentLoading = "Prefer Multiple Components Loading" + +instance ToJSON SessionLoadingPreferenceConfig where + toJSON PreferSingleComponentLoading = + String "singleComponent" + toJSON PreferMultiComponentLoading = + String "multipleComponents" + +instance FromJSON SessionLoadingPreferenceConfig where + parseJSON (String val) = case val of + "singleComponent" -> pure PreferSingleComponentLoading + "multipleComponents" -> pure PreferMultiComponentLoading + _ -> A.prependFailure "parsing SessionLoadingPreferenceConfig failed, " + (A.parseFail $ "Expected one of \"singleComponent\" or \"multipleComponents\" but got " <> T.unpack val ) + parseJSON o = A.prependFailure "parsing SessionLoadingPreferenceConfig failed, " + (A.typeMismatch "String" o) + -- | A PluginConfig is a generic configuration for a given HLS plugin. It -- provides a "big switch" to turn it on or off as a whole, as well as small -- switches per feature, and a slot for custom config. diff --git a/stack-lts21.yaml b/stack-lts21.yaml index a546cc2987..a20038f32b 100644 --- a/stack-lts21.yaml +++ b/stack-lts21.yaml @@ -18,7 +18,7 @@ allow-newer: true extra-deps: - floskell-0.11.1 - hiedb-0.6.0.0 -- hie-bios-0.13.1 +- hie-bios-0.14.0 - implicit-hie-0.1.4.0 - monad-dijkstra-0.1.1.3 - retrie-1.2.2 diff --git a/stack.yaml b/stack.yaml index 8037f49e55..70388aa8dc 100644 --- a/stack.yaml +++ b/stack.yaml @@ -18,6 +18,7 @@ extra-deps: - floskell-0.11.1 - retrie-1.2.2 - hiedb-0.6.0.0 +- hie-bios-0.14.0 - implicit-hie-0.1.4.0 - lsp-2.4.0.0 - lsp-test-0.17.0.0 diff --git a/test/testdata/schema/ghc92/default-config.golden.json b/test/testdata/schema/ghc92/default-config.golden.json index 5b1fbef11a..be1a256f97 100644 --- a/test/testdata/schema/ghc92/default-config.golden.json +++ b/test/testdata/schema/ghc92/default-config.golden.json @@ -148,5 +148,6 @@ "splice": { "globalOn": true } - } + }, + "sessionLoading": "singleComponent" } diff --git a/test/testdata/schema/ghc94/default-config.golden.json b/test/testdata/schema/ghc94/default-config.golden.json index a5a77c9619..2859e3d720 100644 --- a/test/testdata/schema/ghc94/default-config.golden.json +++ b/test/testdata/schema/ghc94/default-config.golden.json @@ -151,5 +151,6 @@ "stan": { "globalOn": false } - } + }, + "sessionLoading": "singleComponent" } diff --git a/test/testdata/schema/ghc96/default-config.golden.json b/test/testdata/schema/ghc96/default-config.golden.json index a5a77c9619..2859e3d720 100644 --- a/test/testdata/schema/ghc96/default-config.golden.json +++ b/test/testdata/schema/ghc96/default-config.golden.json @@ -151,5 +151,6 @@ "stan": { "globalOn": false } - } + }, + "sessionLoading": "singleComponent" } diff --git a/test/testdata/schema/ghc98/default-config.golden.json b/test/testdata/schema/ghc98/default-config.golden.json index a5a77c9619..2859e3d720 100644 --- a/test/testdata/schema/ghc98/default-config.golden.json +++ b/test/testdata/schema/ghc98/default-config.golden.json @@ -151,5 +151,6 @@ "stan": { "globalOn": false } - } + }, + "sessionLoading": "singleComponent" }