Skip to content

Commit 236e790

Browse files
michaelpjmichaelpj
committed
Adapt to lsp changes for workspace/configuration
This has a few substantive changes and a lot of messing with tests. - We now tell `lsp` our config section, and parse just that section. - We move the logic for updating the shake build rules for client config from a `workspace/didChangeConfiguration` handler to the new `lsp` callback, which will ensure it gets called in all circumstances that can be relevant. The test changes are more annoying: - We ignore config and logging messages by default now, so we have to stop doing that when we care about it. - Many tests didn't really need to _change_ the config, but rather just to set it once at the beginning. I adjusted a lot of test functions to allow passing in the initial config for this reason.
1 parent e516937 commit 236e790

File tree

71 files changed

+344
-347
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

71 files changed

+344
-347
lines changed

‎cabal.project

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -55,7 +55,7 @@ package *
5555

5656
write-ghc-environment-files: never
5757

58-
index-state: 2023-08-09T10:37:15Z
58+
index-state: 2023-08-25T00:00:00Z
5959

6060
constraints:
6161
-- For GHC 9.4, older versions of entropy fail to build on Windows
@@ -101,4 +101,3 @@ if impl(ghc >= 9.5)
101101
-- ghc-9.6
102102
ekg-core:ghc-prim,
103103
stm-hamt:transformers,
104-

‎exe/Wrapper.hs

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -283,7 +283,8 @@ launchErrorLSP recorder errorMsg = do
283283

284284
outH <- Main.argsHandleOut defaultArguments
285285

286-
let onConfigurationChange cfg _ = Right cfg
286+
let parseConfig cfg _ = Right cfg
287+
onConfigChange _ = pure ()
287288

288289
let setup clientMsgVar = do
289290
-- Forcefully exit
@@ -311,7 +312,8 @@ launchErrorLSP recorder errorMsg = do
311312
inH
312313
outH
313314
(Main.argsDefaultHlsConfig defaultArguments)
314-
onConfigurationChange
315+
parseConfig
316+
onConfigChange
315317
setup
316318

317319
exitHandler :: IO () -> LSP.Handlers (ErrorLSPM c)

‎flake.lock

Lines changed: 9 additions & 9 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎ghcide-bench/ghcide-bench.cabal

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -119,7 +119,7 @@ test-suite test
119119
base,
120120
extra,
121121
ghcide-bench,
122-
lsp-test ^>= 0.15.0.1,
122+
lsp-test ^>= 0.16,
123123
tasty,
124124
tasty-hunit >= 0.10,
125125
tasty-rerun,

‎ghcide-bench/src/Experiments.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -363,8 +363,8 @@ runBenchmarksFun dir allBenchmarks = do
363363
createDirectoryIfMissing True eventlogDir
364364

365365
lspConfig <- if Experiments.Types.lspConfig ?config
366-
then either error Just . eitherDecodeStrict' <$> BS.getContents
367-
else return Nothing
366+
then either error id . eitherDecodeStrict' <$> BS.getContents
367+
else return mempty
368368

369369
let conf = defaultConfig
370370
{ logStdErr = verbose ?config,
@@ -512,7 +512,7 @@ waitForProgressStart :: Session ()
512512
waitForProgressStart = void $ do
513513
skipManyTill anyMessage $ satisfy $ \case
514514
FromServerMess SMethod_WindowWorkDoneProgressCreate _ -> True
515-
_ -> False
515+
_ -> False
516516

517517
-- | Wait for all progress to be done
518518
-- Needs at least one progress done notification to return

‎ghcide/ghcide.cabal

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -74,8 +74,8 @@ library
7474
lens,
7575
list-t,
7676
hiedb == 0.4.3.*,
77-
lsp-types ^>= 2.0.1.0,
78-
lsp ^>= 2.1.0.0 ,
77+
lsp-types ^>= 2.0.2.0,
78+
lsp ^>= 2.2.0.0 ,
7979
mtl,
8080
optparse-applicative,
8181
parallel,
@@ -371,7 +371,7 @@ test-suite ghcide-tests
371371
hls-plugin-api,
372372
lens,
373373
list-t,
374-
lsp-test ^>= 0.15.0.1,
374+
lsp-test ^>= 0.16.0.0,
375375
mtl,
376376
monoid-subclasses,
377377
network-uri,

‎ghcide/src/Development/IDE/Core/RuleTypes.hs

Lines changed: 32 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -475,7 +475,8 @@ data GetModSummary = GetModSummary
475475
instance Hashable GetModSummary
476476
instance NFData GetModSummary
477477

478-
-- | Get the vscode client settings stored in the ide state
478+
-- See Note [Client configuration in Rules]
479+
-- | Get the client config stored in the ide state
479480
data GetClientSettings = GetClientSettings
480481
deriving (Eq, Show, Typeable, Generic)
481482
instance Hashable GetClientSettings
@@ -510,3 +511,33 @@ instance NFData GhcSessionIO
510511
makeLensesWith
511512
(lensRules & lensField .~ mappingNamer (pure . (++ "L")))
512513
''Splices
514+
515+
{- Note [Client configuration in Rules]
516+
The LSP client configuration is stored by `lsp` for us, and is accesible in
517+
handlers through the LspT monad.
518+
519+
This is all well and good, but what if we want to write a Rule that depends
520+
on the configuration? For example, we might have a plugin that provides
521+
diagnostics - if the configuration changes to turn off that plugin, then
522+
we need to invalidate the Rule producing the diagnostics so that they go
523+
away. More broadly, any time we define a Rule that really depends on the
524+
configuration, such that the dependency needs to be tracked and the Rule
525+
invalidated when the configuration changes, we have a problem.
526+
527+
The solution is that we have to mirror the configuration into the state
528+
that our build system knows about. That means that:
529+
- We have a parallel record of the state in 'IdeConfiguration'
530+
- We install a callback so that when the config changes we can update the
531+
'IdeConfiguration' and mark the rule as dirty.
532+
533+
Then we can define a Rule that gets the configuration, and build Actions
534+
on top of that that behave properly. However, these should really only
535+
be used if you need the dependency tracking - for normal usage in handlers
536+
the config can simply be accessed directly from LspT.
537+
538+
TODO(michaelpj): this is me writing down what I think the logic is, but
539+
it doesn't make much sense to me. In particular, we *can* get the LspT
540+
in an Action. So I don't know why we need to store it twice. We would
541+
still need to invalidate the Rule otherwise we won't know it's changed,
542+
though. See https://github.com/haskell/ghcide/pull/731 for some context.
543+
-}

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1095,6 +1095,7 @@ writeCoreFileIfNeeded se hsc (Just _) getGuts tmr = do
10951095
(diags', !res) <- liftIO $ mkHiFileResultCompile se hsc tmr guts
10961096
pure (diags++diags', res)
10971097

1098+
-- See Note [Client configuration in Rules]
10981099
getClientSettingsRule :: Recorder (WithPriority Log) -> Rules ()
10991100
getClientSettingsRule recorder = defineEarlyCutOffNoFile (cmapWithPrio LogShake recorder) $ \GetClientSettings -> do
11001101
alwaysRerun

‎ghcide/src/Development/IDE/Core/Shake.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -325,6 +325,7 @@ getShakeExtrasRules = do
325325
-- This will actually crash HLS
326326
Nothing -> liftIO $ fail "missing ShakeExtras"
327327

328+
-- See Note [Client configuration in Rules]
328329
-- | Returns the client configuration, creating a build dependency.
329330
-- You should always use this function when accessing client configuration
330331
-- from build rules.

‎ghcide/src/Development/IDE/LSP/LanguageServer.hs

Lines changed: 7 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -90,32 +90,33 @@ runLanguageServer
9090
-> Handle -- output
9191
-> config
9292
-> (config -> Value -> Either T.Text config)
93+
-> (config -> m config ())
9394
-> (MVar ()
9495
-> IO (LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either ResponseError (LSP.LanguageContextEnv config, a)),
9596
LSP.Handlers (m config),
9697
(LanguageContextEnv config, a) -> m config <~> IO))
9798
-> IO ()
98-
runLanguageServer recorder options inH outH defaultConfig onConfigurationChange setup = do
99+
runLanguageServer recorder options inH outH defaultConfig parseConfig onConfigChange setup = do
99100
-- This MVar becomes full when the server thread exits or we receive exit message from client.
100101
-- LSP server will be canceled when it's full.
101102
clientMsgVar <- newEmptyMVar
102103

103104
(doInitialize, staticHandlers, interpretHandler) <- setup clientMsgVar
104105

105106
let serverDefinition = LSP.ServerDefinition
106-
{ LSP.onConfigurationChange = onConfigurationChange
107+
{ LSP.parseConfig = parseConfig
108+
, LSP.onConfigChange = onConfigChange
107109
, LSP.defaultConfig = defaultConfig
110+
-- TODO: magic string
111+
, LSP.configSection = "haskell"
108112
, LSP.doInitialize = doInitialize
109113
, LSP.staticHandlers = (const staticHandlers)
110114
, LSP.interpretHandler = interpretHandler
111115
, LSP.options = modifyOptions options
112116
}
113117

114118
let lspCologAction :: MonadIO m2 => Colog.LogAction m2 (Colog.WithSeverity LspServerLog)
115-
lspCologAction = toCologActionWithPrio $ cfilter
116-
-- filter out bad logs in lsp, see: https://github.com/haskell/lsp/issues/447
117-
(\msg -> priority msg >= Info)
118-
(cmapWithPrio LogLspServer recorder)
119+
lspCologAction = toCologActionWithPrio (cmapWithPrio LogLspServer recorder)
119120

120121
void $ untilMVar clientMsgVar $
121122
void $ LSP.runServerWithHandles

‎ghcide/src/Development/IDE/LSP/Notifications.hs

Lines changed: 3 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -32,12 +32,10 @@ import Development.IDE.Core.FileStore (registerFileWatches,
3232
import qualified Development.IDE.Core.FileStore as FileStore
3333
import Development.IDE.Core.IdeConfiguration
3434
import Development.IDE.Core.OfInterest hiding (Log, LogShake)
35-
import Development.IDE.Core.RuleTypes (GetClientSettings (..))
3635
import Development.IDE.Core.Service hiding (Log, LogShake)
3736
import Development.IDE.Core.Shake hiding (Log, Priority)
3837
import qualified Development.IDE.Core.Shake as Shake
3938
import Development.IDE.Types.Location
40-
import Development.IDE.Types.Shake (toKey)
4139
import Ide.Logger
4240
import Ide.Types
4341
import Numeric.Natural
@@ -119,12 +117,9 @@ descriptor recorder plId = (defaultPluginDescriptor plId) { pluginNotificationHa
119117
$ add (foldMap (S.singleton . parseWorkspaceFolder) (_added events))
120118
. substract (foldMap (S.singleton . parseWorkspaceFolder) (_removed events))
121119

122-
, mkPluginNotificationHandler LSP.SMethod_WorkspaceDidChangeConfiguration $
123-
\ide vfs _ (DidChangeConfigurationParams cfg) -> liftIO $ do
124-
let msg = Text.pack $ show cfg
125-
logDebug (ideLogger ide) $ "Configuration changed: " <> msg
126-
modifyClientSettings ide (const $ Just cfg)
127-
setSomethingModified (VFSModified vfs) ide [toKey GetClientSettings emptyFilePath] "config change"
120+
-- Nothing additional to do here beyond what `lsp` does for us, but this prevents
121+
-- complaints about there being no handler defined
122+
, mkPluginNotificationHandler LSP.SMethod_WorkspaceDidChangeConfiguration mempty
128123

129124
, mkPluginNotificationHandler LSP.SMethod_Initialized $ \ide _ _ _ -> do
130125
--------- Initialize Shake session --------------------------------------------------------------------

‎ghcide/src/Development/IDE/Main.hs

Lines changed: 31 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -13,12 +13,16 @@ module Development.IDE.Main
1313
) where
1414

1515
import Control.Concurrent.Extra (withNumCapabilities)
16+
import Control.Concurrent.MVar (newEmptyMVar,
17+
putMVar, tryReadMVar)
1618
import Control.Concurrent.STM.Stats (dumpSTMStats)
1719
import Control.Exception.Safe (SomeException,
1820
catchAny,
1921
displayException)
2022
import Control.Monad.Extra (concatMapM, unless,
2123
when)
24+
import Control.Monad.IO.Class (liftIO)
25+
import qualified Data.Aeson as J
2226
import Data.Coerce (coerce)
2327
import Data.Default (Default (def))
2428
import Data.Foldable (traverse_)
@@ -31,11 +35,14 @@ import Data.Maybe (catMaybes, isJust)
3135
import qualified Data.Text as T
3236
import Development.IDE (Action,
3337
Priority (Debug, Error),
34-
Rules, hDuplicateTo')
38+
Rules, emptyFilePath,
39+
hDuplicateTo')
3540
import Development.IDE.Core.Debouncer (Debouncer,
3641
newAsyncDebouncer)
37-
import Development.IDE.Core.FileStore (isWatchSupported)
42+
import Development.IDE.Core.FileStore (isWatchSupported,
43+
setSomethingModified)
3844
import Development.IDE.Core.IdeConfiguration (IdeConfiguration (..),
45+
modifyClientSettings,
3946
registerIdeConfiguration)
4047
import Development.IDE.Core.OfInterest (FileOfInterestStatus (OnDisk),
4148
kick,
@@ -83,7 +90,7 @@ import Development.IDE.Types.Options (IdeGhcSession,
8390
defaultIdeOptions,
8491
optModifyDynFlags,
8592
optTesting)
86-
import Development.IDE.Types.Shake (WithHieDb)
93+
import Development.IDE.Types.Shake (WithHieDb, toKey)
8794
import GHC.Conc (getNumProcessors)
8895
import GHC.IO.Encoding (setLocaleEncoding)
8996
import GHC.IO.Handle (hDuplicate)
@@ -95,8 +102,8 @@ import Ide.Logger (Logger,
95102
Recorder,
96103
WithPriority,
97104
cmapWithPrio,
98-
logWith, nest, vsep,
99-
(<+>))
105+
logDebug, logWith,
106+
nest, vsep, (<+>))
100107
import Ide.Plugin.Config (CheckParents (NeverCheck),
101108
Config, checkParents,
102109
checkProject,
@@ -289,7 +296,7 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re
289296
hlsCommands = allLspCmdIds' pid argsHlsPlugins
290297
plugins = hlsPlugin <> argsGhcidePlugin
291298
options = argsLspOptions { LSP.optExecuteCommandCommands = LSP.optExecuteCommandCommands argsLspOptions <> Just hlsCommands }
292-
argsOnConfigChange = getConfigFromNotification argsHlsPlugins
299+
argsParseConfig = getConfigFromNotification argsHlsPlugins
293300
rules = argsRules >> pluginRules plugins
294301

295302
debouncer <- argsDebouncer
@@ -304,6 +311,7 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re
304311
ioT <- offsetTime
305312
logWith recorder Info $ LogLspStart (pluginId <$> ipMap argsHlsPlugins)
306313

314+
ideStateVar <- newEmptyMVar
307315
let getIdeState :: LSP.LanguageContextEnv Config -> Maybe FilePath -> WithHieDb -> IndexQueue -> IO IdeState
308316
getIdeState env rootPath withHieDb hieChan = do
309317
traverse_ IO.setCurrentDirectory rootPath
@@ -334,7 +342,7 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re
334342
}
335343
caps = LSP.resClientCapabilities env
336344
monitoring <- argsMonitoring
337-
initialise
345+
ide <- initialise
338346
(cmapWithPrio LogService recorder)
339347
argsDefaultHlsConfig
340348
argsHlsPlugins
@@ -346,10 +354,24 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re
346354
withHieDb
347355
hieChan
348356
monitoring
357+
putMVar ideStateVar ide
358+
pure ide
349359

350360
let setup = setupLSP (cmapWithPrio LogLanguageServer recorder) argsGetHieDbLoc (pluginHandlers plugins) getIdeState
351-
352-
runLanguageServer (cmapWithPrio LogLanguageServer recorder) options inH outH argsDefaultHlsConfig argsOnConfigChange setup
361+
-- See Note [Client configuration in Rules]
362+
onConfigChange cfg = do
363+
-- TODO: this is nuts, we're converting back to JSON just to get a fingerprint
364+
let cfgObj = J.toJSON cfg
365+
mide <- liftIO $ tryReadMVar ideStateVar
366+
case mide of
367+
Nothing -> pure ()
368+
Just ide -> liftIO $ do
369+
let msg = T.pack $ show cfg
370+
logDebug (Shake.ideLogger ide) $ "Configuration changed: " <> msg
371+
modifyClientSettings ide (const $ Just cfgObj)
372+
setSomethingModified Shake.VFSUnmodified ide [toKey Rules.GetClientSettings emptyFilePath] "config change"
373+
374+
runLanguageServer (cmapWithPrio LogLanguageServer recorder) options inH outH argsDefaultHlsConfig argsParseConfig onConfigChange setup
353375
dumpSTMStats
354376
Check argFiles -> do
355377
dir <- maybe IO.getCurrentDirectory return argsProjectRoot

0 commit comments

Comments
 (0)