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.

The three options are:

* 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 can decide how to handle these situations.
* SessionAuto: Leave the decision to the individual cradle type.
    Some cradles have good support for loading multiple components,
    while others do not.
    So use multiple components loading for tools, such as cabal,
    and force single component loading for tools that do not support
    multiple components, such as stack.

Author: fendor

cabal.project

@@ -42,3 +42,8 @@ constraints:
   -- We want to be able to benefit from the performance optimisations
   -- in the future, thus: TODO: remove this flag.
   bitvec -simd
+
+source-repository-package
+    type: git
+    location: https://github.com/fendor/hie-bios
+    tag: 10afd5b50475b7f8877296cd65614a1a72253941

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
@@ -461,6 +464,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 +655,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
 
@@ -713,7 +717,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 +727,15 @@ 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
+    loadStyle <- decideLoadStyle
+    cradleRes <- HieBios.getCompilerOptions file loadStyle cradle
     case cradleRes of
         CradleSuccess r -> do
             -- Now get the GHC lib dir
@@ -748,6 +753,14 @@ cradleToOptsAndLibDir recorder cradle file old_files = do
             logWith recorder Info $ LogNoneCradleFound file
             return (Left [])
 
+    where
+        decideLoadStyle = case loadConfig of
+            SessionLoadSingleComponent -> pure SingleComponent
+            SessionLoadMultipleComponents -> pure $ LoadWithContext old_fps
+            SessionAuto
+                | HieBios.isCabalCradle cradle -> pure $ LoadWithContext old_fps
+                | otherwise -> pure SingleComponent
+
 #if MIN_VERSION_ghc(9,3,0)
 emptyHscEnv :: NameCache -> FilePath -> IO HscEnv
 #else

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              = SessionAuto
     , plugins                     = mempty
     }
 
@@ -206,6 +210,44 @@ 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.
+    | SessionAuto
+    -- ^ Leave the decision to the individual cradle type.
+    -- Some cradles have good support for loading multiple components,
+    -- while others do not.
+    -- So use multiple components loading for tools, such as cabal,
+    -- and force single component loading for tools that do not support
+    -- multiple components, such as stack.
+  deriving stock (Eq, Ord, Show, Generic)
+
+instance ToJSON SessionLoadingConfig where
+    toJSON SessionLoadSingleComponent =
+        String "Single Component"
+    toJSON SessionLoadMultipleComponents =
+        String "Multiple Components"
+    toJSON SessionAuto =
+        String "Auto"
+
+instance FromJSON SessionLoadingConfig where
+    parseJSON (String val) = case val of
+        "Single Component" -> pure SessionLoadSingleComponent
+        "Multiple Components" -> pure SessionLoadMultipleComponents
+        "Auto" -> pure SessionAuto
+        _ -> A.prependFailure "parsing SessionLoadingConfig failed, "
+            (A.parseFail $ "Expected one of \"Single Component\", \"Multiple Components\" or \"Auto\" 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.

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

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

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

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

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

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

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

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