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.

Author: VeryMilkyJoe

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
 

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

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

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

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 =

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

@@ -9,6 +9,7 @@ module Development.IDE.Plugin.HLS
     , Log(..)
     ) where
 
+import           Control.Concurrent.STM.TVar   (readTVar)
 import           Control.Exception             (SomeException)
 import           Control.Lens                  ((^.))
 import           Control.Monad
@@ -49,7 +50,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, atomically,
+                                                liftIO)
 import           UnliftIO.Async                (forConcurrently)
 import           UnliftIO.Exception            (catchAny)
 
@@ -251,11 +253,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 <- atomically $ readTVar $ 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 +373,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)

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

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