Generalise file extension handling for plugins

NotificationHandler now distinguishes between different file extensions
RequestHandler distinguishes between different file extensions

Author: Jana Chadt

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

@@ -58,8 +58,8 @@ asGhcIdePlugin :: Recorder (WithPriority Log) -> IdePlugins IdeState -> Plugin C
 asGhcIdePlugin recorder (IdePlugins ls) =
     mkPlugin rulesPlugins HLS.pluginRules <>
     mkPlugin executeCommandPlugins HLS.pluginCommands <>
-    mkPlugin extensiblePlugins HLS.pluginHandlers <>
-    mkPlugin (extensibleNotificationPlugins recorder) HLS.pluginNotificationHandlers <>
+    mkPlugin extensiblePlugins id <>
+    mkPlugin (extensibleNotificationPlugins recorder) id <>
     mkPlugin dynFlagsPlugins HLS.pluginModifyDynflags
     where
 
@@ -153,55 +153,80 @@ executeCommandHandlers ecs = requestHandler SWorkspaceExecuteCommand execCmd
 
 -- ---------------------------------------------------------------------
 
-extensiblePlugins :: [(PluginId, PluginHandlers IdeState)] -> Plugin Config
+extensiblePlugins :: [(PluginId, PluginDescriptor IdeState)] -> Plugin Config
 extensiblePlugins xs = mempty { P.pluginHandlers = handlers }
   where
+    getPluginDescriptor pid = lookup pid xs
     IdeHandlers handlers' = foldMap bakePluginId xs
-    bakePluginId :: (PluginId, PluginHandlers IdeState) -> IdeHandlers
-    bakePluginId (pid,PluginHandlers hs) = IdeHandlers $ DMap.map
+    bakePluginId :: (PluginId, PluginDescriptor IdeState) -> IdeHandlers
+    bakePluginId (pid,pluginDesc) = IdeHandlers $ DMap.map
       (\(PluginHandler f) -> IdeHandler [(pid,f pid)])
       hs
+      where
+        PluginHandlers hs = HLS.pluginHandlers pluginDesc
     handlers = mconcat $ do
       (IdeMethod m :=> IdeHandler fs') <- DMap.assocs handlers'
       pure $ requestHandler m $ \ide params -> do
         config <- Ide.PluginUtils.getClientConfig
-        let fs = filter (\(pid,_) -> pluginEnabled m pid config) fs'
-        case nonEmpty fs of
-          Nothing -> pure $ Left $ ResponseError InvalidRequest
-            ("No plugin enabled for " <> T.pack (show m) <> ", available: " <> T.pack (show $ map fst fs))
-            Nothing
-          Just fs -> do
-            let msg e pid = "Exception in plugin " <> T.pack (show pid) <> "while processing " <> T.pack (show m) <> ": " <> T.pack (show e)
-            es <- runConcurrently msg (show m) fs ide params
-            let (errs,succs) = partitionEithers $ toList es
-            case nonEmpty succs of
-              Nothing -> pure $ Left $ combineErrors errs
-              Just xs -> do
-                caps <- LSP.getClientCapabilities
-                pure $ Right $ combineResponses m config caps params xs
+        let pluginInfo = map (\(pid,_) -> (pid, getPluginDescriptor pid)) fs'
+        cleanPluginInfo <- collectPluginDescriptors pluginInfo []
+        case cleanPluginInfo of
+          Left err -> pure $ Left err
+          Right pluginInfos -> do
+            let fs = map snd $ filter (\((_, desc), _) -> pluginEnabled m params desc config) (zip pluginInfos fs')
+            case nonEmpty fs of
+              Nothing -> pure $ Left $ ResponseError InvalidRequest
+                ("No plugin enabled for " <> T.pack (show m) <> ", available: " <> T.pack (show $ map fst fs))
+                Nothing
+              Just fs -> do
+                let msg e pid = "Exception in plugin " <> T.pack (show pid) <> "while processing " <> T.pack (show m) <> ": " <> T.pack (show e)
+                es <- runConcurrently msg (show m) fs ide params
+                let (errs,succs) = partitionEithers $ toList es
+                case nonEmpty succs of
+                  Nothing -> pure $ Left $ combineErrors errs
+                  Just xs -> do
+                    caps <- LSP.getClientCapabilities
+                    pure $ Right $ combineResponses m config caps params xs
+
+collectPluginDescriptors :: [(PluginId, Maybe (PluginDescriptor c))] -> [(PluginId, PluginDescriptor c)] -> LSP.LspM Config (Either ResponseError [(PluginId, PluginDescriptor c)])
+collectPluginDescriptors ((pid, Nothing):_) _ = pure $ Left $ ResponseError InvalidRequest
+        ("No plugindescriptor found for " <>  pidT <> ", available: ")
+        Nothing
+  where
+    PluginId pidT = pid
+collectPluginDescriptors ((pid, Just desc):xs) ys = collectPluginDescriptors xs (ys ++ [(pid, desc)])
+collectPluginDescriptors [] ys = pure $ Right ys
+
 -- ---------------------------------------------------------------------
 
-extensibleNotificationPlugins :: Recorder (WithPriority Log) -> [(PluginId, PluginNotificationHandlers IdeState)] -> Plugin Config
+extensibleNotificationPlugins :: Recorder (WithPriority Log) -> [(PluginId, PluginDescriptor IdeState)] -> Plugin Config
 extensibleNotificationPlugins recorder xs = mempty { P.pluginHandlers = handlers }
   where
+    getPluginDescriptor pid = lookup pid xs
     IdeNotificationHandlers handlers' = foldMap bakePluginId xs
-    bakePluginId :: (PluginId, PluginNotificationHandlers IdeState) -> IdeNotificationHandlers
-    bakePluginId (pid,PluginNotificationHandlers hs) = IdeNotificationHandlers $ DMap.map
+    bakePluginId :: (PluginId, PluginDescriptor IdeState) -> IdeNotificationHandlers
+    bakePluginId (pid,pluginDesc) = IdeNotificationHandlers $ DMap.map
       (\(PluginNotificationHandler f) -> IdeNotificationHandler [(pid,f pid)])
       hs
+      where PluginNotificationHandlers hs = HLS.pluginNotificationHandlers pluginDesc
     handlers = mconcat $ do
       (IdeNotification m :=> IdeNotificationHandler fs') <- DMap.assocs handlers'
       pure $ notificationHandler m $ \ide vfs params -> do
         config <- Ide.PluginUtils.getClientConfig
-        let fs = filter (\(pid,_) -> plcGlobalOn $ configForPlugin config pid) fs'
-        case nonEmpty fs of
-          Nothing -> do
-              logWith recorder Info LogNoEnabledPlugins
-              pure ()
-          Just fs -> do
-            -- We run the notifications in order, so the core ghcide provider
-            -- (which restarts the shake process) hopefully comes last
-              mapM_ (\(pid,f) -> otTracedProvider pid (fromString $ show m) $ f ide vfs params) fs
+        let pluginInfo = map (\(pid,_) -> (pid, getPluginDescriptor pid)) fs'
+        cleanPluginInfo <- collectPluginDescriptors pluginInfo []
+        case cleanPluginInfo of
+          Left _ -> pure ()
+          Right pluginInfos -> do
+            let fs = map snd $ filter (\((_, desc), _) -> pluginEnabled2 m params desc config) (zip pluginInfos fs')
+            case nonEmpty fs of
+                Nothing -> do
+                  logWith recorder Info LogNoEnabledPlugins
+                  pure ()
+                Just fs -> do
+                  -- We run the notifications in order, so the core ghcide provider
+                  -- (which restarts the shake process) hopefully comes last
+                  mapM_ (\(pid,f) -> otTracedProvider pid (fromString $ show m) $ f ide vfs params) fs
 
 -- ---------------------------------------------------------------------
 

haskell-language-server.cabal

@@ -226,7 +226,8 @@ flag dynamic
 common example-plugins
   hs-source-dirs: plugins/default/src
   other-modules: Ide.Plugin.Example,
-                 Ide.Plugin.Example2
+                 Ide.Plugin.Example2,
+                 Ide.Plugin.ExampleCabal
 
 common class
   if flag(class)

hls-plugin-api/hls-plugin-api.cabal

@@ -43,6 +43,7 @@ library
     , Diff                  ^>=0.4.0
     , dlist
     , extra
+    , filepath
     , ghc
     , hashable
     , hls-graph             ^>= 1.7