From c083f8d667a6a4b25de1c728209cd0e245627736 Mon Sep 17 00:00:00 2001 From: VeryMilkyJoe Date: Sun, 8 Jun 2025 16:17:55 +0200 Subject: [PATCH] Change tracking of file types to language kinds The plugin descriptor now tracks the language kinds it is responsible for instead of the file endings. We get the language kinds of any file from the VFS. Currently we are using a source repository to be able to use the lsp changes needed, but once lsp is released this can be removed. --- cabal.project | 11 +++ ghcide/src/Development/IDE/Core/FileStore.hs | 4 +- ghcide/src/Development/IDE/Core/Rules.hs | 4 +- ghcide/src/Development/IDE/Core/Shake.hs | 4 +- .../IDE/Plugin/Completions/Logic.hs | 2 +- ghcide/src/Development/IDE/Plugin/HLS.hs | 10 +- hls-plugin-api/src/Ide/Types.hs | 97 +++++++++++-------- .../test/SemanticTokensTest.hs | 3 +- 8 files changed, 86 insertions(+), 49 deletions(-) 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