Skip to content

Commit 0913d2e

Browse files
soulomoonsoulomoon
authored
Merge branch 'master' into batch-load-multi-read
2 parents 33f788c + d75400d commit 0913d2e

File tree

12 files changed

+315
-38
lines changed

12 files changed

+315
-38
lines changed

‎.github/actions/setup-build/action.yml‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,7 @@ runs:
3131
sudo chown -R $USER /usr/local/.ghcup
3232
shell: bash
3333

34-
- uses: haskell-actions/[email protected].8
34+
- uses: haskell-actions/[email protected].9
3535
id: HaskEnvSetup
3636
with:
3737
ghc-version : ${{ inputs.ghc }}

‎.github/workflows/bench.yml‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -127,7 +127,7 @@ jobs:
127127
example: ['cabal', 'lsp-types']
128128

129129
steps:
130-
- uses: haskell-actions/[email protected].8
130+
- uses: haskell-actions/[email protected].9
131131
with:
132132
ghc-version : ${{ matrix.ghc }}
133133
cabal-version: ${{ matrix.cabal }}

‎cabal.project‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,12 @@ benchmarks: True
1717

1818
write-ghc-environment-files: never
1919

20+
-- Link executables dynamically so the linker doesn't produce test
21+
-- executables of ~150MB each and works lightning fast at that too
22+
-- Disabled on Windows
23+
if(!os(windows))
24+
executable-dynamic: True
25+
2026
-- Many of our tests only work single-threaded, and the only way to
2127
-- ensure tasty runs everything purely single-threaded is to pass
2228
-- this at the top-level

‎ghcide/session-loader/Development/IDE/Session.hs‎

Lines changed: 1 addition & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@ module Development.IDE.Session
88
(SessionLoadingOptions(..)
99
,CacheDirs(..)
1010
,loadSessionWithOptions
11-
,setInitialDynFlags
11+
,getInitialGhcLibDirDefault
1212
,getHieDbLoc
1313
,retryOnSqliteBusy
1414
,retryOnException
@@ -113,7 +113,6 @@ import Development.IDE.Types.Shake (WithHieDb,
113113
import GHC.Data.Graph.Directed
114114
import HieDb.Create
115115
import HieDb.Types
116-
import HieDb.Utils
117116
import Ide.PluginUtils (toAbsolute)
118117
import qualified System.Random as Random
119118
import System.Random (RandomGen)
@@ -303,15 +302,6 @@ getInitialGhcLibDirDefault recorder rootDir = do
303302
logWith recorder Warning LogGetInitialGhcLibDirDefaultCradleNone
304303
pure Nothing
305304

306-
-- | Sets `unsafeGlobalDynFlags` on using the hie-bios cradle and returns the GHC libdir
307-
setInitialDynFlags :: Recorder (WithPriority Log) -> FilePath -> SessionLoadingOptions -> IO (Maybe LibDir)
308-
setInitialDynFlags recorder rootDir SessionLoadingOptions{..} = do
309-
libdir <- getInitialGhcLibDir recorder rootDir
310-
dynFlags <- mapM dynFlagsForPrinting libdir
311-
logWith recorder Debug LogSettingInitialDynFlags
312-
mapM_ setUnsafeGlobalDynFlags dynFlags
313-
pure libdir
314-
315305
-- | If the action throws exception that satisfies predicate then we sleep for
316306
-- a duration determined by the random exponential backoff formula,
317307
-- `uniformRandom(0, min (maxDelay, (baseDelay * 2) ^ retryAttempt))`, and try

‎ghcide/src/Development/IDE/GHC/Util.hs‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -255,7 +255,6 @@ ioe_dupHandlesNotCompatible h =
255255
-- Tracing exactprint terms
256256

257257
-- | Print a GHC value in `defaultUserStyle` without unique symbols.
258-
-- It uses `showSDocUnsafe` with `unsafeGlobalDynFlags` internally.
259258
--
260259
-- This is the most common print utility.
261260
-- It will do something additionally compared to what the 'Outputable' instance does.

‎ghcide/src/Development/IDE/Main.hs‎

Lines changed: 4 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -16,7 +16,6 @@ import Control.Concurrent.MVar (newEmptyMVar,
1616
putMVar, tryReadMVar)
1717
import Control.Concurrent.STM.Stats (dumpSTMStats)
1818
import Control.Exception.Safe (SomeException,
19-
catchAny,
2019
displayException)
2120
import Control.Monad.Extra (concatMapM, unless,
2221
when)
@@ -32,7 +31,7 @@ import Data.List.Extra (intercalate,
3231
import Data.Maybe (catMaybes, isJust)
3332
import qualified Data.Text as T
3433
import Development.IDE (Action,
35-
Priority (Debug, Error),
34+
Priority (Debug),
3635
Rules, hDuplicateTo')
3736
import Development.IDE.Core.Debouncer (Debouncer,
3837
newAsyncDebouncer)
@@ -72,9 +71,9 @@ import qualified Development.IDE.Plugin.HLS.GhcIde as GhcIde
7271
import qualified Development.IDE.Plugin.Test as Test
7372
import Development.IDE.Session (SessionLoadingOptions,
7473
getHieDbLoc,
74+
getInitialGhcLibDirDefault,
7575
loadSessionWithOptions,
76-
retryOnSqliteBusy,
77-
setInitialDynFlags)
76+
retryOnSqliteBusy)
7877
import qualified Development.IDE.Session as Session
7978
import Development.IDE.Types.Location (NormalizedUri,
8079
toNormalizedFilePath')
@@ -136,7 +135,6 @@ data Log
136135
| LogLspStart [PluginId]
137136
| LogLspStartDuration !Seconds
138137
| LogShouldRunSubset !Bool
139-
| LogSetInitialDynFlagsException !SomeException
140138
| LogConfigurationChange T.Text
141139
| LogService Service.Log
142140
| LogShake Shake.Log
@@ -160,8 +158,6 @@ instance Pretty Log where
160158
"Started LSP server in" <+> pretty (showDuration duration)
161159
LogShouldRunSubset shouldRunSubset ->
162160
"shouldRunSubset:" <+> pretty shouldRunSubset
163-
LogSetInitialDynFlagsException e ->
164-
"setInitialDynFlags:" <+> pretty (displayException e)
165161
LogConfigurationChange msg -> "Configuration changed:" <+> pretty msg
166162
LogService msg -> pretty msg
167163
LogShake msg -> pretty msg
@@ -329,13 +325,6 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re
329325
getIdeState env rootPath withHieDb threadQueue = do
330326
t <- ioT
331327
logWith recorder Info $ LogLspStartDuration t
332-
-- We want to set the global DynFlags right now, so that we can use
333-
-- `unsafeGlobalDynFlags` even before the project is configured
334-
_mlibdir <-
335-
setInitialDynFlags (cmapWithPrio LogSession recorder) rootPath argsSessionLoadingOptions
336-
-- TODO: should probably catch/log/rethrow at top level instead
337-
`catchAny` (\e -> logWith recorder Error (LogSetInitialDynFlagsException e) >> pure Nothing)
338-
339328
sessionLoader <- loadSessionWithOptions (cmapWithPrio LogSession recorder) argsSessionLoadingOptions rootPath (tLoaderQueue threadQueue)
340329
config <- LSP.runLspT env LSP.getConfig
341330
let def_options = argsIdeOptions config sessionLoader
@@ -435,7 +424,7 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re
435424
let root = argsProjectRoot
436425
dbLoc <- getHieDbLoc root
437426
hPutStrLn stderr $ "Using hiedb at: " ++ dbLoc
438-
mlibdir <- setInitialDynFlags (cmapWithPrio LogSession recorder) root def
427+
mlibdir <- getInitialGhcLibDirDefault (cmapWithPrio LogSession recorder) root
439428
rng <- newStdGen
440429
case mlibdir of
441430
Nothing -> exitWith $ ExitFailure 1

‎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)