Skip to content

Commit b9c6e6c

Browse files
pepeiborraalanzwz1000
authored
Add ability for plugins to handle file change notifications (#1588)
* 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 * Fix handling of config * run the handlers in parallel * add missing instances * 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 * Update hls-plugin-api/src/Ide/Types.hs Co-authored-by: wz1000 <[email protected]> * bump version numbers to track breaking changes * hlint pragma * fixup! Update hls-plugin-api/src/Ide/Types.hs * relax depends constraints * redundant import * fixup! Update hls-plugin-api/src/Ide/Types.hs * clean up * run notification handlers sequentially * Drop PluginNotification (redundant) * sort out tracing Co-authored-by: Alan Zimmerman <[email protected]> Co-authored-by: wz1000 <[email protected]>
1 parent 7cb4ab7 commit b9c6e6c

File tree

18 files changed

+137
-55
lines changed

18 files changed

+137
-55
lines changed

‎exe/Plugins.hs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -89,7 +89,6 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins
8989
then basePlugins ++ examplePlugins
9090
else basePlugins
9191
basePlugins =
92-
GhcIde.descriptors ++
9392
#if pragmas
9493
Pragmas.descriptor "pragmas" :
9594
#endif
@@ -135,7 +134,9 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins
135134
#if splice
136135
Splice.descriptor "splice" :
137136
#endif
138-
[]
137+
-- The ghcide descriptors should come last so that the notification handlers
138+
-- (which restart the Shake build) run after everything else
139+
GhcIde.descriptors
139140
examplePlugins =
140141
[Example.descriptor "eg"
141142
,Example2.descriptor "eg2"

‎ghcide/ghcide.cabal‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -58,7 +58,7 @@ library
5858
haddock-library ^>= 1.10.0,
5959
hashable,
6060
hie-compat ^>= 0.1.0.0,
61-
hls-plugin-api ^>= 1.0.0.0,
61+
hls-plugin-api ^>= 1.1.0.0,
6262
lens,
6363
hiedb == 0.3.0.1,
6464
lsp-types == 1.1.*,

‎ghcide/src/Development/IDE/LSP/LanguageServer.hs‎

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -41,7 +41,6 @@ import Development.IDE.Core.IdeConfiguration
4141
import Development.IDE.Core.Shake
4242
import Development.IDE.Core.Tracing
4343
import Development.IDE.LSP.HoverDefinition
44-
import Development.IDE.LSP.Notifications
4544
import Development.IDE.Types.Logger
4645

4746
import System.IO.Unsafe (unsafeInterleaveIO)
@@ -100,7 +99,6 @@ runLanguageServer options getHieDbLoc onConfigurationChange userHandlers getIdeS
10099
let ideHandlers = mconcat
101100
[ setIdeHandlers
102101
, userHandlers
103-
, setHandlersNotifications -- absolutely critical, join them with user notifications
104102
]
105103

106104
-- Send everything over a channel, since you need to wait until after initialise before

‎ghcide/src/Development/IDE/LSP/Notifications.hs‎

Lines changed: 21 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,8 @@
77
{-# LANGUAGE RankNTypes #-}
88

99
module Development.IDE.LSP.Notifications
10-
( setHandlersNotifications
10+
( whenUriFile
11+
, descriptor
1112
) where
1213

1314
import qualified Language.LSP.Server as LSP
@@ -37,15 +38,15 @@ import Development.IDE.Core.FileStore (resetFileStore,
3738
typecheckParents)
3839
import Development.IDE.Core.OfInterest
3940
import Ide.Plugin.Config (CheckParents (CheckOnClose))
40-
41+
import Ide.Types
4142

4243
whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO ()
4344
whenUriFile uri act = whenJust (LSP.uriToFilePath uri) $ act . toNormalizedFilePath'
4445

45-
setHandlersNotifications :: LSP.Handlers (ServerM c)
46-
setHandlersNotifications = mconcat
47-
[ notificationHandler LSP.STextDocumentDidOpen $
48-
\ide (DidOpenTextDocumentParams TextDocumentItem{_uri,_version}) -> liftIO $ do
46+
descriptor :: PluginId -> PluginDescriptor IdeState
47+
descriptor plId = (defaultPluginDescriptor plId) { pluginNotificationHandlers = mconcat
48+
[ mkPluginNotificationHandler LSP.STextDocumentDidOpen $
49+
\ide _ (DidOpenTextDocumentParams TextDocumentItem{_uri,_version}) -> liftIO $ do
4950
updatePositionMapping ide (VersionedTextDocumentIdentifier _uri (Just _version)) (List [])
5051
whenUriFile _uri $ \file -> do
5152
-- We don't know if the file actually exists, or if the contents match those on disk
@@ -54,32 +55,32 @@ setHandlersNotifications = mconcat
5455
setFileModified ide False file
5556
logDebug (ideLogger ide) $ "Opened text document: " <> getUri _uri
5657

57-
, notificationHandler LSP.STextDocumentDidChange $
58-
\ide (DidChangeTextDocumentParams identifier@VersionedTextDocumentIdentifier{_uri} changes) -> liftIO $ do
58+
, mkPluginNotificationHandler LSP.STextDocumentDidChange $
59+
\ide _ (DidChangeTextDocumentParams identifier@VersionedTextDocumentIdentifier{_uri} changes) -> liftIO $ do
5960
updatePositionMapping ide identifier changes
6061
whenUriFile _uri $ \file -> do
6162
modifyFilesOfInterest ide (M.insert file Modified{firstOpen=False})
6263
setFileModified ide False file
6364
logDebug (ideLogger ide) $ "Modified text document: " <> getUri _uri
6465

65-
, notificationHandler LSP.STextDocumentDidSave $
66-
\ide (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do
66+
, mkPluginNotificationHandler LSP.STextDocumentDidSave $
67+
\ide _ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do
6768
whenUriFile _uri $ \file -> do
6869
modifyFilesOfInterest ide (M.insert file OnDisk)
6970
setFileModified ide True file
7071
logDebug (ideLogger ide) $ "Saved text document: " <> getUri _uri
7172

72-
, notificationHandler LSP.STextDocumentDidClose $
73-
\ide (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do
73+
, mkPluginNotificationHandler LSP.STextDocumentDidClose $
74+
\ide _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do
7475
whenUriFile _uri $ \file -> do
7576
modifyFilesOfInterest ide (M.delete file)
7677
-- Refresh all the files that depended on this
7778
checkParents <- optCheckParents =<< getIdeOptionsIO (shakeExtras ide)
7879
when (checkParents >= CheckOnClose) $ typecheckParents ide file
7980
logDebug (ideLogger ide) $ "Closed text document: " <> getUri _uri
8081

81-
, notificationHandler LSP.SWorkspaceDidChangeWatchedFiles $
82-
\ide (DidChangeWatchedFilesParams (List fileEvents)) -> liftIO $ do
82+
, mkPluginNotificationHandler LSP.SWorkspaceDidChangeWatchedFiles $
83+
\ide _ (DidChangeWatchedFilesParams (List fileEvents)) -> liftIO $ do
8384
-- See Note [File existence cache and LSP file watchers] which explains why we get these notifications and
8485
-- what we do with them
8586
let msg = Text.pack $ show fileEvents
@@ -88,22 +89,22 @@ setHandlersNotifications = mconcat
8889
resetFileStore ide fileEvents
8990
setSomethingModified ide
9091

91-
, notificationHandler LSP.SWorkspaceDidChangeWorkspaceFolders $
92-
\ide (DidChangeWorkspaceFoldersParams events) -> liftIO $ do
92+
, mkPluginNotificationHandler LSP.SWorkspaceDidChangeWorkspaceFolders $
93+
\ide _ (DidChangeWorkspaceFoldersParams events) -> liftIO $ do
9394
let add = S.union
9495
substract = flip S.difference
9596
modifyWorkspaceFolders ide
9697
$ add (foldMap (S.singleton . parseWorkspaceFolder) (_added events))
9798
. substract (foldMap (S.singleton . parseWorkspaceFolder) (_removed events))
9899

99-
, notificationHandler LSP.SWorkspaceDidChangeConfiguration $
100-
\ide (DidChangeConfigurationParams cfg) -> liftIO $ do
100+
, mkPluginNotificationHandler LSP.SWorkspaceDidChangeConfiguration $
101+
\ide _ (DidChangeConfigurationParams cfg) -> liftIO $ do
101102
let msg = Text.pack $ show cfg
102103
logDebug (ideLogger ide) $ "Configuration changed: " <> msg
103104
modifyClientSettings ide (const $ Just cfg)
104105
setSomethingModified ide
105106

106-
, notificationHandler LSP.SInitialized $ \ide _ -> do
107+
, mkPluginNotificationHandler LSP.SInitialized $ \ide _ _ -> do
107108
clientCapabilities <- LSP.getClientCapabilities
108109
let watchSupported = case () of
109110
_ | LSP.ClientCapabilities{_workspace} <- clientCapabilities
@@ -138,3 +139,4 @@ setHandlersNotifications = mconcat
138139
void $ LSP.sendRequest SClientRegisterCapability regParams (const $ pure ()) -- TODO handle response
139140
else liftIO $ logDebug (ideLogger ide) "Warning: Client does not support watched files. Falling back to OS polling"
140141
]
142+
}

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

Lines changed: 48 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,7 @@
1-
{-# LANGUAGE GADTs #-}
2-
{-# LANGUAGE PolyKinds #-}
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE GADTs #-}
3+
{-# LANGUAGE OverloadedStrings #-}
4+
{-# LANGUAGE PolyKinds #-}
35

46
module Development.IDE.Plugin.HLS
57
(
@@ -8,6 +10,7 @@ module Development.IDE.Plugin.HLS
810

911
import Control.Exception (SomeException)
1012
import Control.Monad
13+
import Control.Monad.IO.Class
1114
import qualified Data.Aeson as J
1215
import Data.Bifunctor
1316
import Data.Dependent.Map (DMap)
@@ -24,6 +27,7 @@ import Development.IDE.Core.Shake
2427
import Development.IDE.Core.Tracing
2528
import Development.IDE.LSP.Server
2629
import Development.IDE.Plugin
30+
import Development.IDE.Types.Logger
2731
import Development.Shake (Rules)
2832
import Ide.Plugin.Config
2933
import Ide.PluginUtils (getClientConfig)
@@ -44,7 +48,8 @@ asGhcIdePlugin :: Config -> IdePlugins IdeState -> Plugin Config
4448
asGhcIdePlugin defaultConfig mp =
4549
mkPlugin rulesPlugins HLS.pluginRules <>
4650
mkPlugin executeCommandPlugins HLS.pluginCommands <>
47-
mkPlugin (extensiblePlugins defaultConfig) HLS.pluginHandlers
51+
mkPlugin (extensiblePlugins defaultConfig) HLS.pluginHandlers <>
52+
mkPlugin (extensibleNotificationPlugins defaultConfig) HLS.pluginNotificationHandlers
4853
where
4954
ls = Map.toList (ipMap mp)
5055

@@ -154,6 +159,31 @@ extensiblePlugins defaultConfig xs = Plugin mempty handlers
154159
Just xs -> do
155160
caps <- LSP.getClientCapabilities
156161
pure $ Right $ combineResponses m config caps params xs
162+
-- ---------------------------------------------------------------------
163+
164+
extensibleNotificationPlugins :: Config -> [(PluginId, PluginNotificationHandlers IdeState)] -> Plugin Config
165+
extensibleNotificationPlugins defaultConfig xs = Plugin mempty handlers
166+
where
167+
IdeNotificationHandlers handlers' = foldMap bakePluginId xs
168+
bakePluginId :: (PluginId, PluginNotificationHandlers IdeState) -> IdeNotificationHandlers
169+
bakePluginId (pid,PluginNotificationHandlers hs) = IdeNotificationHandlers $ DMap.map
170+
(\(PluginNotificationHandler f) -> IdeNotificationHandler [(pid,f pid)])
171+
hs
172+
handlers = mconcat $ do
173+
(IdeNotification m :=> IdeNotificationHandler fs') <- DMap.assocs handlers'
174+
pure $ notificationHandler m $ \ide params -> do
175+
config <- fromMaybe defaultConfig <$> Ide.PluginUtils.getClientConfig
176+
let fs = filter (\(pid,_) -> plcGlobalOn $ configForPlugin config pid) fs'
177+
case nonEmpty fs of
178+
Nothing -> do
179+
liftIO $ logInfo (ideLogger ide) "extensibleNotificationPlugins no enabled plugins"
180+
pure ()
181+
Just fs -> do
182+
-- We run the notifications in order, so the core ghcide provider
183+
-- (which restarts the shake process) hopefully comes last
184+
mapM_ (\(pid,f) -> otTracedProvider pid (fromString $ show m) $ f ide params) fs
185+
186+
-- ---------------------------------------------------------------------
157187

158188
runConcurrently
159189
:: MonadUnliftIO m
@@ -175,12 +205,25 @@ combineErrors xs = ResponseError InternalError (T.pack (show xs)) Nothing
175205
newtype IdeHandler (m :: J.Method FromClient Request)
176206
= IdeHandler [(PluginId,IdeState -> MessageParams m -> LSP.LspM Config (NonEmpty (Either ResponseError (ResponseResult m))))]
177207

208+
-- | Combine the 'PluginHandler' for all plugins
209+
newtype IdeNotificationHandler (m :: J.Method FromClient Notification)
210+
= IdeNotificationHandler [(PluginId, IdeState -> MessageParams m -> LSP.LspM Config ())]
211+
-- type NotificationHandler (m :: Method FromClient Notification) = MessageParams m -> IO ()`
212+
178213
-- | Combine the 'PluginHandlers' for all plugins
179-
newtype IdeHandlers = IdeHandlers (DMap IdeMethod IdeHandler)
214+
newtype IdeHandlers = IdeHandlers (DMap IdeMethod IdeHandler)
215+
newtype IdeNotificationHandlers = IdeNotificationHandlers (DMap IdeNotification IdeNotificationHandler)
180216

181217
instance Semigroup IdeHandlers where
182218
(IdeHandlers a) <> (IdeHandlers b) = IdeHandlers $ DMap.unionWithKey go a b
183219
where
184-
go _ (IdeHandler a) (IdeHandler b) = IdeHandler (a ++ b)
220+
go _ (IdeHandler a) (IdeHandler b) = IdeHandler (a <> b)
185221
instance Monoid IdeHandlers where
186222
mempty = IdeHandlers mempty
223+
224+
instance Semigroup IdeNotificationHandlers where
225+
(IdeNotificationHandlers a) <> (IdeNotificationHandlers b) = IdeNotificationHandlers $ DMap.unionWithKey go a b
226+
where
227+
go _ (IdeNotificationHandler a) (IdeNotificationHandler b) = IdeNotificationHandler (a <> b)
228+
instance Monoid IdeNotificationHandlers where
229+
mempty = IdeNotificationHandlers mempty

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

Lines changed: 15 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -1,29 +1,31 @@
11
{-# LANGUAGE DuplicateRecordFields #-}
2-
{-# LANGUAGE OverloadedStrings #-}
2+
{-# LANGUAGE OverloadedStrings #-}
33

44
-- | Exposes the ghcide features as an HLS plugin
55
module Development.IDE.Plugin.HLS.GhcIde
66
(
77
descriptors
88
) where
9-
import Development.IDE
10-
import Development.IDE.LSP.HoverDefinition
11-
import Development.IDE.LSP.Outline
12-
import Ide.Types
13-
import Language.LSP.Types
14-
import Language.LSP.Server (LspM)
15-
import Text.Regex.TDFA.Text()
16-
import qualified Development.IDE.Plugin.CodeAction as CodeAction
17-
import qualified Development.IDE.Plugin.Completions as Completions
18-
import qualified Development.IDE.Plugin.TypeLenses as TypeLenses
19-
import Control.Monad.IO.Class
9+
import Control.Monad.IO.Class
10+
import Development.IDE
11+
import Development.IDE.LSP.HoverDefinition
12+
import qualified Development.IDE.LSP.Notifications as Notifications
13+
import Development.IDE.LSP.Outline
14+
import qualified Development.IDE.Plugin.CodeAction as CodeAction
15+
import qualified Development.IDE.Plugin.Completions as Completions
16+
import qualified Development.IDE.Plugin.TypeLenses as TypeLenses
17+
import Ide.Types
18+
import Language.LSP.Server (LspM)
19+
import Language.LSP.Types
20+
import Text.Regex.TDFA.Text ()
2021

2122
descriptors :: [PluginDescriptor IdeState]
2223
descriptors =
2324
[ descriptor "ghcide-hover-and-symbols",
2425
CodeAction.descriptor "ghcide-code-actions",
2526
Completions.descriptor "ghcide-completions",
26-
TypeLenses.descriptor "ghcide-type-lenses"
27+
TypeLenses.descriptor "ghcide-type-lenses",
28+
Notifications.descriptor "ghcide-core"
2729
]
2830

2931
-- ---------------------------------------------------------------------

‎haskell-language-server.cabal‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -60,7 +60,7 @@ library
6060
, lsp
6161
, hie-bios
6262
, hiedb
63-
, hls-plugin-api ^>= 1.0.0.0
63+
, hls-plugin-api >= 1.0 && < 1.2
6464
, hslogger
6565
, optparse-applicative
6666
, optparse-simple
@@ -380,7 +380,7 @@ common hls-test-utils
380380
, data-default
381381
, lsp
382382
, hie-bios
383-
, hls-plugin-api ^>= 1.0.0.0
383+
, hls-plugin-api >= 1.0 && < 1.2
384384
, hslogger
385385
, hspec
386386
, hspec-core

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
cabal-version: 2.2
22
name: hls-plugin-api
3-
version: 1.0.0.0
3+
version: 1.1.0.0
44
synopsis: Haskell Language Server API for plugin communication
55
description:
66
Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>

0 commit comments

Comments
 (0)