diff --git a/cabal.project b/cabal.project index 3d43dff2f4..24e4e34e4f 100644 --- a/cabal.project +++ b/cabal.project @@ -7,6 +7,17 @@ packages: ./hls-plugin-api ./hls-test-utils +source-repository-package + type: git + location: https://github.com/VeryMilkyJoe/lsp.git + subdir: lsp + tag: 33673596e1b2eb619ca38244e001adda880c3657 + +source-repository-package + type: git + location: https://github.com/VeryMilkyJoe/lsp.git + subdir: lsp-test + tag: 33673596e1b2eb619ca38244e001adda880c3657 index-state: 2025-06-07T14:57:40Z diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 7dad386ece..0a0be9543a 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -226,8 +226,8 @@ getVersionedTextDoc doc = do maybe (pure Nothing) getVirtualFile $ uriToNormalizedFilePath $ toNormalizedUri uri let ver = case mvf of - Just (VirtualFile lspver _ _) -> lspver - Nothing -> 0 + Just (VirtualFile lspver _ _ _) -> lspver + Nothing -> 0 return (VersionedTextDocumentIdentifier uri ver) fileStoreRules :: Recorder (WithPriority Log) -> (NormalizedFilePath -> Action Bool) -> Rules () diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index f1b11d971b..fd4140e9bc 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -158,7 +158,7 @@ import Ide.Plugin.Properties (HasProperty, useProperty, usePropertyByPath) import Ide.Types (DynFlagsModifications (dynFlagsModifyGlobal, dynFlagsModifyParser), - PluginId) + PluginId, getVirtualFileFromVFS) import qualified Language.LSP.Protocol.Lens as JL import Language.LSP.Protocol.Message (SMethod (SMethod_CustomMethod, SMethod_WindowShowMessage)) import Language.LSP.Protocol.Types (MessageType (MessageType_Info), @@ -509,7 +509,7 @@ persistentHieFileRule recorder = addPersistentRule GetHieAst $ \file -> runMaybe res <- readHieFileForSrcFromDisk recorder file vfsRef <- asks vfsVar vfsData <- liftIO $ _vfsMap <$> readTVarIO vfsRef - (currentSource, ver) <- liftIO $ case M.lookup (filePathToUri' file) vfsData of + (currentSource, ver) <- liftIO $ case getVirtualFileFromVFS (VFS vfsData) (filePathToUri' file) of Nothing -> (,Nothing) . T.decodeUtf8 <$> BS.readFile (fromNormalizedFilePath file) Just vf -> pure (virtualFileText vf, Just $ virtualFileVersion vf) let refmap = Compat.generateReferencesMap . Compat.getAsts . Compat.hie_asts $ res diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 6fc9a4d00e..b107f23e3e 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -129,6 +129,7 @@ import Development.IDE.Core.RuleTypes import Development.IDE.Types.Options as Options import qualified Language.LSP.Protocol.Message as LSP import qualified Language.LSP.Server as LSP +import qualified Language.LSP.VFS as VFS import Development.IDE.Core.Tracing import Development.IDE.Core.WorkerThread @@ -394,7 +395,8 @@ class Typeable a => IsIdeGlobal a where getVirtualFile :: NormalizedFilePath -> Action (Maybe VirtualFile) getVirtualFile nf = do vfs <- fmap _vfsMap . liftIO . readTVarIO . vfsVar =<< getShakeExtras - pure $! Map.lookup (filePathToUri' nf) vfs -- Don't leak a reference to the entire map + pure $! -- Don't leak a reference to the entire map + getVirtualFileFromVFS (VFS vfs) $ filePathToUri' nf -- Take a snapshot of the current LSP VFS vfsSnapshot :: Maybe (LSP.LanguageContextEnv a) -> IO VFS diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index a00705ba39..a2f950dec4 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -854,7 +854,7 @@ mergeListsBy cmp all_lists = merge_lists all_lists -- |From the given cursor position, gets the prefix module or record for autocompletion getCompletionPrefix :: Position -> VFS.VirtualFile -> PosPrefixInfo -getCompletionPrefix pos (VFS.VirtualFile _ _ ropetext) = getCompletionPrefixFromRope pos ropetext +getCompletionPrefix pos (VFS.VirtualFile _ _ ropetext _) = getCompletionPrefixFromRope pos ropetext getCompletionPrefixFromRope :: Position -> Rope.Rope -> PosPrefixInfo getCompletionPrefixFromRope pos@(Position l c) ropetext = diff --git a/ghcide/src/Development/IDE/Plugin/HLS.hs b/ghcide/src/Development/IDE/Plugin/HLS.hs index f5190e9274..f7bf1cadf5 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS.hs @@ -49,7 +49,8 @@ import qualified Language.LSP.Server as LSP import Language.LSP.VFS import Prettyprinter.Render.String (renderString) import Text.Regex.TDFA.Text () -import UnliftIO (MonadUnliftIO, liftIO) +import UnliftIO (MonadUnliftIO, liftIO, + readTVarIO) import UnliftIO.Async (forConcurrently) import UnliftIO.Exception (catchAny) @@ -251,11 +252,12 @@ extensiblePlugins recorder plugins = mempty { P.pluginHandlers = handlers } handlers = mconcat $ do (IdeMethod m :=> IdeHandler fs') <- DMap.assocs handlers' pure $ requestHandler m $ \ide params -> do + vfs <- readTVarIO $ vfsVar $ shakeExtras ide config <- Ide.PluginUtils.getClientConfig -- Only run plugins that are allowed to run on this request, save the -- list of disabled plugins incase that's all we have - let (fs, dfs) = List.partition (\(_, desc, _) -> handlesRequest m params desc config == HandlesRequest) fs' - let disabledPluginsReason = (\(x, desc, _) -> (x, handlesRequest m params desc config)) <$> dfs + let (fs, dfs) = List.partition (\(_, desc, _) -> handlesRequest vfs m params desc config == HandlesRequest) fs' + let disabledPluginsReason = (\(x, desc, _) -> (x, handlesRequest vfs m params desc config)) <$> dfs -- Clients generally don't display ResponseErrors so instead we log any that we come across -- However, some clients do display ResponseErrors! See for example the issues: -- https://github.com/haskell/haskell-language-server/issues/4467 @@ -370,7 +372,7 @@ extensibleNotificationPlugins recorder xs = mempty { P.pluginHandlers = handlers pure $ notificationHandler m $ \ide vfs params -> do config <- Ide.PluginUtils.getClientConfig -- Only run plugins that are enabled for this request - let fs = filter (\(_, desc, _) -> handlesRequest m params desc config == HandlesRequest) fs' + let fs = filter (\(_, desc, _) -> handlesRequest vfs m params desc config == HandlesRequest) fs' case nonEmpty fs of Nothing -> do logWith recorder Warning (LogNoPluginForMethod $ Some m) diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index 3a06656a77..f14430a55b 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -39,6 +39,7 @@ module Ide.Types , PluginNotificationHandlers(..) , PluginRequestMethod(..) , getProcessID, getPid +, getVirtualFileFromVFS , installSigUsr1Handler , lookupCommandProvider , ResolveFunction @@ -94,13 +95,13 @@ import Ide.Plugin.Properties import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types +import qualified Language.LSP.Protocol.Types as J import Language.LSP.Server import Language.LSP.VFS import Numeric.Natural import OpenTelemetry.Eventlog import Options.Applicative (ParserInfo) import Prettyprinter as PP -import System.FilePath import System.IO.Unsafe import Text.Regex.TDFA.Text () import UnliftIO (MonadUnliftIO) @@ -323,7 +324,7 @@ data PluginDescriptor (ideState :: Type) = , pluginNotificationHandlers :: PluginNotificationHandlers ideState , pluginModifyDynflags :: DynFlagsModifications , pluginCli :: Maybe (ParserInfo (IdeCommand ideState)) - , pluginFileType :: [T.Text] + , pluginLanguageIds :: [J.LanguageKind] -- ^ File extension of the files the plugin is responsible for. -- The plugin is only allowed to handle files with these extensions. -- When writing handlers, etc. for this plugin it can be assumed that all handled files are of this type. @@ -416,14 +417,18 @@ pluginResolverResponsible _ _ = DoesNotHandleRequest $ NotResolveOwner "(unable -- We are passing the msgParams here even though we only need the URI URI here. -- If in the future we need to be able to provide only an URI it can be -- separated again. -pluginSupportsFileType :: (L.HasTextDocument m doc, L.HasUri doc Uri) => m -> PluginDescriptor c -> HandleRequestResult -pluginSupportsFileType msgParams pluginDesc = - case mfp of - Just fp | T.pack (takeExtension fp) `elem` pluginFileType pluginDesc -> HandlesRequest - _ -> DoesNotHandleRequest $ DoesNotSupportFileType (maybe "(unable to determine file type)" (T.pack . takeExtension) mfp) +pluginSupportsFileType :: (L.HasTextDocument m doc, L.HasUri doc Uri) => VFS -> m -> PluginDescriptor c -> HandleRequestResult +pluginSupportsFileType (VFS vfs) msgParams pluginDesc = + case languageKindM of + Just languageKind | languageKind `elem` pluginLanguageIds pluginDesc -> HandlesRequest + _ -> DoesNotHandleRequest $ DoesNotSupportFileType (maybe "(unable to determine file type)" (T.pack . show) languageKindM) where - mfp = uriToFilePath uri - uri = msgParams ^. L.textDocument . L.uri + mVFE = getVirtualFileFromVFSIncludingClosed (VFS vfs) uri + uri = toNormalizedUri $ msgParams ^. L.textDocument . L.uri + languageKindM = + case mVFE of + Just x -> virtualFileEntryLanguageKind x + _ -> Nothing -- | Methods that can be handled by plugins. -- 'ExtraParams' captures any extra data the IDE passes to the handlers for this method @@ -452,7 +457,9 @@ class HasTracing (MessageParams m) => PluginMethod (k :: MessageKind) (m :: Meth -- -- But there is no use to split it up into two different methods for now. handlesRequest - :: SMethod m + :: VFS + -- ^ The virtual file system, contains the language kind of the file. + -> SMethod m -- ^ Method type. -> MessageParams m -- ^ Whether a plugin is enabled might depend on the message parameters @@ -468,24 +475,24 @@ class HasTracing (MessageParams m) => PluginMethod (k :: MessageKind) (m :: Meth -- with the given parameters? default handlesRequest :: (L.HasTextDocument (MessageParams m) doc, L.HasUri doc Uri) - => SMethod m -> MessageParams m -> PluginDescriptor c -> Config -> HandleRequestResult - handlesRequest _ params desc conf = - pluginEnabledGlobally desc conf <> pluginSupportsFileType params desc + => VFS -> SMethod m -> MessageParams m -> PluginDescriptor c -> Config -> HandleRequestResult + handlesRequest vfs _ params desc conf = + pluginEnabledGlobally desc conf <> pluginSupportsFileType vfs params desc -- | Check if a plugin is enabled, if one of it's specific config's is enabled, -- and if it supports the file pluginEnabledWithFeature :: (L.HasTextDocument (MessageParams m) doc, L.HasUri doc Uri) - => (PluginConfig -> Bool) -> SMethod m -> MessageParams m + => (PluginConfig -> Bool) -> VFS -> SMethod m -> MessageParams m -> PluginDescriptor c -> Config -> HandleRequestResult -pluginEnabledWithFeature feature _ msgParams pluginDesc config = +pluginEnabledWithFeature feature vfs _ msgParams pluginDesc config = pluginEnabledGlobally pluginDesc config <> pluginFeatureEnabled feature pluginDesc config - <> pluginSupportsFileType msgParams pluginDesc + <> pluginSupportsFileType vfs msgParams pluginDesc -- | Check if a plugin is enabled, if one of it's specific configs is enabled, -- and if it's the plugin responsible for a resolve request. -pluginEnabledResolve :: L.HasData_ s (Maybe Value) => (PluginConfig -> Bool) -> p -> s -> PluginDescriptor c -> Config -> HandleRequestResult -pluginEnabledResolve feature _ msgParams pluginDesc config = +pluginEnabledResolve :: L.HasData_ s (Maybe Value) => (PluginConfig -> Bool) -> VFS -> p -> s -> PluginDescriptor c -> Config -> HandleRequestResult +pluginEnabledResolve feature _ _ msgParams pluginDesc config = pluginEnabledGlobally pluginDesc config <> pluginFeatureEnabled feature pluginDesc config <> pluginResolverResponsible msgParams pluginDesc @@ -498,23 +505,23 @@ instance PluginMethod Request Method_CodeActionResolve where handlesRequest = pluginEnabledResolve plcCodeActionsOn instance PluginMethod Request Method_TextDocumentDefinition where - handlesRequest _ msgParams pluginDesc _ = pluginSupportsFileType msgParams pluginDesc + handlesRequest vfs _ msgParams pluginDesc _ = pluginSupportsFileType vfs msgParams pluginDesc instance PluginMethod Request Method_TextDocumentTypeDefinition where - handlesRequest _ msgParams pluginDesc _ = pluginSupportsFileType msgParams pluginDesc + handlesRequest vfs _ msgParams pluginDesc _ = pluginSupportsFileType vfs msgParams pluginDesc instance PluginMethod Request Method_TextDocumentImplementation where - handlesRequest _ msgParams pluginDesc _ = pluginSupportsFileType msgParams pluginDesc + handlesRequest vfs _ msgParams pluginDesc _ = pluginSupportsFileType vfs msgParams pluginDesc instance PluginMethod Request Method_TextDocumentDocumentHighlight where - handlesRequest _ msgParams pluginDesc _ = pluginSupportsFileType msgParams pluginDesc + handlesRequest vfs _ msgParams pluginDesc _ = pluginSupportsFileType vfs msgParams pluginDesc instance PluginMethod Request Method_TextDocumentReferences where - handlesRequest _ msgParams pluginDesc _ = pluginSupportsFileType msgParams pluginDesc + handlesRequest vfs _ msgParams pluginDesc _ = pluginSupportsFileType vfs msgParams pluginDesc instance PluginMethod Request Method_WorkspaceSymbol where -- Unconditionally enabled, but should it really be? - handlesRequest _ _ _ _ = HandlesRequest + handlesRequest _ _ _ _ _ = HandlesRequest instance PluginMethod Request Method_TextDocumentInlayHint where handlesRequest = pluginEnabledWithFeature plcInlayHintsOn @@ -549,22 +556,22 @@ instance PluginMethod Request Method_TextDocumentCompletion where handlesRequest = pluginEnabledWithFeature plcCompletionOn instance PluginMethod Request Method_TextDocumentFormatting where - handlesRequest _ msgParams pluginDesc conf = + handlesRequest vfs _ msgParams pluginDesc conf = (if PluginId (formattingProvider conf) == pid || PluginId (cabalFormattingProvider conf) == pid then HandlesRequest else DoesNotHandleRequest (NotFormattingProvider (formattingProvider conf)) ) - <> pluginSupportsFileType msgParams pluginDesc + <> pluginSupportsFileType vfs msgParams pluginDesc where pid = pluginId pluginDesc instance PluginMethod Request Method_TextDocumentRangeFormatting where - handlesRequest _ msgParams pluginDesc conf = + handlesRequest vfs _ msgParams pluginDesc conf = (if PluginId (formattingProvider conf) == pid || PluginId (cabalFormattingProvider conf) == pid then HandlesRequest else DoesNotHandleRequest (NotFormattingProvider (formattingProvider conf))) - <> pluginSupportsFileType msgParams pluginDesc + <> pluginSupportsFileType vfs msgParams pluginDesc where pid = pluginId pluginDesc @@ -585,21 +592,21 @@ instance PluginMethod Request Method_TextDocumentFoldingRange where instance PluginMethod Request Method_CallHierarchyIncomingCalls where -- This method has no URI parameter, thus no call to 'pluginResponsible' - handlesRequest _ _ pluginDesc conf = + handlesRequest _ _ _ pluginDesc conf = pluginEnabledGlobally pluginDesc conf <> pluginFeatureEnabled plcCallHierarchyOn pluginDesc conf instance PluginMethod Request Method_CallHierarchyOutgoingCalls where -- This method has no URI parameter, thus no call to 'pluginResponsible' - handlesRequest _ _ pluginDesc conf = + handlesRequest _ _ _ pluginDesc conf = pluginEnabledGlobally pluginDesc conf <> pluginFeatureEnabled plcCallHierarchyOn pluginDesc conf instance PluginMethod Request Method_WorkspaceExecuteCommand where - handlesRequest _ _ _ _= HandlesRequest + handlesRequest _ _ _ _ _ = HandlesRequest instance PluginMethod Request (Method_CustomMethod m) where - handlesRequest _ _ _ _ = HandlesRequest + handlesRequest _ _ _ _ _ = HandlesRequest -- Plugin Notifications @@ -613,19 +620,19 @@ instance PluginMethod Notification Method_TextDocumentDidClose where instance PluginMethod Notification Method_WorkspaceDidChangeWatchedFiles where -- This method has no URI parameter, thus no call to 'pluginResponsible'. - handlesRequest _ _ desc conf = pluginEnabledGlobally desc conf + handlesRequest _ _ _ desc conf = pluginEnabledGlobally desc conf instance PluginMethod Notification Method_WorkspaceDidChangeWorkspaceFolders where -- This method has no URI parameter, thus no call to 'pluginResponsible'. - handlesRequest _ _ desc conf = pluginEnabledGlobally desc conf + handlesRequest _ _ _ desc conf = pluginEnabledGlobally desc conf instance PluginMethod Notification Method_WorkspaceDidChangeConfiguration where -- This method has no URI parameter, thus no call to 'pluginResponsible'. - handlesRequest _ _ desc conf = pluginEnabledGlobally desc conf + handlesRequest _ _ _ desc conf = pluginEnabledGlobally desc conf instance PluginMethod Notification Method_Initialized where -- This method has no URI parameter, thus no call to 'pluginResponsible'. - handlesRequest _ _ desc conf = pluginEnabledGlobally desc conf + handlesRequest _ _ _ desc conf = pluginEnabledGlobally desc conf -- --------------------------------------------------------------------- @@ -1054,7 +1061,7 @@ defaultPluginDescriptor plId desc = mempty mempty Nothing - [".hs", ".lhs", ".hs-boot"] + [J.LanguageKind_Haskell, J.LanguageKind_Custom "literate haskell"] -- | Set up a plugin descriptor, initialized with default values. -- This plugin descriptor is prepared for @.cabal@ files and as such, @@ -1075,7 +1082,7 @@ defaultCabalPluginDescriptor plId desc = mempty mempty Nothing - [".cabal"] + [J.LanguageKind_Custom "cabal"] newtype CommandId = CommandId T.Text deriving (Show, Read, Eq, Ord) @@ -1251,6 +1258,20 @@ mkLspCmdId pid (PluginId plid) (CommandId cid) getPid :: IO T.Text getPid = T.pack . show <$> getProcessID +getVirtualFileFromVFS :: VFS -> NormalizedUri -> Maybe VirtualFile +getVirtualFileFromVFS (VFS vfs) uri = + case Map.lookup uri vfs of + Just (Open x) -> Just x + Just (Closed _) -> Nothing + Nothing -> Nothing + +getVirtualFileFromVFSIncludingClosed :: VFS -> NormalizedUri -> Maybe VirtualFileEntry +getVirtualFileFromVFSIncludingClosed (VFS vfs) uri = + case Map.lookup uri vfs of + Just x -> Just x + Nothing -> Nothing + + getProcessID :: IO Int installSigUsr1Handler :: IO () -> IO () diff --git a/plugins/hls-semantic-tokens-plugin/test/SemanticTokensTest.hs b/plugins/hls-semantic-tokens-plugin/test/SemanticTokensTest.hs index a0d1648fb3..4cc3ae8ae1 100644 --- a/plugins/hls-semantic-tokens-plugin/test/SemanticTokensTest.hs +++ b/plugins/hls-semantic-tokens-plugin/test/SemanticTokensTest.hs @@ -22,6 +22,7 @@ import Ide.Plugin.SemanticTokens.Types import Ide.Types import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Types +import qualified Language.LSP.Protocol.Types as J import qualified Language.LSP.Test as Test import Language.LSP.VFS (VirtualFile (..)) import System.FilePath @@ -90,7 +91,7 @@ docLspSemanticTokensString :: (HasCallStack) => TextDocumentIdentifier -> Sessio docLspSemanticTokensString doc = do res <- Test.getSemanticTokens doc textContent <- documentContents doc - let vfs = VirtualFile 0 0 (Rope.fromText textContent) + let vfs = VirtualFile 0 0 (Rope.fromText textContent) $ Just J.LanguageKind_Haskell case res ^? Language.LSP.Protocol.Types._L of Just tokens -> do either (error . show) pure $ recoverLspSemanticTokens vfs tokens