Skip to content

Commit 15595dc

Browse files
vidit-odvidit-od
committed
Prefer server diagnostics when computing code actions
Replace client-supplied diagnostics in CodeActionParams with server-side diagnostics when available, falling back otherwise. Required for consistent code action behavior.
1 parent b3b71b7 commit 15595dc

2 files changed

Lines changed: 54 additions & 31 deletions

File tree

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

Lines changed: 17 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -27,18 +27,18 @@ module Development.IDE.Core.PluginUtils
2727
-- * Diagnostics
2828
, activeDiagnosticsInRange
2929
, activeDiagnosticsInRangeMT
30+
, injectServerDiagnostics
3031
-- * Formatting handlers
3132
, mkFormattingHandlers) where
3233

3334
import Control.Concurrent.STM
34-
import Control.Lens ((^.))
35+
import Control.Lens
3536
import Control.Monad.Error.Class (MonadError (throwError))
3637
import Control.Monad.Extra
3738
import Control.Monad.IO.Class
3839
import Control.Monad.Reader (runReaderT)
3940
import Control.Monad.Trans.Except
4041
import Control.Monad.Trans.Maybe
41-
import Data.Functor.Identity
4242
import qualified Data.Text as T
4343
import qualified Data.Text.Utf16.Rope.Mixed as Rope
4444
import Development.IDE.Core.FileStore
@@ -60,6 +60,7 @@ import Ide.PluginUtils (rangesOverlap)
6060
import Ide.Types
6161
import qualified Language.LSP.Protocol.Lens as LSP
6262
import Language.LSP.Protocol.Message (SMethod (..))
63+
import Language.LSP.Protocol.Types (CodeActionParams)
6364
import qualified Language.LSP.Protocol.Types as LSP
6465
import qualified StmContainers.Map as STM
6566

@@ -223,6 +224,20 @@ activeDiagnosticsInRangeMT ide nfp range = do
223224
activeDiagnosticsInRange :: MonadIO m => Shake.ShakeExtras -> NormalizedFilePath -> LSP.Range -> m (Maybe [FileDiagnostic])
224225
activeDiagnosticsInRange ide nfp range = runMaybeT (activeDiagnosticsInRangeMT ide nfp range)
225226

227+
-- Prefer server-side diagnostics if available; they are authoritative.
228+
-- Fall back to client-supplied diagnostics when none are found.
229+
injectServerDiagnostics :: IdeState -> CodeActionParams -> IO CodeActionParams
230+
injectServerDiagnostics ide params@LSP.CodeActionParams{_textDocument=LSP.TextDocumentIdentifier{_uri}, _range, _context=context} = do
231+
let clientDiags = context ^. LSP.diagnostics
232+
serverDiags <- case LSP.uriToNormalizedFilePath (LSP.toNormalizedUri _uri) of
233+
Nothing -> pure clientDiags
234+
Just nfp -> do
235+
mDiags <- activeDiagnosticsInRange (shakeExtras ide) nfp _range
236+
case mDiags of
237+
Nothing -> pure clientDiags
238+
Just diags -> pure $ diags ^.. traverse . fdLspDiagnosticL
239+
pure $ params & LSP.context . LSP.diagnostics .~ serverDiags
240+
226241
-- ----------------------------------------------------------------------------
227242
-- Formatting handlers
228243
-- ----------------------------------------------------------------------------

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

Lines changed: 37 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -9,49 +9,50 @@ module Development.IDE.Plugin.HLS
99
, Log(..)
1010
) where
1111

12-
import Control.Exception (SomeException)
13-
import Control.Lens ((^.))
12+
import Control.Exception (SomeException)
13+
import Control.Lens ((^.))
1414
import Control.Monad
15-
import qualified Control.Monad.Extra as Extra
16-
import Control.Monad.IO.Class (MonadIO)
17-
import Control.Monad.Trans.Except (runExceptT)
18-
import qualified Data.Aeson as A
19-
import Data.Bifunctor (first)
20-
import Data.Dependent.Map (DMap)
21-
import qualified Data.Dependent.Map as DMap
15+
import qualified Control.Monad.Extra as Extra
16+
import Control.Monad.IO.Class (MonadIO)
17+
import Control.Monad.Trans.Except (runExceptT)
18+
import qualified Data.Aeson as A
19+
import Data.Bifunctor (first)
20+
import Data.Dependent.Map (DMap)
21+
import qualified Data.Dependent.Map as DMap
2222
import Data.Dependent.Sum
2323
import Data.Either
24-
import qualified Data.List as List
25-
import Data.List.NonEmpty (NonEmpty, nonEmpty, toList)
26-
import qualified Data.List.NonEmpty as NE
27-
import qualified Data.Map as Map
28-
import Data.Maybe (isNothing, mapMaybe)
24+
import qualified Data.List as List
25+
import Data.List.NonEmpty (NonEmpty, nonEmpty, toList)
26+
import qualified Data.List.NonEmpty as NE
27+
import qualified Data.Map as Map
28+
import Data.Maybe (isNothing, mapMaybe)
2929
import Data.Some
3030
import Data.String
31-
import Data.Text (Text)
32-
import qualified Data.Text as T
33-
import Development.IDE.Core.Shake hiding (Log)
31+
import Data.Text (Text)
32+
import qualified Data.Text as T
33+
import Development.IDE.Core.PluginUtils (injectServerDiagnostics)
34+
import Development.IDE.Core.Shake hiding (Log)
3435
import Development.IDE.Core.Tracing
35-
import Development.IDE.Graph (Rules)
36+
import Development.IDE.Graph (Rules)
3637
import Development.IDE.LSP.Server
3738
import Development.IDE.Plugin
38-
import qualified Development.IDE.Plugin as P
39+
import qualified Development.IDE.Plugin as P
3940
import Ide.Logger
4041
import Ide.Plugin.Config
4142
import Ide.Plugin.Error
4243
import Ide.Plugin.HandleRequestTypes
43-
import Ide.PluginUtils (getClientConfig)
44-
import Ide.Types as HLS
45-
import qualified Language.LSP.Protocol.Lens as JL
44+
import Ide.PluginUtils (getClientConfig)
45+
import Ide.Types as HLS
46+
import qualified Language.LSP.Protocol.Lens as JL
4647
import Language.LSP.Protocol.Message
4748
import Language.LSP.Protocol.Types
48-
import qualified Language.LSP.Server as LSP
49+
import qualified Language.LSP.Server as LSP
4950
import Language.LSP.VFS
50-
import Prettyprinter.Render.String (renderString)
51-
import Text.Regex.TDFA.Text ()
52-
import UnliftIO (MonadUnliftIO, liftIO)
53-
import UnliftIO.Async (forConcurrently)
54-
import UnliftIO.Exception (catchAny)
51+
import Prettyprinter.Render.String (renderString)
52+
import Text.Regex.TDFA.Text ()
53+
import UnliftIO (MonadUnliftIO, liftIO)
54+
import UnliftIO.Async (forConcurrently)
55+
import UnliftIO.Exception (catchAny)
5556

5657
-- ---------------------------------------------------------------------
5758
--
@@ -250,7 +251,14 @@ extensiblePlugins recorder plugins = mempty { P.pluginHandlers = handlers }
250251
PluginHandlers hs = HLS.pluginHandlers pluginDesc
251252
handlers = mconcat $ do
252253
(IdeMethod m :=> IdeHandler fs') <- DMap.assocs handlers'
253-
pure $ requestHandler m $ \ide params -> do
254+
pure $ requestHandler m $ \ide params' -> do
255+
-- issue https://github.com/haskell/haskell-language-server/issues/4056
256+
-- established that HLS should rely on server-side diagnostics to compute codeaction
257+
-- To ensure consistency, we intercept codeAction requests and explicitly inject
258+
-- server-side diagnostics before delegating to the plugin handler.
259+
params <- case m of
260+
SMethod_TextDocumentCodeAction -> liftIO $ injectServerDiagnostics ide params'
261+
_ -> pure params'
254262
config <- Ide.PluginUtils.getClientConfig
255263
-- Only run plugins that are allowed to run on this request, save the
256264
-- list of disabled plugins incase that's all we have

0 commit comments

Comments
 (0)