Skip to content

Commit ca5ce66

Browse files
soulomoonsoulomoon
authored
Merge branch 'master' into 1875-tests-randomly-fail-with-exception-fd111-hputbuf-resource-vanished-broken-pipe---test-option-j1-workaround
2 parents 99c835e + d2b3462 commit ca5ce66

5 files changed

Lines changed: 63 additions & 34 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

@@ -223,6 +224,18 @@ 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+
injectServerDiagnostics :: IdeState -> CodeActionParams -> IO CodeActionParams
229+
injectServerDiagnostics ide params@LSP.CodeActionParams{_textDocument=LSP.TextDocumentIdentifier{_uri}, _range} = do
230+
serverDiags <- case LSP.uriToNormalizedFilePath (LSP.toNormalizedUri _uri) of
231+
Nothing -> pure []
232+
Just nfp -> do
233+
mDiags <- activeDiagnosticsInRange (shakeExtras ide) nfp _range
234+
case mDiags of
235+
Nothing -> pure []
236+
Just diags -> pure $ diags ^.. traverse . fdLspDiagnosticL
237+
pure $ params & LSP.context . LSP.diagnostics .~ serverDiags
238+
226239
-- ----------------------------------------------------------------------------
227240
-- Formatting handlers
228241
-- ----------------------------------------------------------------------------

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

Lines changed: 44 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -9,50 +9,51 @@ 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-
readTVarIO)
54-
import UnliftIO.Async (forConcurrently)
55-
import UnliftIO.Exception (catchAny)
51+
import Prettyprinter.Render.String (renderString)
52+
import Text.Regex.TDFA.Text ()
53+
import UnliftIO (MonadUnliftIO, liftIO,
54+
readTVarIO)
55+
import UnliftIO.Async (forConcurrently)
56+
import UnliftIO.Exception (catchAny)
5657

5758
-- ---------------------------------------------------------------------
5859
--
@@ -251,8 +252,9 @@ extensiblePlugins recorder plugins = mempty { P.pluginHandlers = handlers }
251252
PluginHandlers hs = HLS.pluginHandlers pluginDesc
252253
handlers = mconcat $ do
253254
(IdeMethod m :=> IdeHandler fs') <- DMap.assocs handlers'
254-
pure $ requestHandler m $ \ide params -> do
255+
pure $ requestHandler m $ \ide params' -> do
255256
vfs <- readTVarIO $ vfsVar $ shakeExtras ide
257+
params <- liftIO $ preprocessMessageParams ide m params'
256258
config <- Ide.PluginUtils.getClientConfig
257259
-- Only run plugins that are allowed to run on this request, save the
258260
-- list of disabled plugins incase that's all we have
@@ -289,6 +291,18 @@ extensiblePlugins recorder plugins = mempty { P.pluginHandlers = handlers }
289291
Just xs -> do
290292
pure $ Right $ combineResponses m config caps params xs
291293

294+
295+
-- | Preprocess 'MessageParams' and insert custom data.
296+
--
297+
-- In issue https://github.com/haskell/haskell-language-server/issues/4056, we
298+
-- established that HLS should rely on server-side 'Diagnostic's to compute 'CodeAction's
299+
-- To ensure consistency, we intercept 'CodeAction's requests and explicitly inject
300+
-- server-side 'Diagnostic's before delegating to the 'PluginHandler'.
301+
preprocessMessageParams :: IdeState -> SMethod m -> MessageParams m -> IO (MessageParams m)
302+
preprocessMessageParams ide m params = case m of
303+
SMethod_TextDocumentCodeAction -> injectServerDiagnostics ide params
304+
_ -> pure params
305+
292306
-- | Fallback Handler for resolve requests.
293307
-- For all kinds of `*/resolve` requests, if they don't have a 'data_' value,
294308
-- produce the original item, since no other plugin has any resolve data.

‎plugins/hls-hlint-plugin/test/Main.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -218,8 +218,8 @@ suggestionsTests =
218218
doc <- openDoc "TwoHints.hs" "haskell"
219219
_ <- hlintCaptureKick
220220

221-
firstLine <- map fromAction <$> getCodeActions doc (mkRange 0 0 0 0)
222-
secondLine <- map fromAction <$> getCodeActions doc (mkRange 1 0 1 0)
221+
firstLine <- map fromAction <$> getCodeActions doc (mkRange 0 0 1 0)
222+
secondLine <- map fromAction <$> getCodeActions doc (mkRange 1 0 2 0)
223223
thirdLine <- map fromAction <$> getCodeActions doc (mkRange 2 0 2 0)
224224
multiLine <- map fromAction <$> getCodeActions doc (mkRange 0 0 2 0)
225225

‎stack-lts22.yaml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@ allow-newer-deps:
1717
- directory-ospath-streaming
1818

1919
extra-deps:
20+
- extra-1.8.1
2021
- Diff-0.5
2122
- hiedb-0.8.0.0
2223
- hie-bios-0.18.0

‎stack.yaml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,7 @@ allow-newer-deps:
1919
- directory-ospath-streaming
2020

2121
extra-deps:
22+
- extra-1.8.1
2223
- hiedb-0.8.0.0
2324
- hie-compat-0.3.1.2
2425
- implicit-hie-0.1.4.0

0 commit comments

Comments
 (0)