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.

Author: fendor

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

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

ghcide/session-loader/Development/IDE/Session.hs

@@ -69,6 +69,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
@@ -79,6 +80,8 @@ import           Ide.Logger                           (Pretty (pretty),
                                                        nest,
                                                        toCologActionWithPrio,
                                                        vcat, viaShow, (<+>))
+import           Ide.Types                            (SessionLoadingConfig (..),
+                                                       sessionLoading)
 import           Language.LSP.Protocol.Message
 import           Language.LSP.Server
 import           System.Directory
@@ -127,6 +130,7 @@ import           GHC.Unit.State
 #endif
 
 import           GHC.ResponseFile
+import qualified Control.Monad.Extra as Extra
 
 data Log
   = LogSettingInitialDynFlags
@@ -147,6 +151,7 @@ data Log
   | LogNoneCradleFound FilePath
   | LogNewComponentCache !(([FileDiagnostic], Maybe HscEnvEq), DependencyInfo)
   | LogHieBios HieBios.Log
+  | LogSessionLoadingChanged
 deriving instance Show Log
 
 instance Pretty Log where
@@ -217,6 +222,8 @@ instance Pretty Log where
     LogNewComponentCache componentCache ->
       "New component cache HscEnvEq:" <+> viaShow componentCache
     LogHieBios msg -> pretty msg
+    LogSessionLoadingChanged ->
+      "Session Loading Config change, reload the full session."
 
 -- | Bump this version number when making changes to the format of the data stored in hiedb
 hiedbDataVersion :: String
@@ -447,6 +454,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 SessionLoadingConfig))
   let returnWithVersion fun = IdeGhcSession fun <$> liftIO (readVar version)
   -- This caches the mapping from Mod.hs -> hie.yaml
   cradleLoc <- liftIO $ memoIO $ \v -> do
@@ -461,6 +469,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 ()
@@ -651,7 +660,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
 
@@ -679,11 +688,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.
+        didSessionLoadingConfigChange :: IO Bool
+        didSessionLoadingConfigChange = 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 didSessionLoadingConfigChange $ 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
@@ -694,6 +730,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
@@ -713,7 +750,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
@@ -723,14 +760,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) -> SessionLoadingConfig -> 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
@@ -748,6 +785,11 @@ cradleToOptsAndLibDir recorder cradle file old_files = do
             logWith recorder Info $ LogNoneCradleFound file
             return (Left [])
 
+    where
+        loadStyle = case loadConfig of
+            SessionLoadSingleComponent -> LoadFile
+            SessionLoadMultipleComponents -> LoadWithContext old_fps
+
 #if MIN_VERSION_ghc(9,3,0)
 emptyHscEnv :: NameCache -> FilePath -> IO HscEnv
 #else

ghcide/src/Development/IDE/Core/Rules.hs

@@ -701,9 +701,17 @@ 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
+                ]
         return (fingerprint, res)
 
     defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GhcSession file -> do

haskell-language-server.cabal

@@ -822,7 +822,7 @@ test-suite hls-stan-plugin-tests
     , lens
     , lsp-types
     , text
- default-extensions:
+  default-extensions:
     OverloadedStrings
 
 -----------------------------

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'.

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(..), SessionLoadingConfig(..)
 , 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          :: !SessionLoadingConfig
     , 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              = SessionLoadSingleComponent
     , plugins                     = mempty
     }
 
@@ -206,6 +210,38 @@ data CheckParents
   deriving stock (Eq, Ord, Show, Generic)
   deriving anyclass (FromJSON, ToJSON)
 
+
+data SessionLoadingConfig
+    = 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, if the tool doesn't
+    -- support multiple components loading.
+    --
+    -- The cradle can decide how to handle these situations.
+  deriving stock (Eq, Ord, Show, Generic)
+
+instance Pretty SessionLoadingConfig where
+    pretty SessionLoadSingleComponent = "Single Component Session Loading"
+    pretty SessionLoadMultipleComponents = "Multiple Components Session Loading"
+
+instance ToJSON SessionLoadingConfig where
+    toJSON SessionLoadSingleComponent =
+        String "Single Component"
+    toJSON SessionLoadMultipleComponents =
+        String "Multiple Components"
+
+instance FromJSON SessionLoadingConfig where
+    parseJSON (String val) = case val of
+        "Single Component" -> pure SessionLoadSingleComponent
+        "Multiple Components" -> pure SessionLoadMultipleComponents
+        _ -> A.prependFailure "parsing SessionLoadingConfig failed, "
+            (A.parseFail $ "Expected one of \"Single Component\" or \"Multiple Components\" but got " <> T.unpack val )
+    parseJSON o = A.prependFailure "parsing SessionLoadingConfig 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.

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

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

test/testdata/schema/ghc92/default-config.golden.json

@@ -148,5 +148,6 @@
         "splice": {
             "globalOn": true
         }
-    }
+    },
+    "sessionLoading": "Single Component"
 }

test/testdata/schema/ghc94/default-config.golden.json

@@ -151,5 +151,6 @@
         "stan": {
             "globalOn": false
         }
-    }
+    },
+    "sessionLoading": "Single Component"
 }

test/testdata/schema/ghc96/default-config.golden.json

@@ -151,5 +151,6 @@
         "stan": {
             "globalOn": false
         }
-    }
+    },
+    "sessionLoading": "Single Component"
 }

test/testdata/schema/ghc98/default-config.golden.json

@@ -151,5 +151,6 @@
         "stan": {
             "globalOn": false
         }
-    }
+    },
+    "sessionLoading": "Single Component"
 }