Skip to content

Commit 8114dc3

Browse files
mergify[bot]mergify[bot]
authored
Merge branch 'master' into dependabot/github_actions/dot-github/actions/setup-build/haskell-actions/setup-2.7.9
2 parents 7137df3 + 9b0c3c0 commit 8114dc3

File tree

6 files changed

+302
-9
lines changed

6 files changed

+302
-9
lines changed

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

Lines changed: 83 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,10 @@ module Development.IDE.Plugin.HLS
1010
) where
1111

1212
import Control.Exception (SomeException)
13+
import Control.Lens ((^.))
1314
import Control.Monad
15+
import qualified Control.Monad.Extra as Extra
16+
import Control.Monad.IO.Class (MonadIO)
1417
import Control.Monad.Trans.Except (runExceptT)
1518
import qualified Data.Aeson as A
1619
import Data.Bifunctor (first)
@@ -22,7 +25,7 @@ import qualified Data.List as List
2225
import Data.List.NonEmpty (NonEmpty, nonEmpty, toList)
2326
import qualified Data.List.NonEmpty as NE
2427
import qualified Data.Map as Map
25-
import Data.Maybe (mapMaybe)
28+
import Data.Maybe (isNothing, mapMaybe)
2629
import Data.Some
2730
import Data.String
2831
import Data.Text (Text)
@@ -39,6 +42,7 @@ import Ide.Plugin.Error
3942
import Ide.Plugin.HandleRequestTypes
4043
import Ide.PluginUtils (getClientConfig)
4144
import Ide.Types as HLS
45+
import qualified Language.LSP.Protocol.Lens as JL
4246
import Language.LSP.Protocol.Message
4347
import Language.LSP.Protocol.Types
4448
import qualified Language.LSP.Server as LSP
@@ -58,6 +62,7 @@ data Log
5862
| LogNoPluginForMethod (Some SMethod)
5963
| LogInvalidCommandIdentifier
6064
| ExceptionInPlugin PluginId (Some SMethod) SomeException
65+
| LogResolveDefaultHandler (Some SMethod)
6166

6267
instance Pretty Log where
6368
pretty = \case
@@ -71,6 +76,8 @@ instance Pretty Log where
7176
ExceptionInPlugin plId (Some method) exception ->
7277
"Exception in plugin " <> viaShow plId <> " while processing "
7378
<> pretty method <> ": " <> viaShow exception
79+
LogResolveDefaultHandler (Some method) ->
80+
"No plugin can handle" <+> pretty method <+> "request. Return object unchanged."
7481
instance Show Log where show = renderString . layoutCompact . pretty
7582

7683
noPluginHandles :: Recorder (WithPriority Log) -> SMethod m -> [(PluginId, HandleRequestResult)] -> IO (Either (TResponseError m) c)
@@ -250,8 +257,16 @@ extensiblePlugins recorder plugins = mempty { P.pluginHandlers = handlers }
250257
let (fs, dfs) = List.partition (\(_, desc, _) -> handlesRequest m params desc config == HandlesRequest) fs'
251258
let disabledPluginsReason = (\(x, desc, _) -> (x, handlesRequest m params desc config)) <$> dfs
252259
-- Clients generally don't display ResponseErrors so instead we log any that we come across
260+
-- However, some clients do display ResponseErrors! See for example the issues:
261+
-- https://github.com/haskell/haskell-language-server/issues/4467
262+
-- https://github.com/haskell/haskell-language-server/issues/4451
253263
case nonEmpty fs of
254-
Nothing -> liftIO $ noPluginHandles recorder m disabledPluginsReason
264+
Nothing -> do
265+
liftIO (fallbackResolveHandler recorder m params) >>= \case
266+
Nothing ->
267+
liftIO $ noPluginHandles recorder m disabledPluginsReason
268+
Just result ->
269+
pure $ Right result
255270
Just neFs -> do
256271
let plidsAndHandlers = fmap (\(plid,_,handler) -> (plid,handler)) neFs
257272
es <- runHandlerM $ runConcurrently exceptionInPlugin m plidsAndHandlers ide params
@@ -272,6 +287,72 @@ extensiblePlugins recorder plugins = mempty { P.pluginHandlers = handlers }
272287
Just xs -> do
273288
pure $ Right $ combineResponses m config caps params xs
274289

290+
-- | Fallback Handler for resolve requests.
291+
-- For all kinds of `*/resolve` requests, if they don't have a 'data_' value,
292+
-- produce the original item, since no other plugin has any resolve data.
293+
--
294+
-- This is an internal handler, so it cannot be turned off and should be opaque
295+
-- to the end-user.
296+
-- This function does not take the ServerCapabilities into account, and assumes
297+
-- clients will only send these requests, if and only if the Language Server
298+
-- advertised support for it.
299+
--
300+
-- See Note [Fallback Handler for LSP resolve requests] for justification and reasoning.
301+
fallbackResolveHandler :: MonadIO m => Recorder (WithPriority Log) -> SMethod s -> MessageParams s -> m (Maybe (MessageResult s))
302+
fallbackResolveHandler recorder m params = do
303+
let result = case m of
304+
SMethod_InlayHintResolve
305+
| noResolveData params -> Just params
306+
SMethod_CompletionItemResolve
307+
| noResolveData params -> Just params
308+
SMethod_CodeActionResolve
309+
| noResolveData params -> Just params
310+
SMethod_WorkspaceSymbolResolve
311+
| noResolveData params -> Just params
312+
SMethod_CodeLensResolve
313+
| noResolveData params -> Just params
314+
SMethod_DocumentLinkResolve
315+
| noResolveData params -> Just params
316+
_ -> Nothing
317+
logResolveHandling result
318+
pure result
319+
where
320+
noResolveData :: JL.HasData_ p (Maybe a) => p -> Bool
321+
noResolveData p = isNothing $ p ^. JL.data_
322+
323+
-- We only log if we are handling the request.
324+
-- If we don't handle this request, this should be logged
325+
-- on call-site.
326+
logResolveHandling p = Extra.whenJust p $ \_ -> do
327+
logWith recorder Debug $ LogResolveDefaultHandler (Some m)
328+
329+
{- Note [Fallback Handler for LSP resolve requests]
330+
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
331+
332+
We have a special fallback for `*/resolve` requests.
333+
334+
We had multiple reports, where `resolve` requests (such as
335+
`completion/resolve` and `codeAction/resolve`) are rejected
336+
by HLS since the `_data_` field of the respective LSP feature has not been
337+
populated by HLS.
338+
This makes sense, as we only support `resolve` for certain kinds of
339+
`CodeAction`/`Completions`, when they contain particularly expensive
340+
properties, such as documentation or non-local type signatures.
341+
342+
So what to do? We can see two options:
343+
344+
1. Be dumb and permissive: if no plugin wants to resolve a request, then
345+
just respond positively with the original item! Potentially this masks
346+
real issues, but may not be too bad. If a plugin thinks it can
347+
handle the request but it then fails to resolve it, we should still return a failure.
348+
2. Try and be smart: we try to figure out requests that we're "supposed" to
349+
resolve (e.g. those with a data field), and fail if no plugin wants to handle those.
350+
This is possible since we set data.
351+
So as long as we maintain the invariant that only things which need resolving get
352+
data, then it could be okay.
353+
354+
In 'fallbackResolveHandler', we implement the option (2).
355+
-}
275356

276357
-- ---------------------------------------------------------------------
277358

‎ghcide/test/exe/CompletionTests.hs

Lines changed: 4 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -563,13 +563,10 @@ completionDocTests =
563563
_ <- waitForDiagnostics
564564
compls <- getCompletions doc pos
565565
rcompls <- forM compls $ \item -> do
566-
if isJust (item ^. L.data_)
567-
then do
568-
rsp <- request SMethod_CompletionItemResolve item
569-
case rsp ^. L.result of
570-
Left err -> liftIO $ assertFailure ("completionItem/resolve failed with: " <> show err)
571-
Right x -> pure x
572-
else pure item
566+
rsp <- request SMethod_CompletionItemResolve item
567+
case rsp ^. L.result of
568+
Left err -> liftIO $ assertFailure ("completionItem/resolve failed with: " <> show err)
569+
Right x -> pure x
573570
let compls' = [
574571
-- We ignore doc uris since it points to the local path which determined by specific machines
575572
case mn of

‎ghcide/test/exe/Config.hs

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,8 @@ module Config(
55
mkIdeTestFs
66
, dummyPlugin
77

8+
-- * runners for testing specific plugins
9+
, testSessionWithPlugin
810
-- * runners for testing with dummy plugin
911
, runWithDummyPlugin
1012
, testWithDummyPlugin
@@ -34,6 +36,7 @@ import Control.Monad (unless)
3436
import Data.Foldable (traverse_)
3537
import Data.Function ((&))
3638
import qualified Data.Text as T
39+
import Development.IDE (Pretty)
3740
import Development.IDE.Test (canonicalizeUri)
3841
import Ide.Types (defaultPluginDescriptor)
3942
import qualified Language.LSP.Protocol.Lens as L
@@ -49,6 +52,16 @@ testDataDir = "ghcide" </> "test" </> "data"
4952
mkIdeTestFs :: [FS.FileTree] -> FS.VirtualFileTree
5053
mkIdeTestFs = FS.mkVirtualFileTree testDataDir
5154

55+
-- * Run with some injected plugin
56+
-- testSessionWithPlugin :: FS.VirtualFileTree -> (FilePath -> Session a) -> IO a
57+
testSessionWithPlugin :: Pretty b => FS.VirtualFileTree -> PluginTestDescriptor b -> (FilePath -> Session a) -> IO a
58+
testSessionWithPlugin fs plugin = runSessionWithTestConfig def
59+
{ testPluginDescriptor = plugin
60+
, testDirLocation = Right fs
61+
, testConfigCaps = lspTestCaps
62+
, testShiftRoot = True
63+
}
64+
5265
-- * A dummy plugin for testing ghcIde
5366
dummyPlugin :: PluginTestDescriptor ()
5467
dummyPlugin = mkPluginTestDescriptor (\_ pid -> defaultPluginDescriptor pid "dummyTestPlugin") "core"

‎ghcide/test/exe/Main.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -59,6 +59,7 @@ import PluginSimpleTests
5959
import PositionMappingTests
6060
import PreprocessorTests
6161
import ReferenceTests
62+
import ResolveTests
6263
import RootUriTests
6364
import SafeTests
6465
import SymlinkTests
@@ -98,6 +99,7 @@ main = do
9899
, AsyncTests.tests
99100
, ClientSettingsTests.tests
100101
, ReferenceTests.tests
102+
, ResolveTests.tests
101103
, GarbageCollectionTests.tests
102104
, HieDbRetry.tests
103105
, ExceptionTests.tests

0 commit comments

Comments
 (0)