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" }