From 9ade5e5e90fb2a09476f53efd0d559b346885705 Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Tue, 16 Feb 2021 13:53:06 +0000 Subject: [PATCH 01/16] Provide pluginNotificationhandlers too Like pluginHandlers, but for notifications At present the last one in the chain wins, so if one is set it overrides the one built into ghcide --- .../src/Development/IDE/LSP/Notifications.hs | 1 + ghcide/src/Development/IDE/Plugin/HLS.hs | 50 +++++++++++++- hls-plugin-api/src/Ide/Types.hs | 67 ++++++++++++++++++- 3 files changed, 115 insertions(+), 3 deletions(-) diff --git a/ghcide/src/Development/IDE/LSP/Notifications.hs b/ghcide/src/Development/IDE/LSP/Notifications.hs index ccdcbacab6..45b3e97afe 100644 --- a/ghcide/src/Development/IDE/LSP/Notifications.hs +++ b/ghcide/src/Development/IDE/LSP/Notifications.hs @@ -8,6 +8,7 @@ module Development.IDE.LSP.Notifications ( setHandlersNotifications + , whenUriFile ) where import qualified Language.LSP.Server as LSP diff --git a/ghcide/src/Development/IDE/Plugin/HLS.hs b/ghcide/src/Development/IDE/Plugin/HLS.hs index 2113a38b77..ef981f8594 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS.hs @@ -1,5 +1,9 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} module Development.IDE.Plugin.HLS ( @@ -45,6 +49,7 @@ asGhcIdePlugin defaultConfig mp = mkPlugin rulesPlugins HLS.pluginRules <> mkPlugin executeCommandPlugins HLS.pluginCommands <> mkPlugin (extensiblePlugins defaultConfig) HLS.pluginHandlers + mkPlugin extensibleNotificationPlugins HLS.pluginNotificationHandlers where ls = Map.toList (ipMap mp) @@ -154,6 +159,34 @@ extensiblePlugins defaultConfig xs = Plugin mempty handlers Just xs -> do caps <- LSP.getClientCapabilities pure $ Right $ combineResponses m config caps params xs +-- --------------------------------------------------------------------- + +extensibleNotificationPlugins :: [(PluginId, PluginNotificationHandlers IdeState)] -> Plugin Config +extensibleNotificationPlugins xs = Plugin mempty handlers + where + IdeNotificationHandlers handlers' = foldMap bakePluginId xs + bakePluginId :: (PluginId, PluginNotificationHandlers IdeState) -> IdeNotificationHandlers + bakePluginId (pid,PluginNotificationHandlers hs) = IdeNotificationHandlers $ DMap.map + (\(PluginNotificationHandler f) -> IdeNotificationHandler [(pid,f pid)]) + hs + handlers = mconcat $ do + (IdeNotification m :=> IdeNotificationHandler fs') <- DMap.assocs handlers' + pure $ notificationHandler m $ \ide params -> do + liftIO $ logInfo (ideLogger ide) "extensibleNotificationPlugins handler entered" + config <- getClientConfig + let fs = filter (\(pid,_) -> pluginEnabledNotification m pid config) fs' + case nonEmpty fs of + Nothing -> do + liftIO $ logInfo (ideLogger ide) "extensibleNotificationPlugins no enabled plugins" + pure () + -- We run the notifications in order, so the built-in ghcide + -- processing (which restarts the shake process) comes last + -- Just fs -> void $ runConcurrentlyNotification (show m) fs ide params + Just fs -> do + liftIO $ logInfo (ideLogger ide) $ "extensibleNotificationPlugins number of plugins:" <> T.pack (show (length fs)) + mapM_ (\(_pid,f) -> f ide params) fs + +-- --------------------------------------------------------------------- runConcurrently :: MonadUnliftIO m @@ -175,12 +208,25 @@ combineErrors xs = ResponseError InternalError (T.pack (show xs)) Nothing newtype IdeHandler (m :: J.Method FromClient Request) = IdeHandler [(PluginId,IdeState -> MessageParams m -> LSP.LspM Config (NonEmpty (Either ResponseError (ResponseResult m))))] +-- | Combine the 'PluginHandler' for all plugins +newtype IdeNotificationHandler (m :: J.Method FromClient Notification) + = IdeNotificationHandler [(PluginId,(IdeState -> MessageParams m -> LSP.LspM Config (NonEmpty ())))] +-- type NotificationHandler (m :: Method FromClient Notification) = MessageParams m -> IO ()` + -- | Combine the 'PluginHandlers' for all plugins -newtype IdeHandlers = IdeHandlers (DMap IdeMethod IdeHandler) +newtype IdeHandlers = IdeHandlers (DMap IdeMethod IdeHandler) +newtype IdeNotificationHandlers = IdeNotificationHandlers (DMap IdeNotification IdeNotificationHandler) instance Semigroup IdeHandlers where (IdeHandlers a) <> (IdeHandlers b) = IdeHandlers $ DMap.unionWithKey go a b where - go _ (IdeHandler a) (IdeHandler b) = IdeHandler (a ++ b) + go _ (IdeHandler a) (IdeHandler b) = IdeHandler (a <> b) instance Monoid IdeHandlers where mempty = IdeHandlers mempty + +instance Semigroup IdeNotificationHandlers where + (IdeNotificationHandlers a) <> (IdeNotificationHandlers b) = IdeNotificationHandlers $ DMap.unionWithKey go a b + where + go _ (IdeNotificationHandler a) (IdeNotificationHandler b) = IdeNotificationHandler (a <> b) +instance Monoid IdeNotificationHandlers where + mempty = IdeNotificationHandlers mempty diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index f9585a16c1..23f3c80897 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -64,6 +64,7 @@ data PluginDescriptor ideState = , pluginCommands :: ![PluginCommand ideState] , pluginHandlers :: PluginHandlers ideState , pluginCustomConfig :: CustomConfig + , pluginNotificationHandlers :: PluginNotificationHandlers ideState } -- | An existential wrapper of 'Properties', used only for documenting and generating config templates @@ -191,6 +192,26 @@ instance PluginMethod TextDocumentRangeFormatting where pluginEnabled _ pid conf = (PluginId $ formattingProvider conf) == pid combineResponses _ _ _ _ (x :| _) = x +-- --------------------------------------------------------------------- + +-- | Notifications that can be handled by plugins. +-- 'ExtraParams' captures any extra data the IDE passes to the handlers for this method +class HasTracing (MessageParams m) => PluginNotification m where + + -- | Parse the configuration to check if this plugin is enabled + pluginEnabledNotification :: SMethod m -> PluginId -> Config -> Bool + +instance PluginNotification TextDocumentDidOpen where + pluginEnabledNotification _ _ _ = True + +instance PluginNotification TextDocumentDidChange where + pluginEnabledNotification _ _ _ = True + +instance PluginNotification TextDocumentDidSave where + pluginEnabledNotification _ _ _ = True + +-- --------------------------------------------------------------------- + -- | Methods which have a PluginMethod instance data IdeMethod (m :: Method FromClient Request) = PluginMethod m => IdeMethod (SMethod m) instance GEq IdeMethod where @@ -198,11 +219,32 @@ instance GEq IdeMethod where instance GCompare IdeMethod where gcompare (IdeMethod a) (IdeMethod b) = gcompare a b +-- | Methods which have a PluginMethod instance +data IdeNotification (m :: Method FromClient Notification) = PluginNotification m => IdeNotification (SMethod m) +instance GEq IdeNotification where + geq (IdeNotification a) (IdeNotification b) = geq a b +instance GCompare IdeNotification where + gcompare (IdeNotification a) (IdeNotification b) = gcompare a b + -- | Combine handlers for the newtype PluginHandler a (m :: Method FromClient Request) = PluginHandler (PluginId -> a -> MessageParams m -> LspM Config (NonEmpty (Either ResponseError (ResponseResult m)))) -newtype PluginHandlers a = PluginHandlers (DMap IdeMethod (PluginHandler a)) +newtype PluginNotificationHandler a (m :: Method FromClient Notification) + = PluginNotificationHandler (PluginId -> a -> MessageParams m -> LspM Config (NonEmpty ())) +-- newtype PluginNotificationHandler a (m :: Method FromClient Notification) +-- = PluginNotificationHandler (PluginNotificationMethodHandler a m)` + +{- +From Zubin +alanz_: I would say `newtype PluginNotificationHandler a (m :: Method FromClient Notification) = PluginNotificationHandler (PluginNotificationMethodHandler a m)` +16:28 and `newtype PluginNotificationHandlers a = PluginNotificationHandlers (DMap SMethod (PluginNotificationHandler a)) + +-} + +newtype PluginHandlers a = PluginHandlers (DMap IdeMethod (PluginHandler a)) +newtype PluginNotificationHandlers a = PluginNotificationHandlers (DMap IdeNotification (PluginNotificationHandler a)) +-- newtype PluginNotificationHandlers a = PluginNotificationHandlers (DMap SMethod (PluginNotificationHandler a)) instance Semigroup (PluginHandlers a) where (PluginHandlers a) <> (PluginHandlers b) = PluginHandlers $ DMap.unionWithKey go a b @@ -213,8 +255,19 @@ instance Semigroup (PluginHandlers a) where instance Monoid (PluginHandlers a) where mempty = PluginHandlers mempty +instance Semigroup (PluginNotificationHandlers a) where + (PluginNotificationHandlers a) <> (PluginNotificationHandlers b) = PluginNotificationHandlers $ DMap.unionWithKey go a b + where + go _ (PluginNotificationHandler f) (PluginNotificationHandler g) = PluginNotificationHandler $ \pid ide params -> + f pid ide params >> g pid ide params + +instance Monoid (PluginNotificationHandlers a) where + mempty = PluginNotificationHandlers mempty + type PluginMethodHandler a m = a -> PluginId -> MessageParams m -> LspM Config (Either ResponseError (ResponseResult m)) +type PluginNotificationMethodHandler a m = a -> PluginId -> MessageParams m -> LspM Config () + -- | Make a handler for plugins with no extra data mkPluginHandler :: PluginMethod m @@ -225,6 +278,17 @@ mkPluginHandler m f = PluginHandlers $ DMap.singleton (IdeMethod m) (PluginHandl where f' pid ide params = pure <$> f ide pid params +-- | Make a handler for plugins with no extra data +mkPluginNotificationHandler + :: (PluginNotification m) + => SClientMethod (m :: Method FromClient Notification) + -> PluginNotificationMethodHandler ideState m + -> PluginNotificationHandlers ideState +mkPluginNotificationHandler m f + = PluginNotificationHandlers $ DMap.singleton (IdeNotification m) (PluginNotificationHandler f') + where + f' pid ide params = pure <$> f ide pid params + defaultPluginDescriptor :: PluginId -> PluginDescriptor ideState defaultPluginDescriptor plId = PluginDescriptor @@ -233,6 +297,7 @@ defaultPluginDescriptor plId = mempty mempty emptyCustomConfig + mempty newtype CommandId = CommandId T.Text deriving (Show, Read, Eq, Ord) From f334ee5303e3661f4a3827fc4b2c9dc63b379731 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 17 Mar 2021 17:48:38 +0000 Subject: [PATCH 02/16] Fix handling of config --- ghcide/src/Development/IDE/Plugin/HLS.hs | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/HLS.hs b/ghcide/src/Development/IDE/Plugin/HLS.hs index ef981f8594..8667befd69 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS.hs @@ -1,9 +1,8 @@ -{-# LANGUAGE GADTs #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PolyKinds #-} module Development.IDE.Plugin.HLS ( @@ -12,6 +11,7 @@ module Development.IDE.Plugin.HLS import Control.Exception (SomeException) import Control.Monad +import Control.Monad.IO.Class import qualified Data.Aeson as J import Data.Bifunctor import Data.Dependent.Map (DMap) @@ -28,6 +28,7 @@ import Development.IDE.Core.Shake import Development.IDE.Core.Tracing import Development.IDE.LSP.Server import Development.IDE.Plugin +import Development.IDE.Types.Logger import Development.Shake (Rules) import Ide.Plugin.Config import Ide.PluginUtils (getClientConfig) @@ -48,8 +49,8 @@ asGhcIdePlugin :: Config -> IdePlugins IdeState -> Plugin Config asGhcIdePlugin defaultConfig mp = mkPlugin rulesPlugins HLS.pluginRules <> mkPlugin executeCommandPlugins HLS.pluginCommands <> - mkPlugin (extensiblePlugins defaultConfig) HLS.pluginHandlers - mkPlugin extensibleNotificationPlugins HLS.pluginNotificationHandlers + mkPlugin (extensiblePlugins defaultConfig) HLS.pluginHandlers <> + mkPlugin (extensibleNotificationPlugins defaultConfig) HLS.pluginNotificationHandlers where ls = Map.toList (ipMap mp) @@ -161,8 +162,8 @@ extensiblePlugins defaultConfig xs = Plugin mempty handlers pure $ Right $ combineResponses m config caps params xs -- --------------------------------------------------------------------- -extensibleNotificationPlugins :: [(PluginId, PluginNotificationHandlers IdeState)] -> Plugin Config -extensibleNotificationPlugins xs = Plugin mempty handlers +extensibleNotificationPlugins :: Config -> [(PluginId, PluginNotificationHandlers IdeState)] -> Plugin Config +extensibleNotificationPlugins defaultConfig xs = Plugin mempty handlers where IdeNotificationHandlers handlers' = foldMap bakePluginId xs bakePluginId :: (PluginId, PluginNotificationHandlers IdeState) -> IdeNotificationHandlers @@ -173,7 +174,7 @@ extensibleNotificationPlugins xs = Plugin mempty handlers (IdeNotification m :=> IdeNotificationHandler fs') <- DMap.assocs handlers' pure $ notificationHandler m $ \ide params -> do liftIO $ logInfo (ideLogger ide) "extensibleNotificationPlugins handler entered" - config <- getClientConfig + config <- fromMaybe defaultConfig <$> Ide.PluginUtils.getClientConfig let fs = filter (\(pid,_) -> pluginEnabledNotification m pid config) fs' case nonEmpty fs of Nothing -> do From b580c38f66537aa54774ede9953a1a521680fe1f Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 17 Mar 2021 18:17:15 +0000 Subject: [PATCH 03/16] run the handlers in parallel --- ghcide/src/Development/IDE/Plugin/HLS.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/HLS.hs b/ghcide/src/Development/IDE/Plugin/HLS.hs index 8667befd69..21bba57f7c 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS.hs @@ -38,7 +38,8 @@ import Language.LSP.Types import qualified Language.LSP.Types as J import Text.Regex.TDFA.Text () import UnliftIO (MonadUnliftIO) -import UnliftIO.Async (forConcurrently) +import UnliftIO.Async (forConcurrently, + mapConcurrently_) import UnliftIO.Exception (catchAny) -- --------------------------------------------------------------------- @@ -185,7 +186,8 @@ extensibleNotificationPlugins defaultConfig xs = Plugin mempty handlers -- Just fs -> void $ runConcurrentlyNotification (show m) fs ide params Just fs -> do liftIO $ logInfo (ideLogger ide) $ "extensibleNotificationPlugins number of plugins:" <> T.pack (show (length fs)) - mapM_ (\(_pid,f) -> f ide params) fs + -- run notification handlers in parallel + mapConcurrently_ (\(_pid,f) -> f ide params) fs -- --------------------------------------------------------------------- @@ -211,7 +213,7 @@ newtype IdeHandler (m :: J.Method FromClient Request) -- | Combine the 'PluginHandler' for all plugins newtype IdeNotificationHandler (m :: J.Method FromClient Notification) - = IdeNotificationHandler [(PluginId,(IdeState -> MessageParams m -> LSP.LspM Config (NonEmpty ())))] + = IdeNotificationHandler [(PluginId, IdeState -> MessageParams m -> LSP.LspM Config (NonEmpty ()))] -- type NotificationHandler (m :: Method FromClient Notification) = MessageParams m -> IO ()` -- | Combine the 'PluginHandlers' for all plugins From ebdd7af9eb67e63e8971da83986cd38738c4a691 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 17 Mar 2021 18:33:43 +0000 Subject: [PATCH 04/16] add missing instances --- hls-plugin-api/src/Ide/Types.hs | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index 23f3c80897..bfcd41982a 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -210,6 +210,21 @@ instance PluginNotification TextDocumentDidChange where instance PluginNotification TextDocumentDidSave where pluginEnabledNotification _ _ _ = True +instance PluginNotification TextDocumentDidClose where + pluginEnabledNotification _ _ _ = True + +instance PluginNotification WorkspaceDidChangeWatchedFiles where + pluginEnabledNotification _ _ _ = True + +instance PluginNotification WorkspaceDidChangeWorkspaceFolders where + pluginEnabledNotification _ _ _ = True + +instance PluginNotification WorkspaceDidChangeConfiguration where + pluginEnabledNotification _ _ _ = True + +instance PluginNotification Initialized where + pluginEnabledNotification _ _ _ = True + -- --------------------------------------------------------------------- -- | Methods which have a PluginMethod instance From 9618fa1c37ab46f95b2c74fe10e42f6f0ee4283c Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 17 Mar 2021 18:34:20 +0000 Subject: [PATCH 05/16] Extract ghcide notification handlers to an HLS plugin This is required to allow for user defined notification handlers, otherwise HLS plugins will overwrite the ghcide handlers and nothing will work --- .../src/Development/IDE/LSP/LanguageServer.hs | 1 - .../src/Development/IDE/LSP/Notifications.hs | 41 ++++++++++--------- .../src/Development/IDE/Plugin/HLS/GhcIde.hs | 28 +++++++------ 3 files changed, 36 insertions(+), 34 deletions(-) diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs index df9c12264b..128af01381 100644 --- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs +++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs @@ -100,7 +100,6 @@ runLanguageServer options getHieDbLoc onConfigurationChange userHandlers getIdeS let ideHandlers = mconcat [ setIdeHandlers , userHandlers - , setHandlersNotifications -- absolutely critical, join them with user notifications ] -- Send everything over a channel, since you need to wait until after initialise before diff --git a/ghcide/src/Development/IDE/LSP/Notifications.hs b/ghcide/src/Development/IDE/LSP/Notifications.hs index 45b3e97afe..e1909691f9 100644 --- a/ghcide/src/Development/IDE/LSP/Notifications.hs +++ b/ghcide/src/Development/IDE/LSP/Notifications.hs @@ -7,8 +7,8 @@ {-# LANGUAGE RankNTypes #-} module Development.IDE.LSP.Notifications - ( setHandlersNotifications - , whenUriFile + ( whenUriFile + , descriptor ) where import qualified Language.LSP.Server as LSP @@ -38,15 +38,15 @@ import Development.IDE.Core.FileStore (resetFileStore, typecheckParents) import Development.IDE.Core.OfInterest import Ide.Plugin.Config (CheckParents (CheckOnClose)) - +import Ide.Types whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO () whenUriFile uri act = whenJust (LSP.uriToFilePath uri) $ act . toNormalizedFilePath' -setHandlersNotifications :: LSP.Handlers (ServerM c) -setHandlersNotifications = mconcat - [ notificationHandler LSP.STextDocumentDidOpen $ - \ide (DidOpenTextDocumentParams TextDocumentItem{_uri,_version}) -> liftIO $ do +descriptor :: PluginId -> PluginDescriptor IdeState +descriptor plId = (defaultPluginDescriptor plId) { pluginNotificationHandlers = mconcat + [ mkPluginNotificationHandler LSP.STextDocumentDidOpen $ + \ide _ (DidOpenTextDocumentParams TextDocumentItem{_uri,_version}) -> liftIO $ do updatePositionMapping ide (VersionedTextDocumentIdentifier _uri (Just _version)) (List []) whenUriFile _uri $ \file -> do -- We don't know if the file actually exists, or if the contents match those on disk @@ -55,23 +55,23 @@ setHandlersNotifications = mconcat setFileModified ide False file logDebug (ideLogger ide) $ "Opened text document: " <> getUri _uri - , notificationHandler LSP.STextDocumentDidChange $ - \ide (DidChangeTextDocumentParams identifier@VersionedTextDocumentIdentifier{_uri} changes) -> liftIO $ do + , mkPluginNotificationHandler LSP.STextDocumentDidChange $ + \ide _ (DidChangeTextDocumentParams identifier@VersionedTextDocumentIdentifier{_uri} changes) -> liftIO $ do updatePositionMapping ide identifier changes whenUriFile _uri $ \file -> do modifyFilesOfInterest ide (M.insert file Modified{firstOpen=False}) setFileModified ide False file logDebug (ideLogger ide) $ "Modified text document: " <> getUri _uri - , notificationHandler LSP.STextDocumentDidSave $ - \ide (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do + , mkPluginNotificationHandler LSP.STextDocumentDidSave $ + \ide _ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do whenUriFile _uri $ \file -> do modifyFilesOfInterest ide (M.insert file OnDisk) setFileModified ide True file logDebug (ideLogger ide) $ "Saved text document: " <> getUri _uri - , notificationHandler LSP.STextDocumentDidClose $ - \ide (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do + , mkPluginNotificationHandler LSP.STextDocumentDidClose $ + \ide _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do whenUriFile _uri $ \file -> do modifyFilesOfInterest ide (M.delete file) -- Refresh all the files that depended on this @@ -79,8 +79,8 @@ setHandlersNotifications = mconcat when (checkParents >= CheckOnClose) $ typecheckParents ide file logDebug (ideLogger ide) $ "Closed text document: " <> getUri _uri - , notificationHandler LSP.SWorkspaceDidChangeWatchedFiles $ - \ide (DidChangeWatchedFilesParams (List fileEvents)) -> liftIO $ do + , mkPluginNotificationHandler LSP.SWorkspaceDidChangeWatchedFiles $ + \ide _ (DidChangeWatchedFilesParams (List fileEvents)) -> liftIO $ do -- See Note [File existence cache and LSP file watchers] which explains why we get these notifications and -- what we do with them let msg = Text.pack $ show fileEvents @@ -89,22 +89,22 @@ setHandlersNotifications = mconcat resetFileStore ide fileEvents setSomethingModified ide - , notificationHandler LSP.SWorkspaceDidChangeWorkspaceFolders $ - \ide (DidChangeWorkspaceFoldersParams events) -> liftIO $ do + , mkPluginNotificationHandler LSP.SWorkspaceDidChangeWorkspaceFolders $ + \ide _ (DidChangeWorkspaceFoldersParams events) -> liftIO $ do let add = S.union substract = flip S.difference modifyWorkspaceFolders ide $ add (foldMap (S.singleton . parseWorkspaceFolder) (_added events)) . substract (foldMap (S.singleton . parseWorkspaceFolder) (_removed events)) - , notificationHandler LSP.SWorkspaceDidChangeConfiguration $ - \ide (DidChangeConfigurationParams cfg) -> liftIO $ do + , mkPluginNotificationHandler LSP.SWorkspaceDidChangeConfiguration $ + \ide _ (DidChangeConfigurationParams cfg) -> liftIO $ do let msg = Text.pack $ show cfg logDebug (ideLogger ide) $ "Configuration changed: " <> msg modifyClientSettings ide (const $ Just cfg) setSomethingModified ide - , notificationHandler LSP.SInitialized $ \ide _ -> do + , mkPluginNotificationHandler LSP.SInitialized $ \ide _ _ -> do clientCapabilities <- LSP.getClientCapabilities let watchSupported = case () of _ | LSP.ClientCapabilities{_workspace} <- clientCapabilities @@ -139,3 +139,4 @@ setHandlersNotifications = mconcat void $ LSP.sendRequest SClientRegisterCapability regParams (const $ pure ()) -- TODO handle response else liftIO $ logDebug (ideLogger ide) "Warning: Client does not support watched files. Falling back to OS polling" ] + } diff --git a/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs b/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs index 636c2c6287..9d6892bf75 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs @@ -1,29 +1,31 @@ {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} -- | Exposes the ghcide features as an HLS plugin module Development.IDE.Plugin.HLS.GhcIde ( descriptors ) where -import Development.IDE -import Development.IDE.LSP.HoverDefinition -import Development.IDE.LSP.Outline -import Ide.Types -import Language.LSP.Types -import Language.LSP.Server (LspM) -import Text.Regex.TDFA.Text() -import qualified Development.IDE.Plugin.CodeAction as CodeAction -import qualified Development.IDE.Plugin.Completions as Completions -import qualified Development.IDE.Plugin.TypeLenses as TypeLenses -import Control.Monad.IO.Class +import Control.Monad.IO.Class +import Development.IDE +import Development.IDE.LSP.HoverDefinition +import qualified Development.IDE.LSP.Notifications as Notifications +import Development.IDE.LSP.Outline +import qualified Development.IDE.Plugin.CodeAction as CodeAction +import qualified Development.IDE.Plugin.Completions as Completions +import qualified Development.IDE.Plugin.TypeLenses as TypeLenses +import Ide.Types +import Language.LSP.Server (LspM) +import Language.LSP.Types +import Text.Regex.TDFA.Text () descriptors :: [PluginDescriptor IdeState] descriptors = [ descriptor "ghcide-hover-and-symbols", CodeAction.descriptor "ghcide-code-actions", Completions.descriptor "ghcide-completions", - TypeLenses.descriptor "ghcide-type-lenses" + TypeLenses.descriptor "ghcide-type-lenses", + Notifications.descriptor "ghcide-core" ] -- --------------------------------------------------------------------- From 3c1d1e90cafd2028a35ed03593c7d49149b8dd89 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 17 Mar 2021 19:47:02 +0000 Subject: [PATCH 06/16] Update hls-plugin-api/src/Ide/Types.hs Co-authored-by: wz1000 --- hls-plugin-api/src/Ide/Types.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index bfcd41982a..aba049b5b7 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -246,7 +246,7 @@ newtype PluginHandler a (m :: Method FromClient Request) = PluginHandler (PluginId -> a -> MessageParams m -> LspM Config (NonEmpty (Either ResponseError (ResponseResult m)))) newtype PluginNotificationHandler a (m :: Method FromClient Notification) - = PluginNotificationHandler (PluginId -> a -> MessageParams m -> LspM Config (NonEmpty ())) + = PluginNotificationHandler (PluginId -> a -> MessageParams m -> LspM Config ()) -- newtype PluginNotificationHandler a (m :: Method FromClient Notification) -- = PluginNotificationHandler (PluginNotificationMethodHandler a m)` From babbb93dfd7f21de81c3db2cd3f847510ad407dd Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 17 Mar 2021 20:56:59 +0000 Subject: [PATCH 07/16] bump version numbers to track breaking changes --- ghcide/ghcide.cabal | 2 +- hls-plugin-api/hls-plugin-api.cabal | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 50e8296126..c22fc19f49 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -58,7 +58,7 @@ library haddock-library >= 1.8 && < 1.10, hashable, hie-compat ^>= 0.1.0.0, - hls-plugin-api ^>= 1.0.0.0, + hls-plugin-api ^>= 1.1.0.0, lens, hiedb == 0.3.0.1, lsp-types == 1.1.*, diff --git a/hls-plugin-api/hls-plugin-api.cabal b/hls-plugin-api/hls-plugin-api.cabal index 378364c434..6c6f48319b 100644 --- a/hls-plugin-api/hls-plugin-api.cabal +++ b/hls-plugin-api/hls-plugin-api.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: hls-plugin-api -version: 1.0.0.0 +version: 1.1.0.0 synopsis: Haskell Language Server API for plugin communication description: Please see the README on GitHub at From 36ca256b608516d24ba8deec4055f223ca72c68a Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 17 Mar 2021 20:58:33 +0000 Subject: [PATCH 08/16] hlint pragma --- ghcide/src/Development/IDE/Plugin/HLS.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Plugin/HLS.hs b/ghcide/src/Development/IDE/Plugin/HLS.hs index 21bba57f7c..c8e388fd15 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} From 0b312fcd6432face840632ec4751aa15d66e0e7a Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 17 Mar 2021 21:29:45 +0000 Subject: [PATCH 09/16] fixup! Update hls-plugin-api/src/Ide/Types.hs --- hls-plugin-api/src/Ide/Types.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index aba049b5b7..3dabe7578c 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -302,7 +302,7 @@ mkPluginNotificationHandler mkPluginNotificationHandler m f = PluginNotificationHandlers $ DMap.singleton (IdeNotification m) (PluginNotificationHandler f') where - f' pid ide params = pure <$> f ide pid params + f' pid ide = f ide pid defaultPluginDescriptor :: PluginId -> PluginDescriptor ideState defaultPluginDescriptor plId = From 6c5933007b9ccebc17264bf77020a8ae18ae20e2 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 17 Mar 2021 21:30:12 +0000 Subject: [PATCH 10/16] relax depends constraints --- haskell-language-server.cabal | 4 ++-- plugins/hls-brittany-plugin/hls-brittany-plugin.cabal | 2 +- plugins/hls-class-plugin/hls-class-plugin.cabal | 2 +- plugins/hls-eval-plugin/hls-eval-plugin.cabal | 2 +- .../hls-explicit-imports-plugin.cabal | 2 +- .../hls-haddock-comments-plugin.cabal | 2 +- plugins/hls-hlint-plugin/hls-hlint-plugin.cabal | 2 +- plugins/hls-retrie-plugin/hls-retrie-plugin.cabal | 2 +- plugins/hls-splice-plugin/hls-splice-plugin.cabal | 2 +- plugins/hls-tactics-plugin/hls-tactics-plugin.cabal | 2 +- 10 files changed, 11 insertions(+), 11 deletions(-) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 40313da1fe..7087f97736 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -60,7 +60,7 @@ library , lsp , hie-bios , hiedb - , hls-plugin-api ^>= 1.0.0.0 + , hls-plugin-api >= 1.0 && < 1.2 , hslogger , optparse-applicative , optparse-simple @@ -380,7 +380,7 @@ common hls-test-utils , data-default , lsp , hie-bios - , hls-plugin-api ^>= 1.0.0.0 + , hls-plugin-api >= 1.0 && < 1.2 , hslogger , hspec , hspec-core diff --git a/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal b/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal index f2b6ce840f..0c3961e852 100644 --- a/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal +++ b/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal @@ -22,7 +22,7 @@ library , ghc-boot-th , ghcide ^>= 1.1.0.0 , lsp-types - , hls-plugin-api ^>= 1.0.0.0 + , hls-plugin-api >= 1.0 && < 1.2 , lens , text , transformers diff --git a/plugins/hls-class-plugin/hls-class-plugin.cabal b/plugins/hls-class-plugin/hls-class-plugin.cabal index f210186435..5c8e576681 100644 --- a/plugins/hls-class-plugin/hls-class-plugin.cabal +++ b/plugins/hls-class-plugin/hls-class-plugin.cabal @@ -21,7 +21,7 @@ library , base >=4.12 && <5 , containers , lsp - , hls-plugin-api ^>= 1.0.0.0 + , hls-plugin-api >= 1.0 && < 1.2 , ghc , ghc-exactprint , ghcide ^>= 1.1.0.0 diff --git a/plugins/hls-eval-plugin/hls-eval-plugin.cabal b/plugins/hls-eval-plugin/hls-eval-plugin.cabal index 404b0303ee..fa5e6e2992 100644 --- a/plugins/hls-eval-plugin/hls-eval-plugin.cabal +++ b/plugins/hls-eval-plugin/hls-eval-plugin.cabal @@ -53,7 +53,7 @@ library , hashable , lsp , lsp-types - , hls-plugin-api ^>= 1.0.0.0 + , hls-plugin-api >= 1.0 && < 1.2 , lens , megaparsec >=9.0 , mtl diff --git a/plugins/hls-explicit-imports-plugin/hls-explicit-imports-plugin.cabal b/plugins/hls-explicit-imports-plugin/hls-explicit-imports-plugin.cabal index cb1ad143cf..bc8959a739 100644 --- a/plugins/hls-explicit-imports-plugin/hls-explicit-imports-plugin.cabal +++ b/plugins/hls-explicit-imports-plugin/hls-explicit-imports-plugin.cabal @@ -21,7 +21,7 @@ library , deepseq , lsp-types , lsp - , hls-plugin-api ^>= 1.0.0.0 + , hls-plugin-api >= 1.0 && < 1.2 , ghc , ghcide ^>= 1.1.0.0 , shake diff --git a/plugins/hls-haddock-comments-plugin/hls-haddock-comments-plugin.cabal b/plugins/hls-haddock-comments-plugin/hls-haddock-comments-plugin.cabal index 7d91a6535c..0a0401a351 100644 --- a/plugins/hls-haddock-comments-plugin/hls-haddock-comments-plugin.cabal +++ b/plugins/hls-haddock-comments-plugin/hls-haddock-comments-plugin.cabal @@ -25,7 +25,7 @@ library , ghc-exactprint , ghcide ^>= 1.1.0.0 , lsp-types - , hls-plugin-api ^>= 1.0.0.0 + , hls-plugin-api >= 1.0 && < 1.2 , text , unordered-containers diff --git a/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal b/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal index 927f3687ed..b181bdc46c 100644 --- a/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal +++ b/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal @@ -43,7 +43,7 @@ library , hashable , lsp , hlint >=3.2 - , hls-plugin-api ^>= 1.0.0.0 + , hls-plugin-api >= 1.0 && < 1.2 , hslogger , lens , regex-tdfa diff --git a/plugins/hls-retrie-plugin/hls-retrie-plugin.cabal b/plugins/hls-retrie-plugin/hls-retrie-plugin.cabal index 47f374a553..ae23cb1798 100644 --- a/plugins/hls-retrie-plugin/hls-retrie-plugin.cabal +++ b/plugins/hls-retrie-plugin/hls-retrie-plugin.cabal @@ -23,7 +23,7 @@ library , extra , lsp , lsp-types - , hls-plugin-api ^>= 1.0 + , hls-plugin-api >= 1.0 && < 1.2 , ghc , ghcide ^>= 1.1 , hashable diff --git a/plugins/hls-splice-plugin/hls-splice-plugin.cabal b/plugins/hls-splice-plugin/hls-splice-plugin.cabal index f0ed041828..52d3a46efd 100644 --- a/plugins/hls-splice-plugin/hls-splice-plugin.cabal +++ b/plugins/hls-splice-plugin/hls-splice-plugin.cabal @@ -21,7 +21,7 @@ library , extra , foldl , lsp - , hls-plugin-api ^>= 1.0.0.0 + , hls-plugin-api >= 1.0 && < 1.2 , ghc , ghc-exactprint , ghcide ^>= 1.1.0.0 diff --git a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal index 3ff75ba36c..f264bbf4ce 100644 --- a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal +++ b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal @@ -67,7 +67,7 @@ library , ghc-source-gen , ghcide ^>= 1.1.0.0 , lsp - , hls-plugin-api ^>= 1.0.0.0 + , hls-plugin-api >= 1.0 && < 1.2 , lens , mtl , refinery ^>=0.3 From 96c26479ab0f5aff2254c9e854669a3a7c1426db Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 17 Mar 2021 21:30:30 +0000 Subject: [PATCH 11/16] redundant import --- ghcide/src/Development/IDE/LSP/LanguageServer.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs index 128af01381..fb0062f6e2 100644 --- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs +++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs @@ -41,7 +41,6 @@ import Development.IDE.Core.IdeConfiguration import Development.IDE.Core.Shake import Development.IDE.Core.Tracing import Development.IDE.LSP.HoverDefinition -import Development.IDE.LSP.Notifications import Development.IDE.Types.Logger import System.IO.Unsafe (unsafeInterleaveIO) From 97e04768d96a1b3a0099afe1cbbcc8a4d4b2c6c0 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 17 Mar 2021 22:29:32 +0000 Subject: [PATCH 12/16] fixup! Update hls-plugin-api/src/Ide/Types.hs --- ghcide/src/Development/IDE/Plugin/HLS.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Plugin/HLS.hs b/ghcide/src/Development/IDE/Plugin/HLS.hs index c8e388fd15..6454e4c786 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS.hs @@ -212,7 +212,7 @@ newtype IdeHandler (m :: J.Method FromClient Request) -- | Combine the 'PluginHandler' for all plugins newtype IdeNotificationHandler (m :: J.Method FromClient Notification) - = IdeNotificationHandler [(PluginId, IdeState -> MessageParams m -> LSP.LspM Config (NonEmpty ()))] + = IdeNotificationHandler [(PluginId, IdeState -> MessageParams m -> LSP.LspM Config ())] -- type NotificationHandler (m :: Method FromClient Notification) = MessageParams m -> IO ()` -- | Combine the 'PluginHandlers' for all plugins From cf8ea51a9affbce5428ca6a731da0ac95447b41f Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Thu, 18 Mar 2021 15:25:25 +0000 Subject: [PATCH 13/16] clean up --- ghcide/src/Development/IDE/Plugin/HLS.hs | 1 - hls-plugin-api/src/Ide/Types.hs | 11 ----------- 2 files changed, 12 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/HLS.hs b/ghcide/src/Development/IDE/Plugin/HLS.hs index 6454e4c786..071db95d35 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS.hs @@ -173,7 +173,6 @@ extensibleNotificationPlugins defaultConfig xs = Plugin mempty handlers handlers = mconcat $ do (IdeNotification m :=> IdeNotificationHandler fs') <- DMap.assocs handlers' pure $ notificationHandler m $ \ide params -> do - liftIO $ logInfo (ideLogger ide) "extensibleNotificationPlugins handler entered" config <- fromMaybe defaultConfig <$> Ide.PluginUtils.getClientConfig let fs = filter (\(pid,_) -> pluginEnabledNotification m pid config) fs' case nonEmpty fs of diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index 3dabe7578c..c81d270cd1 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -247,20 +247,9 @@ newtype PluginHandler a (m :: Method FromClient Request) newtype PluginNotificationHandler a (m :: Method FromClient Notification) = PluginNotificationHandler (PluginId -> a -> MessageParams m -> LspM Config ()) --- newtype PluginNotificationHandler a (m :: Method FromClient Notification) --- = PluginNotificationHandler (PluginNotificationMethodHandler a m)` - -{- -From Zubin -alanz_: I would say `newtype PluginNotificationHandler a (m :: Method FromClient Notification) = PluginNotificationHandler (PluginNotificationMethodHandler a m)` -16:28 and `newtype PluginNotificationHandlers a = PluginNotificationHandlers (DMap SMethod (PluginNotificationHandler a)) - --} newtype PluginHandlers a = PluginHandlers (DMap IdeMethod (PluginHandler a)) newtype PluginNotificationHandlers a = PluginNotificationHandlers (DMap IdeNotification (PluginNotificationHandler a)) --- newtype PluginNotificationHandlers a = PluginNotificationHandlers (DMap SMethod (PluginNotificationHandler a)) - instance Semigroup (PluginHandlers a) where (PluginHandlers a) <> (PluginHandlers b) = PluginHandlers $ DMap.unionWithKey go a b where From 352272da82e5563e01b0b438f86afaf5e8f71bd7 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Thu, 18 Mar 2021 15:25:39 +0000 Subject: [PATCH 14/16] run notification handlers sequentially --- exe/Plugins.hs | 5 +++-- ghcide/src/Development/IDE/Plugin/HLS.hs | 13 +++++-------- 2 files changed, 8 insertions(+), 10 deletions(-) diff --git a/exe/Plugins.hs b/exe/Plugins.hs index dec73e8994..4672ab92b2 100644 --- a/exe/Plugins.hs +++ b/exe/Plugins.hs @@ -89,7 +89,6 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins then basePlugins ++ examplePlugins else basePlugins basePlugins = - GhcIde.descriptors ++ #if pragmas Pragmas.descriptor "pragmas" : #endif @@ -135,7 +134,9 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins #if splice Splice.descriptor "splice" : #endif - [] + -- The ghcide descriptors should come last so that the notification handlers + -- (which restart the Shake build) run after everything else + GhcIde.descriptors examplePlugins = [Example.descriptor "eg" ,Example2.descriptor "eg2" diff --git a/ghcide/src/Development/IDE/Plugin/HLS.hs b/ghcide/src/Development/IDE/Plugin/HLS.hs index 071db95d35..fcfb0e7c0e 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS.hs @@ -37,8 +37,7 @@ import Language.LSP.Types import qualified Language.LSP.Types as J import Text.Regex.TDFA.Text () import UnliftIO (MonadUnliftIO) -import UnliftIO.Async (forConcurrently, - mapConcurrently_) +import UnliftIO.Async (forConcurrently) import UnliftIO.Exception (catchAny) -- --------------------------------------------------------------------- @@ -179,13 +178,11 @@ extensibleNotificationPlugins defaultConfig xs = Plugin mempty handlers Nothing -> do liftIO $ logInfo (ideLogger ide) "extensibleNotificationPlugins no enabled plugins" pure () - -- We run the notifications in order, so the built-in ghcide - -- processing (which restarts the shake process) comes last - -- Just fs -> void $ runConcurrentlyNotification (show m) fs ide params Just fs -> do - liftIO $ logInfo (ideLogger ide) $ "extensibleNotificationPlugins number of plugins:" <> T.pack (show (length fs)) - -- run notification handlers in parallel - mapConcurrently_ (\(_pid,f) -> f ide params) fs + -- We run the notifications in order, so the core ghcide provider + -- (which restarts the shake process) hopefully comes last + -- TODO tracing + mapM_ (\(_pid,f) -> f ide params) fs -- --------------------------------------------------------------------- From 8913b464d3021cbb3db7520e1c4a69ed1ef1ca85 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Fri, 19 Mar 2021 11:21:16 +0000 Subject: [PATCH 15/16] Drop PluginNotification (redundant) --- ghcide/src/Development/IDE/Plugin/HLS.hs | 2 +- hls-plugin-api/src/Ide/Types.hs | 37 ++---------------------- 2 files changed, 3 insertions(+), 36 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/HLS.hs b/ghcide/src/Development/IDE/Plugin/HLS.hs index fcfb0e7c0e..2fb0e160c3 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS.hs @@ -173,7 +173,7 @@ extensibleNotificationPlugins defaultConfig xs = Plugin mempty handlers (IdeNotification m :=> IdeNotificationHandler fs') <- DMap.assocs handlers' pure $ notificationHandler m $ \ide params -> do config <- fromMaybe defaultConfig <$> Ide.PluginUtils.getClientConfig - let fs = filter (\(pid,_) -> pluginEnabledNotification m pid config) fs' + let fs = filter (\(pid,_) -> plcGlobalOn $ configForPlugin config pid) fs' case nonEmpty fs of Nothing -> do liftIO $ logInfo (ideLogger ide) "extensibleNotificationPlugins no enabled plugins" diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index c81d270cd1..10703c5a8e 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -194,39 +194,6 @@ instance PluginMethod TextDocumentRangeFormatting where -- --------------------------------------------------------------------- --- | Notifications that can be handled by plugins. --- 'ExtraParams' captures any extra data the IDE passes to the handlers for this method -class HasTracing (MessageParams m) => PluginNotification m where - - -- | Parse the configuration to check if this plugin is enabled - pluginEnabledNotification :: SMethod m -> PluginId -> Config -> Bool - -instance PluginNotification TextDocumentDidOpen where - pluginEnabledNotification _ _ _ = True - -instance PluginNotification TextDocumentDidChange where - pluginEnabledNotification _ _ _ = True - -instance PluginNotification TextDocumentDidSave where - pluginEnabledNotification _ _ _ = True - -instance PluginNotification TextDocumentDidClose where - pluginEnabledNotification _ _ _ = True - -instance PluginNotification WorkspaceDidChangeWatchedFiles where - pluginEnabledNotification _ _ _ = True - -instance PluginNotification WorkspaceDidChangeWorkspaceFolders where - pluginEnabledNotification _ _ _ = True - -instance PluginNotification WorkspaceDidChangeConfiguration where - pluginEnabledNotification _ _ _ = True - -instance PluginNotification Initialized where - pluginEnabledNotification _ _ _ = True - --- --------------------------------------------------------------------- - -- | Methods which have a PluginMethod instance data IdeMethod (m :: Method FromClient Request) = PluginMethod m => IdeMethod (SMethod m) instance GEq IdeMethod where @@ -235,7 +202,7 @@ instance GCompare IdeMethod where gcompare (IdeMethod a) (IdeMethod b) = gcompare a b -- | Methods which have a PluginMethod instance -data IdeNotification (m :: Method FromClient Notification) = PluginNotification m => IdeNotification (SMethod m) +data IdeNotification (m :: Method FromClient Notification) = HasTracing (MessageParams m) => IdeNotification (SMethod m) instance GEq IdeNotification where geq (IdeNotification a) (IdeNotification b) = geq a b instance GCompare IdeNotification where @@ -284,7 +251,7 @@ mkPluginHandler m f = PluginHandlers $ DMap.singleton (IdeMethod m) (PluginHandl -- | Make a handler for plugins with no extra data mkPluginNotificationHandler - :: (PluginNotification m) + :: HasTracing (MessageParams m) => SClientMethod (m :: Method FromClient Notification) -> PluginNotificationMethodHandler ideState m -> PluginNotificationHandlers ideState From cd1a0862c5339a7069e317f0ba0ec5ed551d7f4d Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Fri, 19 Mar 2021 11:25:53 +0000 Subject: [PATCH 16/16] sort out tracing --- ghcide/src/Development/IDE/Plugin/HLS.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/HLS.hs b/ghcide/src/Development/IDE/Plugin/HLS.hs index 2fb0e160c3..1a87e36582 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS.hs @@ -181,8 +181,7 @@ extensibleNotificationPlugins defaultConfig xs = Plugin mempty handlers Just fs -> do -- We run the notifications in order, so the core ghcide provider -- (which restarts the shake process) hopefully comes last - -- TODO tracing - mapM_ (\(_pid,f) -> f ide params) fs + mapM_ (\(pid,f) -> otTracedProvider pid (fromString $ show m) $ f ide params) fs -- ---------------------------------------------------------------------