Skip to content

Commit 71aa2d3

Browse files
michaelpjmichaelpj
authored
Bump to new lsp versions (#4279)
1 parent 322ac35 commit 71aa2d3

File tree

28 files changed

+92
-87
lines changed

28 files changed

+92
-87
lines changed

‎cabal.project‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@ packages:
77
./hls-plugin-api
88
./hls-test-utils
99

10-
index-state: 2024-05-10T00:00:00Z
10+
index-state: 2024-06-07T00:00:00Z
1111

1212
tests: True
1313
test-show-details: direct

‎exe/Wrapper.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -48,9 +48,9 @@ import Ide.Logger (Doc, Pretty (pretty),
4848
import Ide.Plugin.Config (Config)
4949
import Ide.Types (IdePlugins (IdePlugins))
5050
import Language.LSP.Protocol.Message (Method (Method_Initialize),
51-
ResponseError,
5251
SMethod (SMethod_Exit, SMethod_WindowShowMessageRequest),
53-
TRequestMessage)
52+
TRequestMessage,
53+
TResponseError)
5454
import Language.LSP.Protocol.Types (MessageActionItem (MessageActionItem),
5555
MessageType (MessageType_Error),
5656
ShowMessageRequestParams (ShowMessageRequestParams),
@@ -283,7 +283,7 @@ launchErrorLSP recorder errorMsg = do
283283
-- Forcefully exit
284284
let exit = void $ tryPutMVar clientMsgVar ()
285285

286-
let doInitialize :: LSP.LanguageContextEnv Config -> TRequestMessage Method_Initialize -> IO (Either ResponseError (LSP.LanguageContextEnv Config, ()))
286+
let doInitialize :: LSP.LanguageContextEnv Config -> TRequestMessage Method_Initialize -> IO (Either (TResponseError Method_Initialize) (LSP.LanguageContextEnv Config, ()))
287287
doInitialize env _ = do
288288

289289
let restartTitle = "Try to restart"

‎ghcide-bench/src/Experiments.hs‎

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -557,7 +557,7 @@ runBenchmarksFun dir allBenchmarks = do
557557
]
558558
++ ["--ot-memory-profiling" | Just _ <- [otMemoryProfiling ?config]]
559559
lspTestCaps =
560-
fullCaps
560+
fullLatestClientCaps
561561
& (L.window . _Just) .~ WindowClientCapabilities (Just True) Nothing Nothing
562562
& (L.textDocument . _Just . L.codeAction . _Just . L.resolveSupport . _Just) .~ (ClientCodeActionResolveOptions ["edit"])
563563
& (L.textDocument . _Just . L.codeAction . _Just . L.dataSupport . _Just) .~ True
@@ -842,27 +842,27 @@ searchSymbol doc@TextDocumentIdentifier{_uri} fileContents pos = do
842842
not . null <$> getCompletions doc pos
843843

844844

845-
getBuildKeysBuilt :: Session (Either ResponseError [T.Text])
845+
getBuildKeysBuilt :: Session (Either (TResponseError @ClientToServer (Method_CustomMethod "test")) [T.Text])
846846
getBuildKeysBuilt = tryCallTestPlugin GetBuildKeysBuilt
847847

848-
getBuildKeysVisited :: Session (Either ResponseError [T.Text])
848+
getBuildKeysVisited :: Session (Either (TResponseError @ClientToServer (Method_CustomMethod "test")) [T.Text])
849849
getBuildKeysVisited = tryCallTestPlugin GetBuildKeysVisited
850850

851-
getBuildKeysChanged :: Session (Either ResponseError [T.Text])
851+
getBuildKeysChanged :: Session (Either (TResponseError @ClientToServer (Method_CustomMethod "test")) [T.Text])
852852
getBuildKeysChanged = tryCallTestPlugin GetBuildKeysChanged
853853

854-
getBuildEdgesCount :: Session (Either ResponseError Int)
854+
getBuildEdgesCount :: Session (Either (TResponseError @ClientToServer (Method_CustomMethod "test")) Int)
855855
getBuildEdgesCount = tryCallTestPlugin GetBuildEdgesCount
856856

857-
getRebuildsCount :: Session (Either ResponseError Int)
857+
getRebuildsCount :: Session (Either (TResponseError @ClientToServer (Method_CustomMethod "test")) Int)
858858
getRebuildsCount = tryCallTestPlugin GetRebuildsCount
859859

860860
-- Copy&paste from ghcide/test/Development.IDE.Test
861861
getStoredKeys :: Session [Text]
862862
getStoredKeys = callTestPlugin GetStoredKeys
863863

864864
-- Copy&paste from ghcide/test/Development.IDE.Test
865-
tryCallTestPlugin :: (A.FromJSON b) => TestRequest -> Session (Either ResponseError b)
865+
tryCallTestPlugin :: (A.FromJSON b) => TestRequest -> Session (Either (TResponseError @ClientToServer (Method_CustomMethod "test")) b)
866866
tryCallTestPlugin cmd = do
867867
let cm = SMethod_CustomMethod (Proxy @"test")
868868
waitId <- sendRequest cm (A.toJSON cmd)
@@ -878,5 +878,5 @@ callTestPlugin :: (A.FromJSON b) => TestRequest -> Session b
878878
callTestPlugin cmd = do
879879
res <- tryCallTestPlugin cmd
880880
case res of
881-
Left (ResponseError t err _) -> error $ show t <> ": " <> T.unpack err
882-
Right a -> pure a
881+
Left (TResponseError t err _) -> error $ show t <> ": " <> T.unpack err
882+
Right a -> pure a

‎ghcide-bench/test/Main.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -41,7 +41,7 @@ benchmarkTests =
4141
]
4242

4343
runInDir :: FilePath -> Session a -> IO a
44-
runInDir dir = runSessionWithConfig defaultConfig cmd fullCaps dir
44+
runInDir dir = runSessionWithConfig defaultConfig cmd fullLatestClientCaps dir
4545
where
4646
-- TODO use HLS instead of ghcide
4747
cmd = "ghcide --lsp --test --verbose -j2 --cwd " <> dir

‎ghcide/ghcide.cabal‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -88,8 +88,8 @@ library
8888
, implicit-hie >= 0.1.4.0 && < 0.1.5
8989
, lens
9090
, list-t
91-
, lsp ^>=2.6.0.0
92-
, lsp-types ^>=2.2.0.0
91+
, lsp ^>=2.7
92+
, lsp-types ^>=2.3
9393
, mtl
9494
, opentelemetry >=0.6.1
9595
, optparse-applicative

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

Lines changed: 8 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -90,7 +90,7 @@ runLanguageServer
9090
-> (config -> Value -> Either T.Text config)
9191
-> (config -> m config ())
9292
-> (MVar ()
93-
-> IO (LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either ResponseError (LSP.LanguageContextEnv config, a)),
93+
-> IO (LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either (TResponseError Method_Initialize) (LSP.LanguageContextEnv config, a)),
9494
LSP.Handlers (m config),
9595
(LanguageContextEnv config, a) -> m config <~> IO))
9696
-> IO ()
@@ -217,22 +217,24 @@ handleInit recorder defaultRoot getHieDbLoc getIdeState lifetime exitClientMsg c
217217
exceptionInHandler e = do
218218
logWith recorder Error $ LogReactorMessageActionException e
219219

220+
checkCancelled :: forall m . LspId m -> IO () -> (TResponseError m -> IO ()) -> IO ()
220221
checkCancelled _id act k =
221-
flip finally (clearReqId _id) $
222+
let sid = SomeLspId _id
223+
in flip finally (clearReqId sid) $
222224
catch (do
223225
-- We could optimize this by first checking if the id
224226
-- is in the cancelled set. However, this is unlikely to be a
225227
-- bottleneck and the additional check might hide
226228
-- issues with async exceptions that need to be fixed.
227-
cancelOrRes <- race (waitForCancel _id) act
229+
cancelOrRes <- race (waitForCancel sid) act
228230
case cancelOrRes of
229231
Left () -> do
230-
logWith recorder Debug $ LogCancelledRequest _id
231-
k $ ResponseError (InL LSPErrorCodes_RequestCancelled) "" Nothing
232+
logWith recorder Debug $ LogCancelledRequest sid
233+
k $ TResponseError (InL LSPErrorCodes_RequestCancelled) "" Nothing
232234
Right res -> pure res
233235
) $ \(e :: SomeException) -> do
234236
exceptionInHandler e
235-
k $ ResponseError (InR ErrorCodes_InternalError) (T.pack $ show e) Nothing
237+
k $ TResponseError (InR ErrorCodes_InternalError) (T.pack $ show e) Nothing
236238
_ <- flip forkFinally handleServerException $ do
237239
untilMVar lifetime $ runWithDb (cmapWithPrio LogSession recorder) dbLoc $ \withHieDb' hieChan' -> do
238240
putMVar dbMVar (WithHieDbShield withHieDb',hieChan')

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

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@ import UnliftIO.Chan
2222

2323
data ReactorMessage
2424
= ReactorNotification (IO ())
25-
| ReactorRequest SomeLspId (IO ()) (ResponseError -> IO ())
25+
| forall m . ReactorRequest (LspId m) (IO ()) (TResponseError m -> IO ())
2626

2727
type ReactorChan = Chan ReactorMessage
2828
newtype ServerM c a = ServerM { unServerM :: ReaderT (ReactorChan, IdeState) (LspM c) a }
@@ -31,17 +31,17 @@ newtype ServerM c a = ServerM { unServerM :: ReaderT (ReactorChan, IdeState) (Ls
3131
requestHandler
3232
:: forall m c. PluginMethod Request m =>
3333
SMethod m
34-
-> (IdeState -> MessageParams m -> LspM c (Either ResponseError (MessageResult m)))
34+
-> (IdeState -> MessageParams m -> LspM c (Either (TResponseError m) (MessageResult m)))
3535
-> Handlers (ServerM c)
3636
requestHandler m k = LSP.requestHandler m $ \TRequestMessage{_method,_id,_params} resp -> do
3737
st@(chan,ide) <- ask
3838
env <- LSP.getLspEnv
39-
let resp' :: Either ResponseError (MessageResult m) -> LspM c ()
39+
let resp' :: Either (TResponseError m) (MessageResult m) -> LspM c ()
4040
resp' = flip (runReaderT . unServerM) st . resp
4141
trace x = otTracedHandler "Request" (show _method) $ \sp -> do
4242
traceWithSpan sp _params
4343
x
44-
writeChan chan $ ReactorRequest (SomeLspId _id) (trace $ LSP.runLspT env $ resp' =<< k ide _params) (LSP.runLspT env . resp' . Left)
44+
writeChan chan $ ReactorRequest (_id) (trace $ LSP.runLspT env $ resp' =<< k ide _params) (LSP.runLspT env . resp' . Left)
4545

4646
notificationHandler
4747
:: forall m c. PluginMethod Notification m =>

‎ghcide/src/Development/IDE/Plugin/HLS.hs‎

Lines changed: 13 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -54,7 +54,7 @@ import UnliftIO.Exception (catchAny)
5454

5555
data Log
5656
= LogPluginError PluginId PluginError
57-
| LogResponseError PluginId ResponseError
57+
| forall m . A.ToJSON (ErrorData m) => LogResponseError PluginId (TResponseError m)
5858
| LogNoPluginForMethod (Some SMethod)
5959
| LogInvalidCommandIdentifier
6060
| ExceptionInPlugin PluginId (Some SMethod) SomeException
@@ -73,10 +73,10 @@ instance Pretty Log where
7373
<> pretty method <> ": " <> viaShow exception
7474
instance Show Log where show = renderString . layoutCompact . pretty
7575

76-
noPluginHandles :: Recorder (WithPriority Log) -> SMethod m -> [(PluginId, HandleRequestResult)] -> IO (Either ResponseError c)
76+
noPluginHandles :: Recorder (WithPriority Log) -> SMethod m -> [(PluginId, HandleRequestResult)] -> IO (Either (TResponseError m) c)
7777
noPluginHandles recorder m fs' = do
7878
logWith recorder Warning (LogNoPluginForMethod $ Some m)
79-
let err = ResponseError (InR ErrorCodes_MethodNotFound) msg Nothing
79+
let err = TResponseError (InR ErrorCodes_MethodNotFound) msg Nothing
8080
msg = noPluginHandlesMsg m fs'
8181
return $ Left err
8282
where noPluginHandlesMsg :: SMethod m -> [(PluginId, HandleRequestResult)] -> Text
@@ -112,9 +112,9 @@ exceptionInPlugin plId method exception =
112112
"Exception in plugin " <> T.pack (show plId) <> " while processing "<> T.pack (show method) <> ": " <> T.pack (show exception)
113113

114114
-- | Build a ResponseError and log it before returning to the caller
115-
logAndReturnError :: Recorder (WithPriority Log) -> PluginId -> (LSPErrorCodes |? ErrorCodes) -> Text -> LSP.LspT Config IO (Either ResponseError a)
115+
logAndReturnError :: A.ToJSON (ErrorData m) => Recorder (WithPriority Log) -> PluginId -> (LSPErrorCodes |? ErrorCodes) -> Text -> LSP.LspT Config IO (Either (TResponseError m) a)
116116
logAndReturnError recorder p errCode msg = do
117-
let err = ResponseError errCode msg Nothing
117+
let err = TResponseError errCode msg Nothing
118118
logWith recorder Warning $ LogResponseError p err
119119
pure $ Left err
120120

@@ -176,7 +176,7 @@ executeCommandHandlers recorder ecs = requestHandler SMethod_WorkspaceExecuteCom
176176
_ -> Nothing
177177

178178
-- The parameters to the HLS command are always the first element
179-
execCmd :: IdeState -> ExecuteCommandParams -> LSP.LspT Config IO (Either ResponseError (A.Value |? Null))
179+
execCmd :: IdeState -> ExecuteCommandParams -> LSP.LspT Config IO (Either (TResponseError Method_WorkspaceExecuteCommand) (A.Value |? Null))
180180
execCmd ide (ExecuteCommandParams mtoken cmdId args) = do
181181
let cmdParams :: A.Value
182182
cmdParams = case args of
@@ -196,8 +196,10 @@ executeCommandHandlers recorder ecs = requestHandler SMethod_WorkspaceExecuteCom
196196
-- If we have a command, continue to execute it
197197
Just (Command _ innerCmdId innerArgs)
198198
-> execCmd ide (ExecuteCommandParams Nothing innerCmdId innerArgs)
199+
-- TODO: This should be a response error?
199200
Nothing -> return $ Right $ InR Null
200201

202+
-- TODO: This should be a response error?
201203
A.Error _str -> return $ Right $ InR Null
202204

203205
-- Just an ordinary HIE command
@@ -206,9 +208,9 @@ executeCommandHandlers recorder ecs = requestHandler SMethod_WorkspaceExecuteCom
206208
-- Couldn't parse the command identifier
207209
_ -> do
208210
logWith recorder Warning LogInvalidCommandIdentifier
209-
return $ Left $ ResponseError (InR ErrorCodes_InvalidParams) "Invalid command identifier" Nothing
211+
return $ Left $ TResponseError (InR ErrorCodes_InvalidParams) "Invalid command identifier" Nothing
210212

211-
runPluginCommand :: IdeState -> PluginId -> CommandId -> Maybe ProgressToken -> A.Value -> LSP.LspT Config IO (Either ResponseError (A.Value |? Null))
213+
runPluginCommand :: IdeState -> PluginId -> CommandId -> Maybe ProgressToken -> A.Value -> LSP.LspT Config IO (Either (TResponseError Method_WorkspaceExecuteCommand) (A.Value |? Null))
212214
runPluginCommand ide p com mtoken arg =
213215
case Map.lookup p pluginMap of
214216
Nothing -> logAndReturnError recorder p (InR ErrorCodes_InvalidRequest) (pluginDoesntExist p)
@@ -314,13 +316,13 @@ runConcurrently msg method fs a b = forConcurrently fs $ \(pid,f) -> otTracedPro
314316
f a b -- See Note [Exception handling in plugins]
315317
`catchAny` (\e -> pure $ pure $ Left $ PluginInternalError (msg pid method e))
316318

317-
combineErrors :: NonEmpty (PluginId, PluginError) -> ResponseError
319+
combineErrors :: NonEmpty (PluginId, PluginError) -> TResponseError m
318320
combineErrors (x NE.:| []) = toResponseError x
319321
combineErrors xs = toResponseError $ NE.last $ NE.sortWith (toPriority . snd) xs
320322

321-
toResponseError :: (PluginId, PluginError) -> ResponseError
323+
toResponseError :: (PluginId, PluginError) -> TResponseError m
322324
toResponseError (PluginId plId, err) =
323-
ResponseError (toErrorCode err) (plId <> ": " <> tPretty err) Nothing
325+
TResponseError (toErrorCode err) (plId <> ": " <> tPretty err) Nothing
324326
where tPretty = T.pack . show . pretty
325327

326328
logErrors :: Recorder (WithPriority Log) -> [(PluginId, PluginError)] -> IO ()

‎ghcide/test/exe/Config.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -153,7 +153,7 @@ defToLocation (InR (InL defLink)) = (\(DefinitionLink LocationLink{_targetUri,_t
153153
defToLocation (InR (InR Null)) = []
154154

155155
lspTestCaps :: ClientCapabilities
156-
lspTestCaps = fullCaps { _window = Just $ WindowClientCapabilities (Just True) Nothing Nothing }
156+
lspTestCaps = fullLatestClientCaps { _window = Just $ WindowClientCapabilities (Just True) Nothing Nothing }
157157

158158
lspTestCapsNoFileWatches :: ClientCapabilities
159159
lspTestCapsNoFileWatches = lspTestCaps & L.workspace . traverse . L.didChangeWatchedFiles .~ Nothing

‎ghcide/test/exe/ExceptionTests.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -56,7 +56,7 @@ tests = do
5656
doc <- createDoc "A.hs" "haskell" "module A where"
5757
(view L.result -> lens) <- request SMethod_TextDocumentCodeLens (CodeLensParams Nothing Nothing doc)
5858
case lens of
59-
Left (ResponseError {_code = InR ErrorCodes_InternalError, _message}) ->
59+
Left (TResponseError {_code = InR ErrorCodes_InternalError, _message}) ->
6060
liftIO $ assertBool "We caught an error, but it wasn't ours!"
6161
(T.isInfixOf "divide by zero" _message && T.isInfixOf (coerce pluginId) _message)
6262
_ -> liftIO $ assertFailure $ show lens
@@ -80,7 +80,7 @@ tests = do
8080
execParams = ExecuteCommandParams Nothing (cmd ^. L.command) (cmd ^. L.arguments)
8181
(view L.result -> res) <- request SMethod_WorkspaceExecuteCommand execParams
8282
case res of
83-
Left (ResponseError {_code = InR ErrorCodes_InternalError, _message}) ->
83+
Left (TResponseError {_code = InR ErrorCodes_InternalError, _message}) ->
8484
liftIO $ assertBool "We caught an error, but it wasn't ours!"
8585
(T.isInfixOf "divide by zero" _message && T.isInfixOf (coerce pluginId) _message)
8686
_ -> liftIO $ assertFailure $ show res

0 commit comments

Comments
 (0)