Skip to content

Commit 5524332

Browse files
vidit-odvidit-od
committed
Server Diagnostics
1 parent b3b71b7 commit 5524332

2 files changed

Lines changed: 53 additions & 35 deletions

File tree

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

Lines changed: 15 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

@@ -253,3 +254,15 @@ mkFormattingHandlers f = mkPluginHandler SMethod_TextDocumentFormatting ( provid
253254
where
254255
uri = params ^. LSP.textDocument . LSP.uri
255256
opts = params ^. LSP.options
257+
258+
injectServerDiagnostics :: IdeState -> CodeActionParams -> IO CodeActionParams
259+
injectServerDiagnostics ide params@LSP.CodeActionParams{_textDocument=LSP.TextDocumentIdentifier{_uri}, _range, _context=context} = do
260+
let clientDiags = context ^. LSP.diagnostics
261+
serverDiags <- case LSP.uriToNormalizedFilePath (LSP.toNormalizedUri _uri) of
262+
Nothing -> pure clientDiags
263+
Just nfp -> do
264+
mDiags <- activeDiagnosticsInRange (shakeExtras ide) nfp _range
265+
case mDiags of
266+
Nothing -> pure clientDiags
267+
Just diags -> pure $ diags ^.. traverse . fdLspDiagnosticL
268+
pure $ params & LSP.context . LSP.diagnostics .~ serverDiags

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

Lines changed: 38 additions & 33 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
--
@@ -251,25 +252,29 @@ extensiblePlugins recorder plugins = mempty { P.pluginHandlers = handlers }
251252
handlers = mconcat $ do
252253
(IdeMethod m :=> IdeHandler fs') <- DMap.assocs handlers'
253254
pure $ requestHandler m $ \ide params -> do
255+
-- Intercept CodeAction requests and inject server-side diagnostics
256+
params' <- case m of
257+
SMethod_TextDocumentCodeAction -> liftIO $ injectServerDiagnostics ide params
258+
_ -> pure params
254259
config <- Ide.PluginUtils.getClientConfig
255260
-- Only run plugins that are allowed to run on this request, save the
256261
-- list of disabled plugins incase that's all we have
257-
let (fs, dfs) = List.partition (\(_, desc, _) -> handlesRequest m params desc config == HandlesRequest) fs'
258-
let disabledPluginsReason = (\(x, desc, _) -> (x, handlesRequest m params desc config)) <$> dfs
262+
let (fs, dfs) = List.partition (\(_, desc, _) -> handlesRequest m params' desc config == HandlesRequest) fs'
263+
let disabledPluginsReason = (\(x, desc, _) -> (x, handlesRequest m params' desc config)) <$> dfs
259264
-- Clients generally don't display ResponseErrors so instead we log any that we come across
260265
-- However, some clients do display ResponseErrors! See for example the issues:
261266
-- https://github.com/haskell/haskell-language-server/issues/4467
262267
-- https://github.com/haskell/haskell-language-server/issues/4451
263268
case nonEmpty fs of
264269
Nothing -> do
265-
liftIO (fallbackResolveHandler recorder m params) >>= \case
270+
liftIO (fallbackResolveHandler recorder m params') >>= \case
266271
Nothing ->
267272
liftIO $ noPluginHandles recorder m disabledPluginsReason
268273
Just result ->
269274
pure $ Right result
270275
Just neFs -> do
271276
let plidsAndHandlers = fmap (\(plid,_,handler) -> (plid,handler)) neFs
272-
es <- runHandlerM $ runConcurrently exceptionInPlugin m plidsAndHandlers ide params
277+
es <- runHandlerM $ runConcurrently exceptionInPlugin m plidsAndHandlers ide params'
273278
caps <- LSP.getClientCapabilities
274279
let (errs,succs) = partitionEithers $ toList $ join $ NE.zipWith (\(pId,_) -> fmap (first (pId,))) plidsAndHandlers es
275280
liftIO $ unless (null errs) $ logErrors recorder errs
@@ -285,7 +290,7 @@ extensiblePlugins recorder plugins = mempty { P.pluginHandlers = handlers }
285290
Nothing -> liftIO $ noPluginHandles recorder m (disabledPluginsReason <> asRefusedReason)
286291
Just xs -> pure $ Left $ combineErrors xs
287292
Just xs -> do
288-
pure $ Right $ combineResponses m config caps params xs
293+
pure $ Right $ combineResponses m config caps params' xs
289294

290295
-- | Fallback Handler for resolve requests.
291296
-- For all kinds of `*/resolve` requests, if they don't have a 'data_' value,

0 commit comments

Comments
 (0)