Bump to new lsp versions

cabal.project

@@ -7,7 +7,7 @@ packages:
          ./hls-plugin-api
          ./hls-test-utils
 
-index-state: 2024-05-10T00:00:00Z
+index-state: 2024-06-07T00:00:00Z
 
 tests: True
 test-show-details: direct

exe/Wrapper.hs

@@ -1,4 +1,4 @@
 {-# LANGUAGE CPP               #-}
 {-# LANGUAGE DataKinds         #-}
 {-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -48,9 +48,9 @@
 import           Ide.Plugin.Config                  (Config)
 import           Ide.Types                          (IdePlugins (IdePlugins))
 import           Language.LSP.Protocol.Message      (Method (Method_Initialize),
-                                                     ResponseError,
                                                      SMethod (SMethod_Exit, SMethod_WindowShowMessageRequest),
-                                                     TRequestMessage)
+                                                     TRequestMessage,
+                                                     TResponseError)
 import           Language.LSP.Protocol.Types        (MessageActionItem (MessageActionItem),
                                                      MessageType (MessageType_Error),
                                                      ShowMessageRequestParams (ShowMessageRequestParams),
@@ -283,7 +283,7 @@
         -- Forcefully exit
         let exit = void $ tryPutMVar clientMsgVar ()
 
-        let doInitialize :: LSP.LanguageContextEnv Config -> TRequestMessage Method_Initialize -> IO (Either ResponseError (LSP.LanguageContextEnv Config, ()))
+        let doInitialize :: LSP.LanguageContextEnv Config -> TRequestMessage Method_Initialize -> IO (Either (TResponseError Method_Initialize) (LSP.LanguageContextEnv Config, ()))
             doInitialize env _ = do
 
               let restartTitle = "Try to restart"

ghcide-bench/src/Experiments.hs

@@ -557,7 +557,7 @@ runBenchmarksFun dir allBenchmarks = do
             ]
           ++ ["--ot-memory-profiling" | Just _ <- [otMemoryProfiling ?config]]
     lspTestCaps =
-      fullCaps
+      fullLatestClientCaps
         & (L.window . _Just) .~ WindowClientCapabilities (Just True) Nothing Nothing
         & (L.textDocument . _Just . L.codeAction . _Just . L.resolveSupport . _Just) .~ (ClientCodeActionResolveOptions ["edit"])
         & (L.textDocument . _Just . L.codeAction . _Just . L.dataSupport . _Just) .~ True
@@ -842,27 +842,27 @@ searchSymbol doc@TextDocumentIdentifier{_uri} fileContents pos = do
         not . null <$> getCompletions doc pos
 
 
-getBuildKeysBuilt :: Session (Either ResponseError [T.Text])
+getBuildKeysBuilt :: Session (Either (TResponseError @ClientToServer (Method_CustomMethod "test")) [T.Text])
 getBuildKeysBuilt = tryCallTestPlugin GetBuildKeysBuilt
 
-getBuildKeysVisited :: Session (Either ResponseError [T.Text])
+getBuildKeysVisited :: Session (Either (TResponseError @ClientToServer (Method_CustomMethod "test")) [T.Text])
 getBuildKeysVisited = tryCallTestPlugin GetBuildKeysVisited
 
-getBuildKeysChanged :: Session (Either ResponseError [T.Text])
+getBuildKeysChanged :: Session (Either (TResponseError @ClientToServer (Method_CustomMethod "test")) [T.Text])
 getBuildKeysChanged = tryCallTestPlugin GetBuildKeysChanged
 
-getBuildEdgesCount :: Session (Either ResponseError Int)
+getBuildEdgesCount :: Session (Either (TResponseError @ClientToServer (Method_CustomMethod "test")) Int)
 getBuildEdgesCount = tryCallTestPlugin GetBuildEdgesCount
 
-getRebuildsCount :: Session (Either ResponseError Int)
+getRebuildsCount :: Session (Either (TResponseError @ClientToServer (Method_CustomMethod "test")) Int)
 getRebuildsCount = tryCallTestPlugin GetRebuildsCount
 
 -- Copy&paste from ghcide/test/Development.IDE.Test
 getStoredKeys :: Session [Text]
 getStoredKeys = callTestPlugin GetStoredKeys
 
 -- Copy&paste from ghcide/test/Development.IDE.Test
-tryCallTestPlugin :: (A.FromJSON b) => TestRequest -> Session (Either ResponseError b)
+tryCallTestPlugin :: (A.FromJSON b) => TestRequest -> Session (Either (TResponseError @ClientToServer (Method_CustomMethod "test")) b)
 tryCallTestPlugin cmd = do
     let cm = SMethod_CustomMethod (Proxy @"test")
     waitId <- sendRequest cm (A.toJSON cmd)
@@ -878,5 +878,5 @@ callTestPlugin :: (A.FromJSON b) => TestRequest -> Session b
 callTestPlugin cmd = do
     res <- tryCallTestPlugin cmd
     case res of
-        Left (ResponseError t err _) -> error $ show t <> ": " <> T.unpack err
-        Right a                      -> pure a
+        Left (TResponseError t err _) -> error $ show t <> ": " <> T.unpack err
+        Right a                       -> pure a

ghcide-bench/test/Main.hs

@@ -41,7 +41,7 @@ benchmarkTests =
     ]
 
 runInDir :: FilePath -> Session a -> IO a
-runInDir dir = runSessionWithConfig defaultConfig cmd fullCaps dir
+runInDir dir = runSessionWithConfig defaultConfig cmd fullLatestClientCaps dir
   where
     -- TODO use HLS instead of ghcide
     cmd = "ghcide --lsp --test --verbose -j2 --cwd " <> dir

ghcide/ghcide.cabal

@@ -88,8 +88,8 @@ library
     , implicit-hie                 >= 0.1.4.0 && < 0.1.5
     , lens
     , list-t
-    , lsp                          ^>=2.6.0.0
-    , lsp-types                    ^>=2.2.0.0
+    , lsp                          ^>=2.7
+    , lsp-types                    ^>=2.3
     , mtl
     , opentelemetry                >=0.6.1
     , optparse-applicative

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

@@ -90,7 +90,7 @@ runLanguageServer
     -> (config -> Value -> Either T.Text config)
     -> (config -> m config ())
     -> (MVar ()
-        -> IO (LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either ResponseError (LSP.LanguageContextEnv config, a)),
+        -> IO (LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either (TResponseError Method_Initialize) (LSP.LanguageContextEnv config, a)),
                LSP.Handlers (m config),
                (LanguageContextEnv config, a) -> m config <~> IO))
     -> IO ()
@@ -217,22 +217,24 @@ handleInit recorder defaultRoot getHieDbLoc getIdeState lifetime exitClientMsg c
         exceptionInHandler e = do
             logWith recorder Error $ LogReactorMessageActionException e
 
+        checkCancelled :: forall m . LspId m -> IO () -> (TResponseError m -> IO ()) -> IO ()
         checkCancelled _id act k =
-            flip finally (clearReqId _id) $
+            let sid = SomeLspId _id
+            in flip finally (clearReqId sid) $
                 catch (do
                     -- We could optimize this by first checking if the id
                     -- is in the cancelled set. However, this is unlikely to be a
                     -- bottleneck and the additional check might hide
                     -- issues with async exceptions that need to be fixed.
-                    cancelOrRes <- race (waitForCancel _id) act
+                    cancelOrRes <- race (waitForCancel sid) act
                     case cancelOrRes of
                         Left () -> do
-                            logWith recorder Debug $ LogCancelledRequest _id
-                            k $ ResponseError (InL LSPErrorCodes_RequestCancelled) "" Nothing
+                            logWith recorder Debug $ LogCancelledRequest sid
+                            k $ TResponseError (InL LSPErrorCodes_RequestCancelled) "" Nothing
                         Right res -> pure res
                 ) $ \(e :: SomeException) -> do
                     exceptionInHandler e
-                    k $ ResponseError (InR ErrorCodes_InternalError) (T.pack $ show e) Nothing
+                    k $ TResponseError (InR ErrorCodes_InternalError) (T.pack $ show e) Nothing
     _ <- flip forkFinally handleServerException $ do
         untilMVar lifetime $ runWithDb (cmapWithPrio LogSession recorder) dbLoc $ \withHieDb' hieChan' -> do
             putMVar dbMVar (WithHieDbShield withHieDb',hieChan')

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

@@ -22,7 +22,7 @@ import           UnliftIO.Chan
 
 data ReactorMessage
   = ReactorNotification (IO ())
-  | ReactorRequest SomeLspId (IO ()) (ResponseError -> IO ())
+  | forall m . ReactorRequest (LspId m) (IO ()) (TResponseError m -> IO ())
 
 type ReactorChan = Chan ReactorMessage
 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
 requestHandler
   :: forall m c. PluginMethod Request m =>
      SMethod m
-  -> (IdeState -> MessageParams m -> LspM c (Either ResponseError (MessageResult m)))
+  -> (IdeState -> MessageParams m -> LspM c (Either (TResponseError m) (MessageResult m)))
   -> Handlers (ServerM c)
 requestHandler m k = LSP.requestHandler m $ \TRequestMessage{_method,_id,_params} resp -> do
   st@(chan,ide) <- ask
   env <- LSP.getLspEnv
-  let resp' :: Either ResponseError (MessageResult m) -> LspM c ()
+  let resp' :: Either (TResponseError m) (MessageResult m) -> LspM c ()
       resp' = flip (runReaderT . unServerM) st . resp
       trace x = otTracedHandler "Request" (show _method) $ \sp -> do
         traceWithSpan sp _params
         x
-  writeChan chan $ ReactorRequest (SomeLspId _id) (trace $ LSP.runLspT env $ resp' =<< k ide _params) (LSP.runLspT env . resp' . Left)
+  writeChan chan $ ReactorRequest (_id) (trace $ LSP.runLspT env $ resp' =<< k ide _params) (LSP.runLspT env . resp' . Left)
 
 notificationHandler
   :: forall m c. PluginMethod Notification m =>

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

@@ -54,7 +54,7 @@ import           UnliftIO.Exception            (catchAny)
 
 data Log
     =  LogPluginError PluginId PluginError
-    | LogResponseError PluginId ResponseError
+    | forall m . A.ToJSON (ErrorData m) => LogResponseError PluginId (TResponseError m)
     | LogNoPluginForMethod (Some SMethod)
     | LogInvalidCommandIdentifier
     | ExceptionInPlugin PluginId (Some SMethod) SomeException
@@ -73,10 +73,10 @@ instance Pretty Log where
           <> pretty method <> ": " <> viaShow exception
 instance Show Log where show = renderString . layoutCompact . pretty
 
-noPluginHandles :: Recorder (WithPriority Log) -> SMethod m -> [(PluginId, HandleRequestResult)] -> IO (Either ResponseError c)
+noPluginHandles :: Recorder (WithPriority Log) -> SMethod m -> [(PluginId, HandleRequestResult)] -> IO (Either (TResponseError m) c)
 noPluginHandles recorder m fs' = do
   logWith recorder Warning (LogNoPluginForMethod $ Some m)
-  let err = ResponseError (InR ErrorCodes_MethodNotFound) msg Nothing
+  let err = TResponseError (InR ErrorCodes_MethodNotFound) msg Nothing
       msg = noPluginHandlesMsg m fs'
   return $ Left err
   where noPluginHandlesMsg :: SMethod m -> [(PluginId, HandleRequestResult)] -> Text
@@ -112,9 +112,9 @@ exceptionInPlugin plId method exception =
     "Exception in plugin " <> T.pack (show plId) <> " while processing "<> T.pack (show method) <> ": " <> T.pack (show exception)
 
 -- | Build a ResponseError and log it before returning to the caller
-logAndReturnError :: Recorder (WithPriority Log) -> PluginId -> (LSPErrorCodes |? ErrorCodes) -> Text -> LSP.LspT Config IO (Either ResponseError a)
+logAndReturnError :: A.ToJSON (ErrorData m) => Recorder (WithPriority Log) -> PluginId -> (LSPErrorCodes |? ErrorCodes) -> Text -> LSP.LspT Config IO (Either (TResponseError m) a)
 logAndReturnError recorder p errCode msg = do
-    let err = ResponseError errCode msg Nothing
+    let err = TResponseError errCode msg Nothing
     logWith recorder Warning $ LogResponseError p err
     pure $ Left err
 
@@ -176,7 +176,7 @@ executeCommandHandlers recorder ecs = requestHandler SMethod_WorkspaceExecuteCom
       _                    -> Nothing
 
     -- The parameters to the HLS command are always the first element
-    execCmd :: IdeState -> ExecuteCommandParams -> LSP.LspT Config IO (Either ResponseError (A.Value |? Null))
+    execCmd :: IdeState -> ExecuteCommandParams -> LSP.LspT Config IO (Either (TResponseError Method_WorkspaceExecuteCommand) (A.Value |? Null))
     execCmd ide (ExecuteCommandParams mtoken cmdId args) = do
       let cmdParams :: A.Value
           cmdParams = case args of
@@ -196,8 +196,10 @@ executeCommandHandlers recorder ecs = requestHandler SMethod_WorkspaceExecuteCom
                 -- If we have a command, continue to execute it
                 Just (Command _ innerCmdId innerArgs)
                     -> execCmd ide (ExecuteCommandParams Nothing innerCmdId innerArgs)
+                -- TODO: This should be a response error?
                 Nothing -> return $ Right $ InR Null
 
+            -- TODO: This should be a response error?
             A.Error _str -> return $ Right $ InR Null
 
         -- Just an ordinary HIE command
@@ -206,9 +208,9 @@ executeCommandHandlers recorder ecs = requestHandler SMethod_WorkspaceExecuteCom
         -- Couldn't parse the command identifier
         _ -> do
             logWith recorder Warning LogInvalidCommandIdentifier
-            return $ Left $ ResponseError (InR ErrorCodes_InvalidParams) "Invalid command identifier" Nothing
+            return $ Left $ TResponseError (InR ErrorCodes_InvalidParams) "Invalid command identifier" Nothing
 
-    runPluginCommand :: IdeState -> PluginId -> CommandId -> Maybe ProgressToken -> A.Value -> LSP.LspT Config IO (Either ResponseError (A.Value |? Null))
+    runPluginCommand :: IdeState -> PluginId -> CommandId -> Maybe ProgressToken -> A.Value -> LSP.LspT Config IO (Either (TResponseError Method_WorkspaceExecuteCommand) (A.Value |? Null))
     runPluginCommand ide p com mtoken arg =
       case Map.lookup p pluginMap  of
         Nothing -> logAndReturnError recorder p (InR ErrorCodes_InvalidRequest) (pluginDoesntExist p)
@@ -314,13 +316,13 @@ runConcurrently msg method fs a b = forConcurrently fs $ \(pid,f) -> otTracedPro
   f a b  -- See Note [Exception handling in plugins]
      `catchAny` (\e -> pure $ pure $ Left $ PluginInternalError (msg pid method e))
 
-combineErrors :: NonEmpty (PluginId, PluginError) -> ResponseError
+combineErrors :: NonEmpty (PluginId, PluginError) -> TResponseError m
 combineErrors (x NE.:| []) = toResponseError x
 combineErrors xs = toResponseError $ NE.last $ NE.sortWith (toPriority . snd) xs
 
-toResponseError :: (PluginId, PluginError) -> ResponseError
+toResponseError :: (PluginId, PluginError) -> TResponseError m
 toResponseError (PluginId plId, err) =
-        ResponseError (toErrorCode err) (plId <> ": " <> tPretty err) Nothing
+        TResponseError (toErrorCode err) (plId <> ": " <> tPretty err) Nothing
     where tPretty = T.pack . show . pretty
 
 logErrors :: Recorder (WithPriority Log) -> [(PluginId, PluginError)] -> IO ()

ghcide/test/exe/Config.hs

@@ -153,7 +153,7 @@ defToLocation (InR (InL defLink)) = (\(DefinitionLink LocationLink{_targetUri,_t
 defToLocation (InR (InR Null)) = []
 
 lspTestCaps :: ClientCapabilities
-lspTestCaps = fullCaps { _window = Just $ WindowClientCapabilities (Just True) Nothing Nothing }
+lspTestCaps = fullLatestClientCaps { _window = Just $ WindowClientCapabilities (Just True) Nothing Nothing }
 
 lspTestCapsNoFileWatches :: ClientCapabilities
 lspTestCapsNoFileWatches = lspTestCaps & L.workspace . traverse . L.didChangeWatchedFiles .~ Nothing

ghcide/test/exe/ExceptionTests.hs

@@ -56,7 +56,7 @@ tests = do
               doc <- createDoc "A.hs" "haskell" "module A where"
               (view L.result -> lens) <- request SMethod_TextDocumentCodeLens (CodeLensParams Nothing Nothing doc)
               case lens of
-                Left (ResponseError {_code = InR ErrorCodes_InternalError, _message}) ->
+                Left (TResponseError {_code = InR ErrorCodes_InternalError, _message}) ->
                     liftIO $ assertBool "We caught an error, but it wasn't ours!"
                           (T.isInfixOf "divide by zero" _message && T.isInfixOf (coerce pluginId) _message)
                 _ -> liftIO $ assertFailure $ show lens
@@ -80,7 +80,7 @@ tests = do
                   execParams = ExecuteCommandParams Nothing (cmd ^. L.command) (cmd ^. L.arguments)
               (view L.result -> res) <- request SMethod_WorkspaceExecuteCommand execParams
               case res of
-                Left (ResponseError {_code = InR ErrorCodes_InternalError, _message}) ->
+                Left (TResponseError {_code = InR ErrorCodes_InternalError, _message}) ->
                   liftIO $ assertBool "We caught an error, but it wasn't ours!"
                           (T.isInfixOf "divide by zero" _message && T.isInfixOf (coerce pluginId) _message)
                 _ -> liftIO $ assertFailure $ show res

haskell-language-server.cabal

@@ -259,8 +259,8 @@ library hls-cabal-plugin
     , hls-plugin-api        == 2.8.0.0
     , hls-graph             == 2.8.0.0
     , lens
-    , lsp                   ^>=2.6
-    , lsp-types             ^>=2.2
+    , lsp                   ^>=2.7
+    , lsp-types             ^>=2.3
     , regex-tdfa            ^>=1.3.1
     , text
     , text-rope
@@ -390,7 +390,7 @@ library hls-call-hierarchy-plugin
     , hiedb                 ^>= 0.6.0.0
     , hls-plugin-api        == 2.8.0.0
     , lens
-    , lsp                    >=2.6
+    , lsp                    >=2.7
     , sqlite-simple
     , text
 
@@ -1004,7 +1004,7 @@ library hls-alternate-number-format-plugin
     , hls-graph
     , hls-plugin-api       == 2.8.0.0
     , lens
-    , lsp                  ^>=2.6
+    , lsp                  ^>=2.7
     , mtl
     , regex-tdfa
     , syb
@@ -1234,7 +1234,7 @@ library hls-gadt-plugin
     , hls-plugin-api         == 2.8.0.0
     , haskell-language-server:hls-refactor-plugin
     , lens
-    , lsp                    >=2.6
+    , lsp                    >=2.7
     , mtl
     , text
     , transformers
@@ -1283,7 +1283,7 @@ library hls-explicit-fixity-plugin
     , ghcide                == 2.8.0.0
     , hashable
     , hls-plugin-api        == 2.8.0.0
-    , lsp                   >=2.6
+    , lsp                   >=2.7
     , text
 
   default-extensions: DataKinds
@@ -1426,7 +1426,7 @@ library hls-floskell-plugin
     , floskell        ^>=0.11.0
     , ghcide          == 2.8.0.0
     , hls-plugin-api  == 2.8.0.0
-    , lsp-types       ^>=2.2
+    , lsp-types       ^>=2.3
     , mtl
     , text
 
@@ -1806,7 +1806,7 @@ library hls-notes-plugin
     , hls-graph == 2.8.0.0
     , hls-plugin-api == 2.8.0.0
     , lens
-    , lsp >=2.6
+    , lsp >=2.7
     , mtl >= 2.2
     , regex-tdfa >= 1.3.1
     , text
@@ -2113,7 +2113,7 @@ test-suite ghcide-tests
     , lens
     , list-t
     , lsp
-    , lsp-test                ^>=0.17.0.1
+    , lsp-test                ^>=0.17.1
     , lsp-types
     , monoid-subclasses
     , mtl

hls-plugin-api/hls-plugin-api.cabal

@@ -69,7 +69,7 @@ library
     , hls-graph             == 2.8.0.0
     , lens
     , lens-aeson
-    , lsp                   ^>=2.6
+    , lsp                   ^>=2.7
     , megaparsec            >=9.0
     , mtl
     , opentelemetry         >=0.4

hls-plugin-api/src/Ide/Plugin/Resolve.hs

@@ -38,7 +38,7 @@ import           Language.LSP.Server           (LspT, getClientCapabilities,
 
 data Log
     = DoesNotSupportResolve T.Text
-    | ApplyWorkspaceEditFailed ResponseError
+    | forall m . A.ToJSON (ErrorData m) => ApplyWorkspaceEditFailed (TResponseError m)
 instance Pretty Log where
     pretty = \case
         DoesNotSupportResolve fallback->

hls-test-utils/hls-test-utils.cabal

@@ -48,7 +48,7 @@ library
     , lens
     , lsp
     , lsp-test                ^>=0.17
-    , lsp-types               ^>=2.2
+    , lsp-types               ^>=2.3
     , neat-interpolation
     , safe-exceptions
     , tasty