From c21664543c3f836ed054311b2ae0c5b0594e9f9e Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Sat, 11 Nov 2023 13:16:22 +0300 Subject: [PATCH 1/9] Bounce completion requests&improve no plugin msgs --- .../src/Development/IDE/Plugin/Completions.hs | 22 +- ghcide/src/Development/IDE/Plugin/HLS.hs | 18 +- .../src/Development/IDE/Plugin/HLS/GhcIde.hs | 1 + hls-plugin-api/src/Ide/Types.hs | 290 ++++++++++-------- .../hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 2 +- 5 files changed, 190 insertions(+), 143 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index e15655a3cc..5c9c17c00a 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -4,7 +4,8 @@ {-# LANGUAGE TypeFamilies #-} module Development.IDE.Plugin.Completions - ( descriptor + ( bounceDescriptor + , descriptor , Log(..) , ghcideCompletionsPluginPriority ) where @@ -40,9 +41,11 @@ import Development.IDE.Types.HscEnvEq (HscEnvEq (envPackageE import qualified Development.IDE.Types.KnownTargets as KT import Development.IDE.Types.Location import Ide.Logger (Pretty (pretty), + Priority (Debug), Recorder, WithPriority, - cmapWithPrio) + cmapWithPrio, + logWith) import Ide.Plugin.Error import Ide.Types import qualified Language.LSP.Protocol.Lens as L @@ -63,12 +66,25 @@ import qualified Ide.Plugin.Config as Config import qualified GHC.LanguageExtensions as LangExt #endif -data Log = LogShake Shake.Log deriving Show +data Log = LogShake Shake.Log + | LogBouncedCompletionResolve deriving Show instance Pretty Log where pretty = \case + LogBouncedCompletionResolve -> "Bounced an extraneous completion resolve request" LogShake msg -> pretty msg +bounceDescriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState +bounceDescriptor recorder plId = (defaultPluginDescriptor plId) + { pluginHandlers = mkPluginHandler SMethod_CompletionItemResolve (bounceEmptyResolve recorder) + } + +-- | Generate code actions. +bounceEmptyResolve :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_CompletionItemResolve +bounceEmptyResolve recorder _ _ ci = do + _ <- logWith recorder Debug LogBouncedCompletionResolve + pure ci + ghcideCompletionsPluginPriority :: Natural ghcideCompletionsPluginPriority = defaultPluginPriority diff --git a/ghcide/src/Development/IDE/Plugin/HLS.hs b/ghcide/src/Development/IDE/Plugin/HLS.hs index 3e58a57ccb..4d7e05554f 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS.hs @@ -72,16 +72,16 @@ instance Pretty Log where <> pretty method <> ": " <> viaShow exception instance Show Log where show = renderString . layoutCompact . pretty -noPluginEnabled :: Recorder (WithPriority Log) -> SMethod m -> [PluginId] -> IO (Either ResponseError c) +noPluginEnabled :: Recorder (WithPriority Log) -> SMethod m -> [(PluginId, PluginStatus)] -> IO (Either ResponseError c) noPluginEnabled recorder m fs' = do logWith recorder Warning (LogNoPluginForMethod $ Some m) let err = ResponseError (InR ErrorCodes_MethodNotFound) msg Nothing msg = pluginNotEnabled m fs' return $ Left err - where pluginNotEnabled :: SMethod m -> [PluginId] -> Text + where pluginNotEnabled :: SMethod m -> [(PluginId, PluginStatus)] -> Text pluginNotEnabled method availPlugins = - "No plugin enabled for " <> T.pack (show method) <> ", potentially available: " - <> (T.intercalate ", " $ map (\(PluginId plid) -> plid) availPlugins) + "No plugin enabled for this " <> T.pack (show method) <> " request.\n Plugins installed for this method, but not enabled for this request are:\n" + <> (T.intercalate "\n" $ map (\(PluginId plid, pluginStatus) -> plid <> " " <> T.pack (show pluginStatus)) availPlugins) pluginDoesntExist :: PluginId -> Text pluginDoesntExist (PluginId pid) = "Plugin " <> pid <> " doesn't exist" @@ -214,7 +214,7 @@ executeCommandHandlers recorder ecs = requestHandler SMethod_WorkspaceExecuteCom (\e -> pure $ Left $ PluginInternalError (exceptionInPlugin p SMethod_WorkspaceExecuteCommand e)) case res of (Left (PluginRequestRefused _)) -> - liftIO $ noPluginEnabled recorder SMethod_WorkspaceExecuteCommand (fst <$> ecs) + liftIO $ noPluginEnabled recorder SMethod_WorkspaceExecuteCommand ((,PluginDisabled PluginRejected) . fst <$> ecs) (Left pluginErr) -> do liftIO $ logErrors recorder [(p, pluginErr)] pure $ Left $ toResponseError (p, pluginErr) @@ -237,10 +237,10 @@ extensiblePlugins recorder plugins = mempty { P.pluginHandlers = handlers } pure $ requestHandler m $ \ide params -> do config <- Ide.PluginUtils.getClientConfig -- Only run plugins that are allowed to run on this request - let fs = filter (\(_, desc, _) -> pluginEnabled m params desc config) fs' + let (fs, dfs) = List.partition (\(_, desc, _) -> pluginEnabled m params desc config == PluginEnabled) fs' -- Clients generally don't display ResponseErrors so instead we log any that we come across case nonEmpty fs of - Nothing -> liftIO $ noPluginEnabled recorder m ((\(x, _, _) -> x) <$> fs') + Nothing -> liftIO $ noPluginEnabled recorder m ((\(x, desc, _) -> (x, pluginEnabled m params desc config)) <$> dfs) Just neFs -> do let plidsAndHandlers = fmap (\(plid,_,handler) -> (plid,handler)) neFs es <- runConcurrently exceptionInPlugin m plidsAndHandlers ide params @@ -253,7 +253,7 @@ extensiblePlugins recorder plugins = mempty { P.pluginHandlers = handlers } noRefused (_, _) = True filteredErrs = filter noRefused errs case nonEmpty filteredErrs of - Nothing -> liftIO $ noPluginEnabled recorder m ((\(x, _, _) -> x) <$> fs') + Nothing -> liftIO $ noPluginEnabled recorder m ((\(x, desc, _) -> (x, pluginEnabled m params desc config)) <$> fs') Just xs -> pure $ Left $ combineErrors xs Just xs -> do pure $ Right $ combineResponses m config caps params xs @@ -275,7 +275,7 @@ extensibleNotificationPlugins recorder xs = mempty { P.pluginHandlers = handlers pure $ notificationHandler m $ \ide vfs params -> do config <- Ide.PluginUtils.getClientConfig -- Only run plugins that are allowed to run on this request - let fs = filter (\(_, desc, _) -> pluginEnabled m params desc config) fs' + let fs = filter (\(_, desc, _) -> pluginEnabled m params desc config == PluginEnabled) fs' case nonEmpty fs of Nothing -> do logWith recorder Warning (LogNoPluginForMethod $ Some m) diff --git a/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs b/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs index f85f0c8522..a7e6d06ee7 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs @@ -35,6 +35,7 @@ descriptors :: Recorder (WithPriority Log) -> [PluginDescriptor IdeState] descriptors recorder = [ descriptor "ghcide-hover-and-symbols", Completions.descriptor (cmapWithPrio LogCompletions recorder) "ghcide-completions", + Completions.bounceDescriptor (cmapWithPrio LogCompletions recorder) "ghcide-completions-bounce", TypeLenses.descriptor (cmapWithPrio LogTypeLenses recorder) "ghcide-type-lenses", Notifications.descriptor (cmapWithPrio LogNotifications recorder) "ghcide-core" ] diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index 9159fc4596..dd77696843 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -50,6 +50,8 @@ module Ide.Types , lookupCommandProvider , ResolveFunction , mkResolveHandler +, DisabledReason (..) +, PluginStatus (..) ) where @@ -285,11 +287,11 @@ data PluginDescriptor (ideState :: Type) = -- | Check whether the given plugin descriptor is responsible for the file with the given path. -- Compares the file extension of the file at the given path with the file extension -- the plugin is responsible for. -pluginResponsible :: Uri -> PluginDescriptor c -> Bool +pluginResponsible :: Uri -> PluginDescriptor c -> PluginStatus pluginResponsible uri pluginDesc | Just fp <- mfp - , T.pack (takeExtension fp) `elem` pluginFileType pluginDesc = True - | otherwise = False + , T.pack (takeExtension fp) `elem` pluginFileType pluginDesc = PluginEnabled + | otherwise = PluginDisabled $ DisabledByFileType (maybe "" takeExtension mfp) where mfp = uriToFilePath uri @@ -333,6 +335,24 @@ defaultConfigDescriptor :: ConfigDescriptor defaultConfigDescriptor = ConfigDescriptor Data.Default.def False (mkCustomConfig emptyProperties) +data DisabledReason = PluginRejected | NotResolveOwner String | DisabledByConfig | DisabledByFileType String + deriving (Eq) + +data PluginStatus = PluginEnabled | PluginDisabled DisabledReason + deriving (Eq) + +instance Show PluginStatus where + show PluginEnabled = "is enabled" + show (PluginDisabled PluginRejected) = "chose to reject this request" + show (PluginDisabled (NotResolveOwner s)) = "does not respond to resolve requests for " ++ s ++ ")" + show (PluginDisabled DisabledByConfig) = "is disabled from the config" + show (PluginDisabled (DisabledByFileType s)) = "does not respond to requests for " ++ s ++ " filetypes)" + +instance Semigroup PluginStatus where + PluginEnabled <> PluginEnabled = PluginEnabled + PluginDisabled r <> _ = PluginDisabled r + _ <> PluginDisabled r = PluginDisabled r + -- | Methods that can be handled by plugins. -- 'ExtraParams' captures any extra data the IDE passes to the handlers for this method -- Only methods for which we know how to combine responses can be instances of 'PluginMethod' @@ -372,168 +392,195 @@ class HasTracing (MessageParams m) => PluginMethod (k :: MessageKind) (m :: Meth -> Config -- ^ Generic config description, expected to contain 'PluginConfig' configuration -- for this plugin - -> Bool + -> PluginStatus -- ^ Is this plugin enabled and allowed to respond to the given request -- with the given parameters? default pluginEnabled :: (L.HasTextDocument (MessageParams m) doc, L.HasUri doc Uri) - => SMethod m -> MessageParams m -> PluginDescriptor c -> Config -> Bool - pluginEnabled _ params desc conf = pluginResponsible uri desc && plcGlobalOn (configForPlugin conf desc) + => SMethod m -> MessageParams m -> PluginDescriptor c -> Config -> PluginStatus + pluginEnabled _ params desc conf = + pluginGlobalEnabled (configForPlugin conf desc) <> pluginResponsible uri desc where uri = params ^. L.textDocument . L.uri --- --------------------------------------------------------------------- --- Plugin Requests --- --------------------------------------------------------------------- - -class PluginMethod Request m => PluginRequestMethod (m :: Method ClientToServer Request) where - -- | How to combine responses from different plugins. - -- - -- For example, for Hover requests, we might have multiple producers of - -- Hover information. We do not want to decide which one to display to the user - -- but instead allow to define how to merge two hover request responses into one - -- glorious hover box. - -- - -- However, as sometimes only one handler of a request can realistically exist - -- (such as TextDocumentFormatting), it is safe to just unconditionally report - -- back one arbitrary result (arbitrary since it should only be one anyway). - combineResponses - :: SMethod m - -> Config -- ^ IDE Configuration - -> ClientCapabilities - -> MessageParams m - -> NonEmpty (MessageResult m) -> MessageResult m +pluginEnabledOnlyFileType :: (L.HasTextDocument (MessageParams m) doc, L.HasUri doc Uri) + => SMethod m -> MessageParams m -> PluginDescriptor c -> Config -> PluginStatus +pluginEnabledOnlyFileType _ msgParams pluginDesc _ = pluginResponsible uri pluginDesc + where + uri = msgParams ^. L.textDocument . L.uri - default combineResponses :: Semigroup (MessageResult m) - => SMethod m -> Config -> ClientCapabilities -> MessageParams m -> NonEmpty (MessageResult m) -> MessageResult m - combineResponses _method _config _caps _params = sconcat +pluginEnabledOnlyGlobalOn :: SMethod m -> MessageParams m -> PluginDescriptor c -> Config -> PluginStatus +pluginEnabledOnlyGlobalOn _ _ desc conf = pluginGlobalEnabled (configForPlugin conf desc) -instance PluginMethod Request Method_TextDocumentCodeAction where - pluginEnabled _ msgParams pluginDesc config = - pluginResponsible uri pluginDesc && pluginEnabledConfig plcCodeActionsOn (configForPlugin config pluginDesc) +pluginEnabledWithFeature :: (L.HasTextDocument (MessageParams m) doc, L.HasUri doc Uri) + => (PluginConfig -> Bool) -> SMethod m -> MessageParams m + -> PluginDescriptor c -> Config -> PluginStatus +pluginEnabledWithFeature feature _ msgParams pluginDesc config = + pluginEnabledConfig feature (configForPlugin config pluginDesc) + <> pluginResponsible uri pluginDesc where uri = msgParams ^. L.textDocument . L.uri +pluginEnabledResolve :: L.HasData_ s (Maybe Value) => (PluginConfig -> Bool) -> p -> s -> PluginDescriptor c -> Config -> PluginStatus +pluginEnabledResolve feature _ msgParams pluginDesc config = + pluginEnabledConfig feature (configForPlugin config pluginDesc) + <> pluginResolverResponsible (msgParams ^. L.data_) pluginDesc + +instance PluginMethod Request Method_TextDocumentCodeAction where + pluginEnabled = pluginEnabledWithFeature plcCodeActionsOn + instance PluginMethod Request Method_CodeActionResolve where -- See Note [Resolve in PluginHandlers] - pluginEnabled _ msgParams pluginDesc config = - pluginResolverResponsible (msgParams ^. L.data_) pluginDesc - && pluginEnabledConfig plcCodeActionsOn (configForPlugin config pluginDesc) + pluginEnabled = pluginEnabledResolve plcCodeActionsOn instance PluginMethod Request Method_TextDocumentDefinition where - pluginEnabled _ msgParams pluginDesc _ = - pluginResponsible uri pluginDesc - where - uri = msgParams ^. L.textDocument . L.uri + pluginEnabled = pluginEnabledOnlyFileType instance PluginMethod Request Method_TextDocumentTypeDefinition where - pluginEnabled _ msgParams pluginDesc _ = - pluginResponsible uri pluginDesc - where - uri = msgParams ^. L.textDocument . L.uri + pluginEnabled = pluginEnabledOnlyFileType + instance PluginMethod Request Method_TextDocumentDocumentHighlight where - pluginEnabled _ msgParams pluginDesc _ = - pluginResponsible uri pluginDesc - where - uri = msgParams ^. L.textDocument . L.uri + pluginEnabled = pluginEnabledOnlyFileType + instance PluginMethod Request Method_TextDocumentReferences where - pluginEnabled _ msgParams pluginDesc _ = - pluginResponsible uri pluginDesc - where - uri = msgParams ^. L.textDocument . L.uri + pluginEnabled = pluginEnabledOnlyFileType instance PluginMethod Request Method_WorkspaceSymbol where -- Unconditionally enabled, but should it really be? - pluginEnabled _ _ _ _ = True + pluginEnabled _ _ _ _ = PluginEnabled instance PluginMethod Request Method_TextDocumentCodeLens where - pluginEnabled _ msgParams pluginDesc config = pluginResponsible uri pluginDesc - && pluginEnabledConfig plcCodeLensOn (configForPlugin config pluginDesc) - where - uri = msgParams ^. L.textDocument . L.uri + pluginEnabled = pluginEnabledWithFeature plcCodeLensOn instance PluginMethod Request Method_CodeLensResolve where -- See Note [Resolve in PluginHandlers] - pluginEnabled _ msgParams pluginDesc config = - pluginResolverResponsible (msgParams ^. L.data_) pluginDesc - && pluginEnabledConfig plcCodeActionsOn (configForPlugin config pluginDesc) + pluginEnabled = pluginEnabledResolve plcCodeLensOn instance PluginMethod Request Method_TextDocumentRename where - pluginEnabled _ msgParams pluginDesc config = pluginResponsible uri pluginDesc - && pluginEnabledConfig plcRenameOn (configForPlugin config pluginDesc) - where - uri = msgParams ^. L.textDocument . L.uri + pluginEnabled = pluginEnabledWithFeature plcRenameOn + instance PluginMethod Request Method_TextDocumentHover where - pluginEnabled _ msgParams pluginDesc config = pluginResponsible uri pluginDesc - && pluginEnabledConfig plcHoverOn (configForPlugin config pluginDesc) - where - uri = msgParams ^. L.textDocument . L.uri + + pluginEnabled = pluginEnabledWithFeature plcHoverOn instance PluginMethod Request Method_TextDocumentDocumentSymbol where - pluginEnabled _ msgParams pluginDesc config = pluginResponsible uri pluginDesc - && pluginEnabledConfig plcSymbolsOn (configForPlugin config pluginDesc) - where - uri = msgParams ^. L.textDocument . L.uri + + pluginEnabled = pluginEnabledWithFeature plcSymbolsOn instance PluginMethod Request Method_CompletionItemResolve where -- See Note [Resolve in PluginHandlers] - pluginEnabled _ msgParams pluginDesc config = pluginResolverResponsible (msgParams ^. L.data_) pluginDesc - && pluginEnabledConfig plcCompletionOn (configForPlugin config pluginDesc) + pluginEnabled _ (CompletionItem {_data_=Nothing}) (PluginDescriptor {pluginId=PluginId "ghcide-completions-bounce"}) _ = PluginEnabled + pluginEnabled method params desc conf = pluginEnabledResolve plcCompletionOn method params desc conf instance PluginMethod Request Method_TextDocumentCompletion where - pluginEnabled _ msgParams pluginDesc config = pluginResponsible uri pluginDesc - && pluginEnabledConfig plcCompletionOn (configForPlugin config pluginDesc) - where - uri = msgParams ^. L.textDocument . L.uri + + pluginEnabled = pluginEnabledWithFeature plcCompletionOn instance PluginMethod Request Method_TextDocumentFormatting where pluginEnabled SMethod_TextDocumentFormatting msgParams pluginDesc conf = - pluginResponsible uri pluginDesc - && (PluginId (formattingProvider conf) == pid || PluginId (cabalFormattingProvider conf) == pid) + if PluginId (formattingProvider conf) == pid + || PluginId (cabalFormattingProvider conf) == pid + then PluginEnabled + else PluginDisabled DisabledByConfig + <> pluginResponsible uri pluginDesc where uri = msgParams ^. L.textDocument . L.uri pid = pluginId pluginDesc instance PluginMethod Request Method_TextDocumentRangeFormatting where - pluginEnabled _ msgParams pluginDesc conf = pluginResponsible uri pluginDesc - && (PluginId (formattingProvider conf) == pid || PluginId (cabalFormattingProvider conf) == pid) + pluginEnabled _ msgParams pluginDesc conf = + if PluginId (formattingProvider conf) == pid + || PluginId (cabalFormattingProvider conf) == pid + then PluginEnabled + else PluginDisabled DisabledByConfig + <> pluginResponsible uri pluginDesc where uri = msgParams ^. L.textDocument . L.uri pid = pluginId pluginDesc instance PluginMethod Request Method_TextDocumentPrepareCallHierarchy where - pluginEnabled _ msgParams pluginDesc conf = pluginResponsible uri pluginDesc - && pluginEnabledConfig plcCallHierarchyOn (configForPlugin conf pluginDesc) - where - uri = msgParams ^. L.textDocument . L.uri + + pluginEnabled = pluginEnabledWithFeature plcCallHierarchyOn instance PluginMethod Request Method_TextDocumentSelectionRange where - pluginEnabled _ msgParams pluginDesc conf = pluginResponsible uri pluginDesc - && pluginEnabledConfig plcSelectionRangeOn (configForPlugin conf pluginDesc) - where - uri = msgParams ^. L.textDocument . L.uri + + pluginEnabled = pluginEnabledWithFeature plcSelectionRangeOn instance PluginMethod Request Method_TextDocumentFoldingRange where - pluginEnabled _ msgParams pluginDesc conf = pluginResponsible uri pluginDesc - && pluginEnabledConfig plcFoldingRangeOn (configForPlugin conf pluginDesc) - where - uri = msgParams ^. L.textDocument . L.uri + + pluginEnabled = pluginEnabledWithFeature plcFoldingRangeOn instance PluginMethod Request Method_CallHierarchyIncomingCalls where -- This method has no URI parameter, thus no call to 'pluginResponsible' - pluginEnabled _ _ pluginDesc conf = pluginEnabledConfig plcCallHierarchyOn (configForPlugin conf pluginDesc) + pluginEnabled _ _ pluginDesc conf = + pluginEnabledConfig plcCallHierarchyOn (configForPlugin conf pluginDesc) instance PluginMethod Request Method_CallHierarchyOutgoingCalls where -- This method has no URI parameter, thus no call to 'pluginResponsible' - pluginEnabled _ _ pluginDesc conf = pluginEnabledConfig plcCallHierarchyOn (configForPlugin conf pluginDesc) - + pluginEnabled _ _ pluginDesc conf = + pluginEnabledConfig plcCallHierarchyOn (configForPlugin conf pluginDesc) instance PluginMethod Request Method_WorkspaceExecuteCommand where - pluginEnabled _ _ _ _= True + pluginEnabled _ _ _ _= PluginEnabled instance PluginMethod Request (Method_CustomMethod m) where - pluginEnabled _ _ _ _ = True + pluginEnabled _ _ _ _ = PluginEnabled + +-- Plugin Notifications + +instance PluginMethod Notification Method_TextDocumentDidOpen where + +instance PluginMethod Notification Method_TextDocumentDidChange where + +instance PluginMethod Notification Method_TextDocumentDidSave where + +instance PluginMethod Notification Method_TextDocumentDidClose where + +instance PluginMethod Notification Method_WorkspaceDidChangeWatchedFiles where + -- This method has no URI parameter, thus no call to 'pluginResponsible'. + pluginEnabled = pluginEnabledOnlyGlobalOn + +instance PluginMethod Notification Method_WorkspaceDidChangeWorkspaceFolders where + -- This method has no URI parameter, thus no call to 'pluginResponsible'. + pluginEnabled = pluginEnabledOnlyGlobalOn + +instance PluginMethod Notification Method_WorkspaceDidChangeConfiguration where + -- This method has no URI parameter, thus no call to 'pluginResponsible'. + pluginEnabled = pluginEnabledOnlyGlobalOn + +instance PluginMethod Notification Method_Initialized where + -- This method has no URI parameter, thus no call to 'pluginResponsible'. + pluginEnabled = pluginEnabledOnlyGlobalOn + + +-- --------------------------------------------------------------------- +-- Plugin Requests +-- --------------------------------------------------------------------- + +class PluginMethod Request m => PluginRequestMethod (m :: Method ClientToServer Request) where + -- | How to combine responses from different plugins. + -- + -- For example, for Hover requests, we might have multiple producers of + -- Hover information. We do not want to decide which one to display to the user + -- but instead allow to define how to merge two hover request responses into one + -- glorious hover box. + -- + -- However, as sometimes only one handler of a request can realistically exist + -- (such as TextDocumentFormatting), it is safe to just unconditionally report + -- back one arbitrary result (arbitrary since it should only be one anyway). + combineResponses + :: SMethod m + -> Config -- ^ IDE Configuration + -> ClientCapabilities + -> MessageParams m + -> NonEmpty (MessageResult m) -> MessageResult m + + default combineResponses :: Semigroup (MessageResult m) + => SMethod m -> Config -> ClientCapabilities -> MessageParams m -> NonEmpty (MessageResult m) -> MessageResult m + combineResponses _method _config _caps _params = sconcat + + --- instance PluginRequestMethod Method_TextDocumentCodeAction where @@ -702,31 +749,6 @@ nullToMaybe' (InR (InR _)) = Nothing class PluginMethod Notification m => PluginNotificationMethod (m :: Method ClientToServer Notification) where -instance PluginMethod Notification Method_TextDocumentDidOpen where - -instance PluginMethod Notification Method_TextDocumentDidChange where - -instance PluginMethod Notification Method_TextDocumentDidSave where - -instance PluginMethod Notification Method_TextDocumentDidClose where - -instance PluginMethod Notification Method_WorkspaceDidChangeWatchedFiles where - -- This method has no URI parameter, thus no call to 'pluginResponsible'. - pluginEnabled _ _ desc conf = plcGlobalOn $ configForPlugin conf desc - -instance PluginMethod Notification Method_WorkspaceDidChangeWorkspaceFolders where - -- This method has no URI parameter, thus no call to 'pluginResponsible'. - pluginEnabled _ _ desc conf = plcGlobalOn $ configForPlugin conf desc - -instance PluginMethod Notification Method_WorkspaceDidChangeConfiguration where - -- This method has no URI parameter, thus no call to 'pluginResponsible'. - pluginEnabled _ _ desc conf = plcGlobalOn $ configForPlugin conf desc - -instance PluginMethod Notification Method_Initialized where - -- This method has no URI parameter, thus no call to 'pluginResponsible'. - pluginEnabled _ _ desc conf = plcGlobalOn $ configForPlugin conf desc - - instance PluginNotificationMethod Method_TextDocumentDidOpen where instance PluginNotificationMethod Method_TextDocumentDidChange where @@ -972,10 +994,16 @@ configForPlugin :: Config -> PluginDescriptor c -> PluginConfig configForPlugin config PluginDescriptor{..} = Map.findWithDefault (configInitialGenericConfig pluginConfigDescriptor) pluginId (plugins config) +pluginGlobalEnabled :: PluginConfig -> PluginStatus +pluginGlobalEnabled pc = if plcGlobalOn pc + then PluginEnabled + else PluginDisabled DisabledByConfig -- | Checks that a given plugin is both enabled and the specific feature is -- enabled -pluginEnabledConfig :: (PluginConfig -> Bool) -> PluginConfig -> Bool -pluginEnabledConfig f pluginConfig = plcGlobalOn pluginConfig && f pluginConfig +pluginEnabledConfig :: (PluginConfig -> Bool) -> PluginConfig -> PluginStatus +pluginEnabledConfig f pluginConfig = if plcGlobalOn pluginConfig && f pluginConfig + then PluginEnabled + else PluginDisabled DisabledByConfig -- --------------------------------------------------------------------- @@ -1102,11 +1130,13 @@ installSigUsr1Handler h = void $ installHandler sigUSR1 (Catch h) Nothing -- |Determine whether this request should be routed to the plugin. Fails closed -- if we can't determine which plugin it should be routed to. -pluginResolverResponsible :: Maybe Value -> PluginDescriptor c -> Bool -pluginResolverResponsible (Just (fromJSON -> (Success (PluginResolveData o _ _)))) pluginDesc = - pluginId pluginDesc == o +pluginResolverResponsible :: Maybe Value -> PluginDescriptor c -> PluginStatus +pluginResolverResponsible (Just (fromJSON -> (Success (PluginResolveData o@(PluginId ot) _ _)))) pluginDesc = + if pluginId pluginDesc == o + then PluginEnabled + else PluginDisabled $ NotResolveOwner (T.unpack ot) -- We want to fail closed -pluginResolverResponsible _ _ = False +pluginResolverResponsible _ _ = PluginDisabled $ NotResolveOwner "" {- Note [Resolve in PluginHandlers] Resolve methods have a few guarantees that need to be made by HLS, diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 2c02c6c6e0..2f6181c212 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -226,7 +226,7 @@ rules recorder plugin = do define (cmapWithPrio LogShake recorder) $ \GetHlintDiagnostics file -> do config <- getPluginConfigAction plugin let hlintOn = pluginEnabledConfig plcDiagnosticsOn config - ideas <- if hlintOn then getIdeas recorder file else return (Right []) + ideas <- if hlintOn == PluginEnabled then getIdeas recorder file else return (Right []) return (diagnostics file ideas, Just ()) defineNoFile (cmapWithPrio LogShake recorder) $ \GetHlintSettings -> do From c7989519982341c38a20871b5882133390a43d52 Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Tue, 14 Nov 2023 11:52:07 +0300 Subject: [PATCH 2/9] Fix edge cases, move to Pretty, add comments --- .../src/Development/IDE/Plugin/Completions.hs | 2 +- ghcide/src/Development/IDE/Plugin/HLS.hs | 25 +++++++++------ hls-plugin-api/src/Ide/Types.hs | 31 +++++++++++++------ 3 files changed, 39 insertions(+), 19 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 5c9c17c00a..2122d982d7 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -74,12 +74,12 @@ instance Pretty Log where LogBouncedCompletionResolve -> "Bounced an extraneous completion resolve request" LogShake msg -> pretty msg +-- | Bounce empty completion resolve request. This is to fix https://github.com/haskell/haskell-language-server/issues/3842 bounceDescriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState bounceDescriptor recorder plId = (defaultPluginDescriptor plId) { pluginHandlers = mkPluginHandler SMethod_CompletionItemResolve (bounceEmptyResolve recorder) } --- | Generate code actions. bounceEmptyResolve :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_CompletionItemResolve bounceEmptyResolve recorder _ _ ci = do _ <- logWith recorder Debug LogBouncedCompletionResolve diff --git a/ghcide/src/Development/IDE/Plugin/HLS.hs b/ghcide/src/Development/IDE/Plugin/HLS.hs index 4d7e05554f..582d3c987f 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS.hs @@ -23,6 +23,7 @@ import qualified Data.List as List import Data.List.NonEmpty (NonEmpty, nonEmpty, toList) import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map +import Data.Maybe (mapMaybe) import Data.Some import Data.String import Data.Text (Text) @@ -79,9 +80,10 @@ noPluginEnabled recorder m fs' = do msg = pluginNotEnabled m fs' return $ Left err where pluginNotEnabled :: SMethod m -> [(PluginId, PluginStatus)] -> Text + pluginNotEnabled method [] = "No plugin installed for this " <> T.pack (show method) <> " request." pluginNotEnabled method availPlugins = "No plugin enabled for this " <> T.pack (show method) <> " request.\n Plugins installed for this method, but not enabled for this request are:\n" - <> (T.intercalate "\n" $ map (\(PluginId plid, pluginStatus) -> plid <> " " <> T.pack (show pluginStatus)) availPlugins) + <> (T.intercalate "\n" $ map (\(PluginId plid, pluginStatus) -> plid <> " " <> (renderStrict . layoutCompact . pretty) pluginStatus) availPlugins) pluginDoesntExist :: PluginId -> Text pluginDoesntExist (PluginId pid) = "Plugin " <> pid <> " doesn't exist" @@ -213,8 +215,8 @@ executeCommandHandlers recorder ecs = requestHandler SMethod_WorkspaceExecuteCom res <- runExceptT (f ide a) `catchAny` -- See Note [Exception handling in plugins] (\e -> pure $ Left $ PluginInternalError (exceptionInPlugin p SMethod_WorkspaceExecuteCommand e)) case res of - (Left (PluginRequestRefused _)) -> - liftIO $ noPluginEnabled recorder SMethod_WorkspaceExecuteCommand ((,PluginDisabled PluginRejected) . fst <$> ecs) + (Left (PluginRequestRefused r)) -> + liftIO $ noPluginEnabled recorder SMethod_WorkspaceExecuteCommand [(p,PluginDisabled (PluginRejected r))] (Left pluginErr) -> do liftIO $ logErrors recorder [(p, pluginErr)] pure $ Left $ toResponseError (p, pluginErr) @@ -236,11 +238,13 @@ extensiblePlugins recorder plugins = mempty { P.pluginHandlers = handlers } (IdeMethod m :=> IdeHandler fs') <- DMap.assocs handlers' pure $ requestHandler m $ \ide params -> do config <- Ide.PluginUtils.getClientConfig - -- Only run plugins that are allowed to run on this request + -- 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, _) -> pluginEnabled m params desc config == PluginEnabled) fs' + let disabledPluginsReason = (\(x, desc, _) -> (x, pluginEnabled m params desc config)) <$> dfs -- Clients generally don't display ResponseErrors so instead we log any that we come across case nonEmpty fs of - Nothing -> liftIO $ noPluginEnabled recorder m ((\(x, desc, _) -> (x, pluginEnabled m params desc config)) <$> dfs) + Nothing -> liftIO $ noPluginEnabled recorder m disabledPluginsReason Just neFs -> do let plidsAndHandlers = fmap (\(plid,_,handler) -> (plid,handler)) neFs es <- runConcurrently exceptionInPlugin m plidsAndHandlers ide params @@ -251,9 +255,12 @@ extensiblePlugins recorder plugins = mempty { P.pluginHandlers = handlers } Nothing -> do let noRefused (_, PluginRequestRefused _) = False noRefused (_, _) = True - filteredErrs = filter noRefused errs - case nonEmpty filteredErrs of - Nothing -> liftIO $ noPluginEnabled recorder m ((\(x, desc, _) -> (x, pluginEnabled m params desc config)) <$> fs') + (asErrors, asRefused) = List.partition noRefused errs + convertPRR (pId, PluginRequestRefused r) = Just (pId, PluginDisabled (PluginRejected r)) + convertPRR _ = Nothing + asRefusedReason = mapMaybe convertPRR asRefused + case nonEmpty asErrors of + Nothing -> liftIO $ noPluginEnabled recorder m (disabledPluginsReason <> asRefusedReason) Just xs -> pure $ Left $ combineErrors xs Just xs -> do pure $ Right $ combineResponses m config caps params xs @@ -274,7 +281,7 @@ extensibleNotificationPlugins recorder xs = mempty { P.pluginHandlers = handlers (IdeNotification m :=> IdeNotificationHandler fs') <- DMap.assocs handlers' pure $ notificationHandler m $ \ide vfs params -> do config <- Ide.PluginUtils.getClientConfig - -- Only run plugins that are allowed to run on this request + -- Only run plugins that are enabled for this request let fs = filter (\(_, desc, _) -> pluginEnabled m params desc config == PluginEnabled) fs' case nonEmpty fs of Nothing -> do diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index dd77696843..832de2bc3a 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -105,6 +105,7 @@ import Language.LSP.VFS import Numeric.Natural import OpenTelemetry.Eventlog import Options.Applicative (ParserInfo) +import Prettyprinter import System.FilePath import System.IO.Unsafe import Text.Regex.TDFA.Text () @@ -291,7 +292,7 @@ pluginResponsible :: Uri -> PluginDescriptor c -> PluginStatus pluginResponsible uri pluginDesc | Just fp <- mfp , T.pack (takeExtension fp) `elem` pluginFileType pluginDesc = PluginEnabled - | otherwise = PluginDisabled $ DisabledByFileType (maybe "" takeExtension mfp) + | otherwise = PluginDisabled $ DisabledByFileType (maybe "" (T.pack . takeExtension) mfp) where mfp = uriToFilePath uri @@ -335,19 +336,22 @@ defaultConfigDescriptor :: ConfigDescriptor defaultConfigDescriptor = ConfigDescriptor Data.Default.def False (mkCustomConfig emptyProperties) -data DisabledReason = PluginRejected | NotResolveOwner String | DisabledByConfig | DisabledByFileType String +-- | Reasons why a plugin could be disabled for a request +data DisabledReason = PluginRejected T.Text | NotResolveOwner T.Text | DisabledByConfig | DisabledByFileType T.Text deriving (Eq) +-- | Whether a plugin is enabled or not data PluginStatus = PluginEnabled | PluginDisabled DisabledReason deriving (Eq) -instance Show PluginStatus where - show PluginEnabled = "is enabled" - show (PluginDisabled PluginRejected) = "chose to reject this request" - show (PluginDisabled (NotResolveOwner s)) = "does not respond to resolve requests for " ++ s ++ ")" - show (PluginDisabled DisabledByConfig) = "is disabled from the config" - show (PluginDisabled (DisabledByFileType s)) = "does not respond to requests for " ++ s ++ " filetypes)" +instance Pretty PluginStatus where + pretty PluginEnabled = "is enabled" + pretty (PluginDisabled (PluginRejected t)) = "rejected the request with: " <> pretty t + pretty (PluginDisabled (NotResolveOwner s)) = "does not respond to resolve requests for " <> pretty s <> ")" + pretty (PluginDisabled DisabledByConfig) = "is disabled from the config" + pretty (PluginDisabled (DisabledByFileType s)) = "does not respond to requests for " <> pretty s <> " filetypes)" +-- We always want to keep the leftmost disabled reason instance Semigroup PluginStatus where PluginEnabled <> PluginEnabled = PluginEnabled PluginDisabled r <> _ = PluginDisabled r @@ -403,15 +407,19 @@ class HasTracing (MessageParams m) => PluginMethod (k :: MessageKind) (m :: Meth where uri = params ^. L.textDocument . L.uri +-- | Only check if the file type is supported pluginEnabledOnlyFileType :: (L.HasTextDocument (MessageParams m) doc, L.HasUri doc Uri) => SMethod m -> MessageParams m -> PluginDescriptor c -> Config -> PluginStatus pluginEnabledOnlyFileType _ msgParams pluginDesc _ = pluginResponsible uri pluginDesc where uri = msgParams ^. L.textDocument . L.uri +-- | Only check if the plugin is enabled globally pluginEnabledOnlyGlobalOn :: SMethod m -> MessageParams m -> PluginDescriptor c -> Config -> PluginStatus pluginEnabledOnlyGlobalOn _ _ desc conf = pluginGlobalEnabled (configForPlugin conf 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 -> PluginDescriptor c -> Config -> PluginStatus @@ -421,6 +429,8 @@ pluginEnabledWithFeature feature _ msgParams pluginDesc config = where uri = msgParams ^. L.textDocument . L.uri +-- | 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 -> PluginStatus pluginEnabledResolve feature _ msgParams pluginDesc config = pluginEnabledConfig feature (configForPlugin config pluginDesc) @@ -740,6 +750,7 @@ nullToMaybe' :: (a |? (b |? Null)) -> Maybe (a |? b) nullToMaybe' (InL x) = Just $ InL x nullToMaybe' (InR (InL x)) = Just $ InR x nullToMaybe' (InR (InR _)) = Nothing + -- --------------------------------------------------------------------- -- Plugin Notifications -- --------------------------------------------------------------------- @@ -994,10 +1005,12 @@ configForPlugin :: Config -> PluginDescriptor c -> PluginConfig configForPlugin config PluginDescriptor{..} = Map.findWithDefault (configInitialGenericConfig pluginConfigDescriptor) pluginId (plugins config) +-- | Checks that a specific plugin is enabled pluginGlobalEnabled :: PluginConfig -> PluginStatus pluginGlobalEnabled pc = if plcGlobalOn pc then PluginEnabled else PluginDisabled DisabledByConfig + -- | Checks that a given plugin is both enabled and the specific feature is -- enabled pluginEnabledConfig :: (PluginConfig -> Bool) -> PluginConfig -> PluginStatus @@ -1134,7 +1147,7 @@ pluginResolverResponsible :: Maybe Value -> PluginDescriptor c -> PluginStatus pluginResolverResponsible (Just (fromJSON -> (Success (PluginResolveData o@(PluginId ot) _ _)))) pluginDesc = if pluginId pluginDesc == o then PluginEnabled - else PluginDisabled $ NotResolveOwner (T.unpack ot) + else PluginDisabled $ NotResolveOwner ot -- We want to fail closed pluginResolverResponsible _ _ = PluginDisabled $ NotResolveOwner "" From 1d3b3bb0c34f92d27db0c084d3da4dafb35160d5 Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Thu, 28 Dec 2023 17:26:47 +0300 Subject: [PATCH 3/9] Remove resolve bounce from PR --- .../src/Development/IDE/Plugin/Completions.hs | 22 +++---------------- .../src/Development/IDE/Plugin/HLS/GhcIde.hs | 1 - 2 files changed, 3 insertions(+), 20 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 2122d982d7..e15655a3cc 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -4,8 +4,7 @@ {-# LANGUAGE TypeFamilies #-} module Development.IDE.Plugin.Completions - ( bounceDescriptor - , descriptor + ( descriptor , Log(..) , ghcideCompletionsPluginPriority ) where @@ -41,11 +40,9 @@ import Development.IDE.Types.HscEnvEq (HscEnvEq (envPackageE import qualified Development.IDE.Types.KnownTargets as KT import Development.IDE.Types.Location import Ide.Logger (Pretty (pretty), - Priority (Debug), Recorder, WithPriority, - cmapWithPrio, - logWith) + cmapWithPrio) import Ide.Plugin.Error import Ide.Types import qualified Language.LSP.Protocol.Lens as L @@ -66,25 +63,12 @@ import qualified Ide.Plugin.Config as Config import qualified GHC.LanguageExtensions as LangExt #endif -data Log = LogShake Shake.Log - | LogBouncedCompletionResolve deriving Show +data Log = LogShake Shake.Log deriving Show instance Pretty Log where pretty = \case - LogBouncedCompletionResolve -> "Bounced an extraneous completion resolve request" LogShake msg -> pretty msg --- | Bounce empty completion resolve request. This is to fix https://github.com/haskell/haskell-language-server/issues/3842 -bounceDescriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState -bounceDescriptor recorder plId = (defaultPluginDescriptor plId) - { pluginHandlers = mkPluginHandler SMethod_CompletionItemResolve (bounceEmptyResolve recorder) - } - -bounceEmptyResolve :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_CompletionItemResolve -bounceEmptyResolve recorder _ _ ci = do - _ <- logWith recorder Debug LogBouncedCompletionResolve - pure ci - ghcideCompletionsPluginPriority :: Natural ghcideCompletionsPluginPriority = defaultPluginPriority diff --git a/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs b/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs index a7e6d06ee7..f85f0c8522 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs @@ -35,7 +35,6 @@ descriptors :: Recorder (WithPriority Log) -> [PluginDescriptor IdeState] descriptors recorder = [ descriptor "ghcide-hover-and-symbols", Completions.descriptor (cmapWithPrio LogCompletions recorder) "ghcide-completions", - Completions.bounceDescriptor (cmapWithPrio LogCompletions recorder) "ghcide-completions-bounce", TypeLenses.descriptor (cmapWithPrio LogTypeLenses recorder) "ghcide-type-lenses", Notifications.descriptor (cmapWithPrio LogNotifications recorder) "ghcide-core" ] From e01d364f78f919c579f65144de1257249a1da4d4 Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Thu, 28 Dec 2023 18:04:20 +0300 Subject: [PATCH 4/9] fix stan --- plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs b/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs index 63e4de376d..417709024e 100644 --- a/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs +++ b/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs @@ -31,7 +31,8 @@ import Development.IDE.GHC.Error (realSrcSpanToRange) import GHC.Generics (Generic) import Ide.Plugin.Config import Ide.Types (PluginDescriptor (..), - PluginId, configHasDiagnostics, + PluginEnabled, PluginId, + configHasDiagnostics, configInitialGenericConfig, defaultConfigDescriptor, defaultPluginDescriptor, @@ -80,7 +81,7 @@ rules recorder plId = do define (cmapWithPrio LogShake recorder) $ \GetStanDiagnostics file -> do config <- getPluginConfigAction plId - if pluginEnabledConfig plcDiagnosticsOn config then do + if pluginEnabledConfig plcDiagnosticsOn config == PluginEnabled then do maybeHie <- getHieFile file case maybeHie of Nothing -> return ([], Nothing) From 33855b0234dad86039d0a137ac54bbb1d1fffee6 Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Thu, 28 Dec 2023 21:00:18 +0300 Subject: [PATCH 5/9] fix stan try 2 --- plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs b/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs index 417709024e..a2bc6f06ed 100644 --- a/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs +++ b/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs @@ -31,7 +31,7 @@ import Development.IDE.GHC.Error (realSrcSpanToRange) import GHC.Generics (Generic) import Ide.Plugin.Config import Ide.Types (PluginDescriptor (..), - PluginEnabled, PluginId, + PluginId, PluginStatus (..), configHasDiagnostics, configInitialGenericConfig, defaultConfigDescriptor, From 563a3b3f5c32098d161c45a77e164cd93afff6db Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Sun, 31 Dec 2023 13:19:34 +0300 Subject: [PATCH 6/9] some refactoring in addition to addressing michealpj's comments --- ghcide/src/Development/IDE/Plugin/HLS.hs | 38 +-- hls-plugin-api/hls-plugin-api.cabal | 1 + hls-plugin-api/src/Ide/Plugin/Error.hs | 17 +- .../src/Ide/Plugin/HandleRequestTypes.hs | 42 +++ hls-plugin-api/src/Ide/PluginUtils.hs | 2 +- hls-plugin-api/src/Ide/Types.hs | 255 ++++++++---------- .../hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 4 +- .../hls-stan-plugin/src/Ide/Plugin/Stan.hs | 8 +- test/functional/Format.hs | 2 +- 9 files changed, 192 insertions(+), 177 deletions(-) create mode 100644 hls-plugin-api/src/Ide/Plugin/HandleRequestTypes.hs diff --git a/ghcide/src/Development/IDE/Plugin/HLS.hs b/ghcide/src/Development/IDE/Plugin/HLS.hs index 582d3c987f..022d3ae107 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS.hs @@ -37,6 +37,7 @@ import qualified Development.IDE.Plugin as P import Ide.Logger import Ide.Plugin.Config import Ide.Plugin.Error +import Ide.Plugin.HandleRequestTypes import Ide.PluginUtils (getClientConfig) import Ide.Types as HLS import Language.LSP.Protocol.Message @@ -66,24 +67,29 @@ instance Pretty Log where LogResponseError (PluginId pId) err -> pretty pId <> ":" <+> pretty err LogNoPluginForMethod (Some method) -> - "No plugin enabled for " <> pretty method + "No plugin handles this " <> pretty method <> " request." LogInvalidCommandIdentifier-> "Invalid command identifier" ExceptionInPlugin plId (Some method) exception -> "Exception in plugin " <> viaShow plId <> " while processing " <> pretty method <> ": " <> viaShow exception instance Show Log where show = renderString . layoutCompact . pretty -noPluginEnabled :: Recorder (WithPriority Log) -> SMethod m -> [(PluginId, PluginStatus)] -> IO (Either ResponseError c) -noPluginEnabled recorder m fs' = do +noPluginHandles :: Recorder (WithPriority Log) -> SMethod m -> [(PluginId, HandleRequestResult)] -> IO (Either ResponseError c) +noPluginHandles recorder m fs' = do logWith recorder Warning (LogNoPluginForMethod $ Some m) let err = ResponseError (InR ErrorCodes_MethodNotFound) msg Nothing - msg = pluginNotEnabled m fs' + msg = noPluginHandlesMsg m fs' return $ Left err - where pluginNotEnabled :: SMethod m -> [(PluginId, PluginStatus)] -> Text - pluginNotEnabled method [] = "No plugin installed for this " <> T.pack (show method) <> " request." - pluginNotEnabled method availPlugins = - "No plugin enabled for this " <> T.pack (show method) <> " request.\n Plugins installed for this method, but not enabled for this request are:\n" - <> (T.intercalate "\n" $ map (\(PluginId plid, pluginStatus) -> plid <> " " <> (renderStrict . layoutCompact . pretty) pluginStatus) availPlugins) + where noPluginHandlesMsg :: SMethod m -> [(PluginId, HandleRequestResult)] -> Text + noPluginHandlesMsg method [] = "No plugin installed for this " <> T.pack (show method) <> " request." + noPluginHandlesMsg method availPlugins = + "No plugins are available to handle this " <> T.pack (show method) <> " request.\n Plugins installed for this method, but not available to handle this request are:\n" + <> (T.intercalate "\n" $ + map (\(PluginId plid, pluginStatus) -> + plid + <> " " + <> (renderStrict . layoutCompact . pretty) pluginStatus) + availPlugins) pluginDoesntExist :: PluginId -> Text pluginDoesntExist (PluginId pid) = "Plugin " <> pid <> " doesn't exist" @@ -216,7 +222,7 @@ executeCommandHandlers recorder ecs = requestHandler SMethod_WorkspaceExecuteCom (\e -> pure $ Left $ PluginInternalError (exceptionInPlugin p SMethod_WorkspaceExecuteCommand e)) case res of (Left (PluginRequestRefused r)) -> - liftIO $ noPluginEnabled recorder SMethod_WorkspaceExecuteCommand [(p,PluginDisabled (PluginRejected r))] + liftIO $ noPluginHandles recorder SMethod_WorkspaceExecuteCommand [(p,DoesNotHandleRequest r)] (Left pluginErr) -> do liftIO $ logErrors recorder [(p, pluginErr)] pure $ Left $ toResponseError (p, pluginErr) @@ -240,11 +246,11 @@ extensiblePlugins recorder plugins = mempty { P.pluginHandlers = handlers } 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, _) -> pluginEnabled m params desc config == PluginEnabled) fs' - let disabledPluginsReason = (\(x, desc, _) -> (x, pluginEnabled m params desc config)) <$> dfs + let (fs, dfs) = List.partition (\(_, desc, _) -> handlesRequest m params desc config == HandlesRequest) fs' + let disabledPluginsReason = (\(x, desc, _) -> (x, handlesRequest m params desc config)) <$> dfs -- Clients generally don't display ResponseErrors so instead we log any that we come across case nonEmpty fs of - Nothing -> liftIO $ noPluginEnabled recorder m disabledPluginsReason + Nothing -> liftIO $ noPluginHandles recorder m disabledPluginsReason Just neFs -> do let plidsAndHandlers = fmap (\(plid,_,handler) -> (plid,handler)) neFs es <- runConcurrently exceptionInPlugin m plidsAndHandlers ide params @@ -256,11 +262,11 @@ extensiblePlugins recorder plugins = mempty { P.pluginHandlers = handlers } let noRefused (_, PluginRequestRefused _) = False noRefused (_, _) = True (asErrors, asRefused) = List.partition noRefused errs - convertPRR (pId, PluginRequestRefused r) = Just (pId, PluginDisabled (PluginRejected r)) + convertPRR (pId, PluginRequestRefused r) = Just (pId, DoesNotHandleRequest r) convertPRR _ = Nothing asRefusedReason = mapMaybe convertPRR asRefused case nonEmpty asErrors of - Nothing -> liftIO $ noPluginEnabled recorder m (disabledPluginsReason <> asRefusedReason) + Nothing -> liftIO $ noPluginHandles recorder m (disabledPluginsReason <> asRefusedReason) Just xs -> pure $ Left $ combineErrors xs Just xs -> do pure $ Right $ combineResponses m config caps params xs @@ -282,7 +288,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, _) -> pluginEnabled m params desc config == PluginEnabled) fs' + let fs = filter (\(_, desc, _) -> handlesRequest m params desc config == HandlesRequest) fs' case nonEmpty fs of Nothing -> do logWith recorder Warning (LogNoPluginForMethod $ Some m) diff --git a/hls-plugin-api/hls-plugin-api.cabal b/hls-plugin-api/hls-plugin-api.cabal index 790612d9d9..2ec296cecf 100644 --- a/hls-plugin-api/hls-plugin-api.cabal +++ b/hls-plugin-api/hls-plugin-api.cabal @@ -38,6 +38,7 @@ library Ide.Plugin.Config Ide.Plugin.ConfigUtils Ide.Plugin.Error + Ide.Plugin.HandleRequestTypes Ide.Plugin.Properties Ide.Plugin.RangeMap Ide.Plugin.Resolve diff --git a/hls-plugin-api/src/Ide/Plugin/Error.hs b/hls-plugin-api/src/Ide/Plugin/Error.hs index ce874b744a..13532bd602 100644 --- a/hls-plugin-api/src/Ide/Plugin/Error.hs +++ b/hls-plugin-api/src/Ide/Plugin/Error.hs @@ -11,11 +11,12 @@ module Ide.Plugin.Error ( getNormalizedFilePathE, ) where -import Control.Monad.Extra (maybeM) -import Control.Monad.Trans.Class (lift) -import Control.Monad.Trans.Except (ExceptT (..), throwE) -import qualified Data.Text as T +import Control.Monad.Extra (maybeM) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Except (ExceptT (..), throwE) +import qualified Data.Text as T import Ide.Logger +import Ide.Plugin.HandleRequestTypes (RejectionReason) import Language.LSP.Protocol.Types -- ---------------------------------------------------------------------------- @@ -79,13 +80,13 @@ data PluginError | PluginInvalidUserState T.Text -- |PluginRequestRefused allows your handler to inspect a request before -- rejecting it. In effect it allows your plugin to act make a secondary - -- `pluginEnabled` decision after receiving the request. This should only be + -- `handlesRequest` decision after receiving the request. This should only be -- used if the decision to accept the request can not be made in - -- `pluginEnabled`. + -- `handlesRequest`. -- -- This error will be with Debug. If it's the only response to a request, - -- HLS will respond as if no plugins passed the `pluginEnabled` stage. - | PluginRequestRefused T.Text + -- HLS will respond as if no plugins passed the `handlesRequest` stage. + | PluginRequestRefused RejectionReason -- |PluginRuleFailed should be thrown when a Rule your response depends on -- fails. -- diff --git a/hls-plugin-api/src/Ide/Plugin/HandleRequestTypes.hs b/hls-plugin-api/src/Ide/Plugin/HandleRequestTypes.hs new file mode 100644 index 0000000000..9eb30ad52d --- /dev/null +++ b/hls-plugin-api/src/Ide/Plugin/HandleRequestTypes.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Ide.Plugin.HandleRequestTypes where + +import Data.Text +import Prettyprinter + +-- | Reasons why a plugin could reject a specific request. +data RejectionReason = + -- | The resolve request is not meant for this plugin or handler. The text + -- field should contain the identifier for the plugin who owns this resolve + -- request. + NotResolveOwner Text + -- | The plugin is disabled globally in the users config. + | DisabledGlobally + -- | The feature in the plugin that responds to this request is disabled in + -- the users config + | FeatureDisabled + -- | This plugin does not support the file type. The text field here should + -- contain the filetype of the rejected request. + | DoesNotSupportFileType Text + deriving (Eq) + +-- | Whether a plugin will handle a request or not. +data HandleRequestResult = HandlesRequest | DoesNotHandleRequest RejectionReason + deriving (Eq) + +instance Pretty HandleRequestResult where + pretty HandlesRequest = "handles this request" + pretty (DoesNotHandleRequest reason) = pretty reason + +instance Pretty RejectionReason where + pretty (NotResolveOwner s) = "does not handle resolve requests for " <> pretty s <> ")." + pretty DisabledGlobally = "is disabled globally in your config." + pretty FeatureDisabled = "'s feature that handles this request is disabled in your config." + pretty (DoesNotSupportFileType s) = "does not support " <> pretty s <> " filetypes)." + +-- We always want to keep the leftmost disabled reason +instance Semigroup HandleRequestResult where + HandlesRequest <> HandlesRequest = HandlesRequest + DoesNotHandleRequest r <> _ = DoesNotHandleRequest r + _ <> DoesNotHandleRequest r = DoesNotHandleRequest r diff --git a/hls-plugin-api/src/Ide/PluginUtils.hs b/hls-plugin-api/src/Ide/PluginUtils.hs index 817c96ed9c..19ae197753 100644 --- a/hls-plugin-api/src/Ide/PluginUtils.hs +++ b/hls-plugin-api/src/Ide/PluginUtils.hs @@ -20,7 +20,7 @@ module Ide.PluginUtils getClientConfig, getPluginConfig, configForPlugin, - pluginEnabled, + handlesRequest, extractTextInRange, fullRange, mkLspCommand, diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index df5ab98f1d..2150d12509 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -32,7 +32,7 @@ module Ide.Types , IdePlugins(IdePlugins, ipMap) , DynFlagsModifications(..) , Config(..), PluginConfig(..), CheckParents(..) -, ConfigDescriptor(..), defaultConfigDescriptor, configForPlugin, pluginEnabledConfig +, ConfigDescriptor(..), defaultConfigDescriptor, configForPlugin , CustomConfig(..), mkCustomConfig , FallbackCodeActionParams(..) , FormattingType(..), FormattingMethod, FormattingHandler, mkFormattingHandlers @@ -51,8 +51,6 @@ module Ide.Types , lookupCommandProvider , ResolveFunction , mkResolveHandler -, DisabledReason (..) -, PluginStatus (..) ) where @@ -69,7 +67,8 @@ import System.Posix.Signals import Control.Applicative ((<|>)) import Control.Arrow ((&&&)) -import Control.Lens (_Just, (.~), (?~), (^.), (^?)) +import Control.Lens (_Just, view, (.~), (?~), (^.), + (^?)) import Control.Monad (void) import Control.Monad.Error.Class (MonadError (throwError)) import Control.Monad.Trans.Class (MonadTrans (lift)) @@ -98,6 +97,7 @@ import Development.IDE.Graph import GHC (DynFlags) import GHC.Generics import Ide.Plugin.Error +import Ide.Plugin.HandleRequestTypes import Ide.Plugin.Properties import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Message @@ -245,7 +245,7 @@ instance Default PluginConfig where , plcCompletionOn = True , plcRenameOn = True , plcSelectionRangeOn = True - , plcFoldingRangeOn = True + , plcFoldingRangeOn = True , plcConfig = mempty } @@ -295,16 +295,6 @@ describePlugin p = pdesc = pluginDescription p in pretty pid <> ":" <> nest 4 (PP.line <> pretty pdesc) --- | Check whether the given plugin descriptor is responsible for the file with the given path. --- Compares the file extension of the file at the given path with the file extension --- the plugin is responsible for. -pluginResponsible :: Uri -> PluginDescriptor c -> PluginStatus -pluginResponsible uri pluginDesc - | Just fp <- mfp - , T.pack (takeExtension fp) `elem` pluginFileType pluginDesc = PluginEnabled - | otherwise = PluginDisabled $ DisabledByFileType (maybe "" (T.pack . takeExtension) mfp) - where - mfp = uriToFilePath uri -- | An existential wrapper of 'Properties' data CustomConfig = forall r. CustomConfig (Properties r) @@ -346,47 +336,71 @@ defaultConfigDescriptor :: ConfigDescriptor defaultConfigDescriptor = ConfigDescriptor Data.Default.def False (mkCustomConfig emptyProperties) --- | Reasons why a plugin could be disabled for a request -data DisabledReason = PluginRejected T.Text | NotResolveOwner T.Text | DisabledByConfig | DisabledByFileType T.Text - deriving (Eq) +-- | Lookup the current config for a plugin +configForPlugin :: Config -> PluginDescriptor c -> PluginConfig +configForPlugin config PluginDescriptor{..} + = Map.findWithDefault (configInitialGenericConfig pluginConfigDescriptor) pluginId (plugins config) --- | Whether a plugin is enabled or not -data PluginStatus = PluginEnabled | PluginDisabled DisabledReason - deriving (Eq) +-- | Checks that a specific plugin is globally enabled in order to respond to +-- requests +pluginEnabledGlobally :: PluginDescriptor c -> Config -> HandleRequestResult +pluginEnabledGlobally desc conf = if plcGlobalOn (configForPlugin conf desc) + then HandlesRequest + else DoesNotHandleRequest DisabledGlobally -instance Pretty PluginStatus where - pretty PluginEnabled = "is enabled" - pretty (PluginDisabled (PluginRejected t)) = "rejected the request with: " <> pretty t - pretty (PluginDisabled (NotResolveOwner s)) = "does not respond to resolve requests for " <> pretty s <> ")" - pretty (PluginDisabled DisabledByConfig) = "is disabled from the config" - pretty (PluginDisabled (DisabledByFileType s)) = "does not respond to requests for " <> pretty s <> " filetypes)" +-- | Checks that a specific feature for a given plugin is both enabled order +-- to respond to requests +pluginFeatureEnabled :: (PluginConfig -> Bool) -> PluginDescriptor c -> Config -> HandleRequestResult +pluginFeatureEnabled f desc conf = if f (configForPlugin conf desc) + then HandlesRequest + else DoesNotHandleRequest FeatureDisabled --- We always want to keep the leftmost disabled reason -instance Semigroup PluginStatus where - PluginEnabled <> PluginEnabled = PluginEnabled - PluginDisabled r <> _ = PluginDisabled r - _ <> PluginDisabled r = PluginDisabled r +-- |Determine whether this request should be routed to the plugin. Fails closed +-- if we can't determine which plugin it should be routed to. +pluginResolverResponsible :: L.HasData_ m (Maybe Value) => m -> PluginDescriptor c -> HandleRequestResult +pluginResolverResponsible + (view L.data_ -> (Just (fromJSON -> (Success (PluginResolveData o@(PluginId ot) _ _))))) + pluginDesc = + if pluginId pluginDesc == o + then HandlesRequest + else DoesNotHandleRequest $ NotResolveOwner ot +-- We want to fail closed +pluginResolverResponsible _ _ = DoesNotHandleRequest $ NotResolveOwner "(unable to determine resolve owner)" + +-- | Check whether the given plugin descriptor is responsible for the file with +-- the given path. Compares the file extension from the msgParams with the +-- file extension the plugin is responsible for. +-- We are passing the msgParams here even though we only need the URI to allow +-- us to extract the URI here. If in the future we need to be able to provide +-- an URI it can be separated again. +pluginSupportsFileType :: (L.HasTextDocument m doc, L.HasUri doc Uri) => m -> PluginDescriptor c -> HandleRequestResult +pluginSupportsFileType msgParams pluginDesc = + case uriToFilePath uri of + Just fp | T.pack (takeExtension fp) `elem` pluginFileType pluginDesc -> HandlesRequest + _ -> DoesNotHandleRequest $ DoesNotSupportFileType (maybe "(unable to determine file type)" (T.pack . takeExtension) mfp) + where + mfp = uriToFilePath uri + uri = msgParams ^. L.textDocument . L.uri -- | Methods that can be handled by plugins. -- 'ExtraParams' captures any extra data the IDE passes to the handlers for this method -- Only methods for which we know how to combine responses can be instances of 'PluginMethod' class HasTracing (MessageParams m) => PluginMethod (k :: MessageKind) (m :: Method ClientToServer k) where - -- | Parse the configuration to check if this plugin is enabled. - -- Perform sanity checks on the message to see whether the plugin is enabled - -- for this message in particular. - -- If a plugin is not enabled, its handlers, commands, etc. will not be - -- run for the given message. + -- | Parse the configuration to check if this plugin is globally enabled, and + -- if the feature which handles this method is enabled. Perform sanity checks + -- on the message to see whether the plugin handles this message in particular. + -- This class is only used to determine whether a plugin can handle a specific + -- request. Commands and rules do not use this logic to determine whether or + -- not they are run. -- - -- Semantically, this method describes whether a plugin is enabled configuration wise - -- and is allowed to respond to the message. This might depend on the URI that is - -- associated to the Message Parameters. There are requests - -- with no associated URI that, consequentially, cannot inspect the URI. -- - -- A common reason why a plugin might not be allowed to respond although it is enabled: + -- A common reason why a plugin won't handle a request even though it is enabled: -- * The plugin cannot handle requests associated with the specific URI -- * Since the implementation of [cabal plugins](https://github.com/haskell/haskell-language-server/issues/2940) -- HLS knows plugins specific to Haskell and specific to [Cabal file descriptions](https://cabal.readthedocs.io/en/3.6/cabal-package.html) + -- * The resolve request is not routed to that specific plugin. Each resolve + -- request needs to be routed to only one plugin. -- -- Strictly speaking, we are conflating two concepts here: -- * Dynamically enabled (e.g. on a per-message basis) @@ -394,7 +408,7 @@ class HasTracing (MessageParams m) => PluginMethod (k :: MessageKind) (m :: Meth -- * Strictly speaking, this might also change dynamically -- -- But there is no use to split it up into two different methods for now. - pluginEnabled + handlesRequest :: SMethod m -- ^ Method type. -> MessageParams m @@ -406,146 +420,125 @@ class HasTracing (MessageParams m) => PluginMethod (k :: MessageKind) (m :: Meth -> Config -- ^ Generic config description, expected to contain 'PluginConfig' configuration -- for this plugin - -> PluginStatus + -> HandleRequestResult -- ^ Is this plugin enabled and allowed to respond to the given request -- with the given parameters? - default pluginEnabled :: (L.HasTextDocument (MessageParams m) doc, L.HasUri doc Uri) - => SMethod m -> MessageParams m -> PluginDescriptor c -> Config -> PluginStatus - pluginEnabled _ params desc conf = - pluginGlobalEnabled (configForPlugin conf desc) <> pluginResponsible uri desc - where - uri = params ^. L.textDocument . L.uri - --- | Only check if the file type is supported -pluginEnabledOnlyFileType :: (L.HasTextDocument (MessageParams m) doc, L.HasUri doc Uri) - => SMethod m -> MessageParams m -> PluginDescriptor c -> Config -> PluginStatus -pluginEnabledOnlyFileType _ msgParams pluginDesc _ = pluginResponsible uri pluginDesc - where - uri = msgParams ^. L.textDocument . L.uri - --- | Only check if the plugin is enabled globally -pluginEnabledOnlyGlobalOn :: SMethod m -> MessageParams m -> PluginDescriptor c -> Config -> PluginStatus -pluginEnabledOnlyGlobalOn _ _ desc conf = pluginGlobalEnabled (configForPlugin conf desc) + 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 -- | 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 - -> PluginDescriptor c -> Config -> PluginStatus + -> PluginDescriptor c -> Config -> HandleRequestResult pluginEnabledWithFeature feature _ msgParams pluginDesc config = - pluginEnabledConfig feature (configForPlugin config pluginDesc) - <> pluginResponsible uri pluginDesc - where - uri = msgParams ^. L.textDocument . L.uri + pluginEnabledGlobally pluginDesc config + <> pluginFeatureEnabled feature pluginDesc config + <> pluginSupportsFileType 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 -> PluginStatus +pluginEnabledResolve :: L.HasData_ s (Maybe Value) => (PluginConfig -> Bool) -> p -> s -> PluginDescriptor c -> Config -> HandleRequestResult pluginEnabledResolve feature _ msgParams pluginDesc config = - pluginEnabledConfig feature (configForPlugin config pluginDesc) - <> pluginResolverResponsible (msgParams ^. L.data_) pluginDesc + pluginEnabledGlobally pluginDesc config + <> pluginFeatureEnabled feature pluginDesc config + <> pluginResolverResponsible msgParams pluginDesc instance PluginMethod Request Method_TextDocumentCodeAction where - pluginEnabled = pluginEnabledWithFeature plcCodeActionsOn + handlesRequest = pluginEnabledWithFeature plcCodeActionsOn instance PluginMethod Request Method_CodeActionResolve where -- See Note [Resolve in PluginHandlers] - pluginEnabled = pluginEnabledResolve plcCodeActionsOn + handlesRequest = pluginEnabledResolve plcCodeActionsOn instance PluginMethod Request Method_TextDocumentDefinition where - pluginEnabled = pluginEnabledOnlyFileType + handlesRequest _ msgParams pluginDesc _ = pluginSupportsFileType msgParams pluginDesc instance PluginMethod Request Method_TextDocumentTypeDefinition where - pluginEnabled = pluginEnabledOnlyFileType - + handlesRequest _ msgParams pluginDesc _ = pluginSupportsFileType msgParams pluginDesc instance PluginMethod Request Method_TextDocumentDocumentHighlight where - pluginEnabled = pluginEnabledOnlyFileType - + handlesRequest _ msgParams pluginDesc _ = pluginSupportsFileType msgParams pluginDesc instance PluginMethod Request Method_TextDocumentReferences where - pluginEnabled = pluginEnabledOnlyFileType + handlesRequest _ msgParams pluginDesc _ = pluginSupportsFileType msgParams pluginDesc instance PluginMethod Request Method_WorkspaceSymbol where -- Unconditionally enabled, but should it really be? - pluginEnabled _ _ _ _ = PluginEnabled + handlesRequest _ _ _ _ = HandlesRequest instance PluginMethod Request Method_TextDocumentCodeLens where - pluginEnabled = pluginEnabledWithFeature plcCodeLensOn + handlesRequest = pluginEnabledWithFeature plcCodeLensOn instance PluginMethod Request Method_CodeLensResolve where -- See Note [Resolve in PluginHandlers] - pluginEnabled = pluginEnabledResolve plcCodeLensOn + handlesRequest = pluginEnabledResolve plcCodeLensOn instance PluginMethod Request Method_TextDocumentRename where - pluginEnabled = pluginEnabledWithFeature plcRenameOn + handlesRequest = pluginEnabledWithFeature plcRenameOn instance PluginMethod Request Method_TextDocumentHover where - - pluginEnabled = pluginEnabledWithFeature plcHoverOn + handlesRequest = pluginEnabledWithFeature plcHoverOn instance PluginMethod Request Method_TextDocumentDocumentSymbol where - - pluginEnabled = pluginEnabledWithFeature plcSymbolsOn + handlesRequest = pluginEnabledWithFeature plcSymbolsOn instance PluginMethod Request Method_CompletionItemResolve where -- See Note [Resolve in PluginHandlers] - pluginEnabled _ (CompletionItem {_data_=Nothing}) (PluginDescriptor {pluginId=PluginId "ghcide-completions-bounce"}) _ = PluginEnabled - pluginEnabled method params desc conf = pluginEnabledResolve plcCompletionOn method params desc conf + handlesRequest = pluginEnabledResolve plcCompletionOn instance PluginMethod Request Method_TextDocumentCompletion where - - pluginEnabled = pluginEnabledWithFeature plcCompletionOn + handlesRequest = pluginEnabledWithFeature plcCompletionOn instance PluginMethod Request Method_TextDocumentFormatting where - pluginEnabled SMethod_TextDocumentFormatting msgParams pluginDesc conf = + handlesRequest _ msgParams pluginDesc conf = if PluginId (formattingProvider conf) == pid || PluginId (cabalFormattingProvider conf) == pid - then PluginEnabled - else PluginDisabled DisabledByConfig - <> pluginResponsible uri pluginDesc + then HandlesRequest + else DoesNotHandleRequest FeatureDisabled + <> pluginSupportsFileType msgParams pluginDesc where - uri = msgParams ^. L.textDocument . L.uri pid = pluginId pluginDesc instance PluginMethod Request Method_TextDocumentRangeFormatting where - pluginEnabled _ msgParams pluginDesc conf = + handlesRequest _ msgParams pluginDesc conf = if PluginId (formattingProvider conf) == pid || PluginId (cabalFormattingProvider conf) == pid - then PluginEnabled - else PluginDisabled DisabledByConfig - <> pluginResponsible uri pluginDesc + then HandlesRequest + else DoesNotHandleRequest FeatureDisabled + <> pluginSupportsFileType msgParams pluginDesc where - uri = msgParams ^. L.textDocument . L.uri pid = pluginId pluginDesc instance PluginMethod Request Method_TextDocumentPrepareCallHierarchy where - - pluginEnabled = pluginEnabledWithFeature plcCallHierarchyOn + handlesRequest = pluginEnabledWithFeature plcCallHierarchyOn instance PluginMethod Request Method_TextDocumentSelectionRange where - - pluginEnabled = pluginEnabledWithFeature plcSelectionRangeOn + handlesRequest = pluginEnabledWithFeature plcSelectionRangeOn instance PluginMethod Request Method_TextDocumentFoldingRange where - - pluginEnabled = pluginEnabledWithFeature plcFoldingRangeOn + handlesRequest = pluginEnabledWithFeature plcFoldingRangeOn instance PluginMethod Request Method_CallHierarchyIncomingCalls where -- This method has no URI parameter, thus no call to 'pluginResponsible' - pluginEnabled _ _ pluginDesc conf = - pluginEnabledConfig plcCallHierarchyOn (configForPlugin conf pluginDesc) + 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' - pluginEnabled _ _ pluginDesc conf = - pluginEnabledConfig plcCallHierarchyOn (configForPlugin conf pluginDesc) + handlesRequest _ _ pluginDesc conf = + pluginEnabledGlobally pluginDesc conf + <> pluginFeatureEnabled plcCallHierarchyOn pluginDesc conf + instance PluginMethod Request Method_WorkspaceExecuteCommand where - pluginEnabled _ _ _ _= PluginEnabled + handlesRequest _ _ _ _= HandlesRequest instance PluginMethod Request (Method_CustomMethod m) where - pluginEnabled _ _ _ _ = PluginEnabled + handlesRequest _ _ _ _ = HandlesRequest -- Plugin Notifications @@ -559,19 +552,19 @@ instance PluginMethod Notification Method_TextDocumentDidClose where instance PluginMethod Notification Method_WorkspaceDidChangeWatchedFiles where -- This method has no URI parameter, thus no call to 'pluginResponsible'. - pluginEnabled = pluginEnabledOnlyGlobalOn + handlesRequest _ _ desc conf = pluginEnabledGlobally desc conf instance PluginMethod Notification Method_WorkspaceDidChangeWorkspaceFolders where -- This method has no URI parameter, thus no call to 'pluginResponsible'. - pluginEnabled = pluginEnabledOnlyGlobalOn + handlesRequest _ _ desc conf = pluginEnabledGlobally desc conf instance PluginMethod Notification Method_WorkspaceDidChangeConfiguration where -- This method has no URI parameter, thus no call to 'pluginResponsible'. - pluginEnabled = pluginEnabledOnlyGlobalOn + handlesRequest _ _ desc conf = pluginEnabledGlobally desc conf instance PluginMethod Notification Method_Initialized where -- This method has no URI parameter, thus no call to 'pluginResponsible'. - pluginEnabled = pluginEnabledOnlyGlobalOn + handlesRequest _ _ desc conf = pluginEnabledGlobally desc conf -- --------------------------------------------------------------------- @@ -1008,7 +1001,7 @@ mkResolveHandler -> PluginHandlers ideState mkResolveHandler m f = mkPluginHandler m $ \ideState plId params -> do case fromJSON <$> (params ^. L.data_) of - (Just (Success (PluginResolveData owner uri value) )) -> do + (Just (Success (PluginResolveData owner@(PluginId ownerName) uri value) )) -> do if owner == plId then case fromJSON value of @@ -1018,7 +1011,8 @@ mkResolveHandler m f = mkPluginHandler m $ \ideState plId params -> do Error msg -> -- We are assuming that if we can't decode the data, that this -- request belongs to another resolve handler for this plugin. - throwError (PluginRequestRefused (T.pack ("Unable to decode payload for handler, assuming that it's for a different handler" <> msg))) + throwError (PluginRequestRefused + (NotResolveOwner (ownerName <> ": error decoding payload:" <> T.pack msg))) -- If we are getting an owner that isn't us, this means that there is an -- error, as we filter these our in `pluginEnabled` else throwError $ PluginInternalError invalidRequest @@ -1054,23 +1048,6 @@ newtype PluginId = PluginId T.Text instance IsString PluginId where fromString = PluginId . T.pack --- | Lookup the current config for a plugin -configForPlugin :: Config -> PluginDescriptor c -> PluginConfig -configForPlugin config PluginDescriptor{..} - = Map.findWithDefault (configInitialGenericConfig pluginConfigDescriptor) pluginId (plugins config) - --- | Checks that a specific plugin is enabled -pluginGlobalEnabled :: PluginConfig -> PluginStatus -pluginGlobalEnabled pc = if plcGlobalOn pc - then PluginEnabled - else PluginDisabled DisabledByConfig - --- | Checks that a given plugin is both enabled and the specific feature is --- enabled -pluginEnabledConfig :: (PluginConfig -> Bool) -> PluginConfig -> PluginStatus -pluginEnabledConfig f pluginConfig = if plcGlobalOn pluginConfig && f pluginConfig - then PluginEnabled - else PluginDisabled DisabledByConfig -- --------------------------------------------------------------------- @@ -1195,16 +1172,6 @@ getProcessID = fromIntegral <$> P.getProcessID installSigUsr1Handler h = void $ installHandler sigUSR1 (Catch h) Nothing #endif --- |Determine whether this request should be routed to the plugin. Fails closed --- if we can't determine which plugin it should be routed to. -pluginResolverResponsible :: Maybe Value -> PluginDescriptor c -> PluginStatus -pluginResolverResponsible (Just (fromJSON -> (Success (PluginResolveData o@(PluginId ot) _ _)))) pluginDesc = - if pluginId pluginDesc == o - then PluginEnabled - else PluginDisabled $ NotResolveOwner ot --- We want to fail closed -pluginResolverResponsible _ _ = PluginDisabled $ NotResolveOwner "" - {- Note [Resolve in PluginHandlers] Resolve methods have a few guarantees that need to be made by HLS, specifically they need to only be called once, as neither their errors nor diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 1a1c8783d7..0c47287183 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -226,8 +226,8 @@ rules :: Recorder (WithPriority Log) -> PluginId -> Rules () rules recorder plugin = do define (cmapWithPrio LogShake recorder) $ \GetHlintDiagnostics file -> do config <- getPluginConfigAction plugin - let hlintOn = pluginEnabledConfig plcDiagnosticsOn config - ideas <- if hlintOn == PluginEnabled then getIdeas recorder file else return (Right []) + let hlintOn = plcGlobalOn config && plcDiagnosticsOn config + ideas <- if hlintOn then getIdeas recorder file else return (Right []) return (diagnostics file ideas, Just ()) defineNoFile (cmapWithPrio LogShake recorder) $ \GetHlintSettings -> do diff --git a/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs b/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs index a2bc6f06ed..576cbe9c5d 100644 --- a/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs +++ b/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs @@ -31,12 +31,10 @@ import Development.IDE.GHC.Error (realSrcSpanToRange) import GHC.Generics (Generic) import Ide.Plugin.Config import Ide.Types (PluginDescriptor (..), - PluginId, PluginStatus (..), - configHasDiagnostics, + PluginId, configHasDiagnostics, configInitialGenericConfig, defaultConfigDescriptor, - defaultPluginDescriptor, - pluginEnabledConfig) + defaultPluginDescriptor) import qualified Language.LSP.Protocol.Types as LSP import Stan.Analysis (Analysis (..), runAnalysis) import Stan.Category (Category (..)) @@ -81,7 +79,7 @@ rules recorder plId = do define (cmapWithPrio LogShake recorder) $ \GetStanDiagnostics file -> do config <- getPluginConfigAction plId - if pluginEnabledConfig plcDiagnosticsOn config == PluginEnabled then do + if plcGlobalOn config && plcDiagnosticsOn config then do maybeHie <- getHieFile file case maybeHie of Nothing -> return ([], Nothing) diff --git a/test/functional/Format.hs b/test/functional/Format.hs index 6b174a68d1..0b021c79d5 100644 --- a/test/functional/Format.hs +++ b/test/functional/Format.hs @@ -30,7 +30,7 @@ providerTests = testGroup "lsp formatting provider" liftIO $ case resp ^. L.result of result@(Left (ResponseError reason message Nothing)) -> case reason of (InR ErrorCodes_MethodNotFound) -> pure () -- No formatter - (InR ErrorCodes_InvalidRequest) | "No plugin enabled for SMethod_TextDocumentFormatting" `T.isPrefixOf` message -> pure () + (InR ErrorCodes_InvalidRequest) | "No plugin" `T.isPrefixOf` message -> pure () _ -> assertFailure $ "strange response from formatting provider:" ++ show result result -> assertFailure $ "strange response from formatting provider:" ++ show result From 6cdc4c8a71073e3ea5e4e8d1ea56250bc331f01d Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Sun, 31 Dec 2023 13:33:46 +0300 Subject: [PATCH 7/9] Fix test and comments --- ghcide/test/exe/ExceptionTests.hs | 15 ++++++++------- hls-plugin-api/src/Ide/Types.hs | 2 +- 2 files changed, 9 insertions(+), 8 deletions(-) diff --git a/ghcide/test/exe/ExceptionTests.hs b/ghcide/test/exe/ExceptionTests.hs index 106e9bb985..1a5003d5f4 100644 --- a/ghcide/test/exe/ExceptionTests.hs +++ b/ghcide/test/exe/ExceptionTests.hs @@ -18,6 +18,7 @@ import GHC.Base (coerce) import Ide.Logger (Logger, Recorder, WithPriority, cmapWithPrio) import Ide.Plugin.Error +import Ide.Plugin.HandleRequestTypes (RejectionReason (DisabledGlobally)) import Ide.PluginUtils (idePluginsToPluginDesc, pluginDescToIdePlugins) import Ide.Types @@ -106,9 +107,9 @@ tests recorder logger = do _ -> liftIO $ assertFailure $ "We should have had an empty list" <> show lens] , testGroup "Testing PluginError order..." - [ pluginOrderTestCase recorder logger "InternalError over InvalidParams" PluginInternalError PluginInvalidParams - , pluginOrderTestCase recorder logger "InvalidParams over InvalidUserState" PluginInvalidParams PluginInvalidUserState - , pluginOrderTestCase recorder logger "InvalidUserState over RequestRefused" PluginInvalidUserState PluginRequestRefused + [ pluginOrderTestCase recorder logger "InternalError over InvalidParams" (PluginInternalError "error test") (PluginInvalidParams "error test") + , pluginOrderTestCase recorder logger "InvalidParams over InvalidUserState" (PluginInvalidParams "error test") (PluginInvalidUserState "error test") + , pluginOrderTestCase recorder logger "InvalidUserState over RequestRefused" (PluginInvalidUserState "error test") (PluginRequestRefused DisabledGlobally) ] ] @@ -132,7 +133,7 @@ testingLite recorder logger plugins = , IDE.argsIdeOptions = ideOptions } -pluginOrderTestCase :: Recorder (WithPriority Log) -> Logger -> TestName -> (T.Text -> PluginError) -> (T.Text -> PluginError) -> TestTree +pluginOrderTestCase :: Recorder (WithPriority Log) -> Logger -> TestName -> PluginError -> PluginError -> TestTree pluginOrderTestCase recorder logger msg err1 err2 = testCase msg $ do let pluginId = "error-order-test" @@ -140,9 +141,9 @@ pluginOrderTestCase recorder logger msg err1 err2 = [ (defaultPluginDescriptor pluginId "") { pluginHandlers = mconcat [ mkPluginHandler SMethod_TextDocumentCodeLens $ \_ _ _-> do - throwError $ err1 "error test" + throwError err1 ,mkPluginHandler SMethod_TextDocumentCodeLens $ \_ _ _-> do - throwError $ err2 "error test" + throwError err2 ] }] testIde recorder (testingLite recorder logger plugins) $ do @@ -150,6 +151,6 @@ pluginOrderTestCase recorder logger msg err1 err2 = waitForProgressDone (view L.result -> lens) <- request SMethod_TextDocumentCodeLens (CodeLensParams Nothing Nothing doc) case lens of - Left re | toResponseError (pluginId, err1 "error test") == re -> pure () + Left re | toResponseError (pluginId, err1) == re -> pure () | otherwise -> liftIO $ assertFailure "We caught an error, but it wasn't ours!" _ -> liftIO $ assertFailure $ show lens diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index 2150d12509..ea5746d3aa 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -348,7 +348,7 @@ pluginEnabledGlobally desc conf = if plcGlobalOn (configForPlugin conf desc) then HandlesRequest else DoesNotHandleRequest DisabledGlobally --- | Checks that a specific feature for a given plugin is both enabled order +-- | Checks that a specific feature for a given plugin is enabled in order -- to respond to requests pluginFeatureEnabled :: (PluginConfig -> Bool) -> PluginDescriptor c -> Config -> HandleRequestResult pluginFeatureEnabled f desc conf = if f (configForPlugin conf desc) From fc7a5ef1ea71468aa8d6b221e0f6661b1108929b Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Wed, 3 Jan 2024 17:34:01 +0300 Subject: [PATCH 8/9] Fix formatting provider bug --- .../src/Ide/Plugin/HandleRequestTypes.hs | 4 +++ hls-plugin-api/src/Ide/Types.hs | 25 ++++++++++--------- 2 files changed, 17 insertions(+), 12 deletions(-) diff --git a/hls-plugin-api/src/Ide/Plugin/HandleRequestTypes.hs b/hls-plugin-api/src/Ide/Plugin/HandleRequestTypes.hs index 9eb30ad52d..20b81efa2d 100644 --- a/hls-plugin-api/src/Ide/Plugin/HandleRequestTypes.hs +++ b/hls-plugin-api/src/Ide/Plugin/HandleRequestTypes.hs @@ -16,6 +16,9 @@ data RejectionReason = -- | The feature in the plugin that responds to this request is disabled in -- the users config | FeatureDisabled + -- | This plugin is not the formatting provider selected in the users config. + -- The text should be the formatting provider in your config. + | NotFormattingProvider Text -- | This plugin does not support the file type. The text field here should -- contain the filetype of the rejected request. | DoesNotSupportFileType Text @@ -33,6 +36,7 @@ instance Pretty RejectionReason where pretty (NotResolveOwner s) = "does not handle resolve requests for " <> pretty s <> ")." pretty DisabledGlobally = "is disabled globally in your config." pretty FeatureDisabled = "'s feature that handles this request is disabled in your config." + pretty (NotFormattingProvider s) = "is not the formatting provider ("<> pretty s<>") you chose in your config." pretty (DoesNotSupportFileType s) = "does not support " <> pretty s <> " filetypes)." -- We always want to keep the leftmost disabled reason diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index ea5746d3aa..e796994294 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -364,18 +364,19 @@ pluginResolverResponsible if pluginId pluginDesc == o then HandlesRequest else DoesNotHandleRequest $ NotResolveOwner ot --- We want to fail closed +-- If we can't determine who this request belongs to, then we don't want any plugin +-- to handle it. pluginResolverResponsible _ _ = DoesNotHandleRequest $ NotResolveOwner "(unable to determine resolve owner)" --- | Check whether the given plugin descriptor is responsible for the file with --- the given path. Compares the file extension from the msgParams with the --- file extension the plugin is responsible for. --- We are passing the msgParams here even though we only need the URI to allow --- us to extract the URI here. If in the future we need to be able to provide --- an URI it can be separated again. +-- | Check whether the given plugin descriptor supports the file with +-- the given path. Compares the file extension from the msgParams with the +-- file extension the plugin is responsible for. +-- 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 uriToFilePath uri of + 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) where @@ -495,20 +496,20 @@ instance PluginMethod Request Method_TextDocumentCompletion where instance PluginMethod Request Method_TextDocumentFormatting where handlesRequest _ msgParams pluginDesc conf = - if PluginId (formattingProvider conf) == pid + (if PluginId (formattingProvider conf) == pid || PluginId (cabalFormattingProvider conf) == pid then HandlesRequest - else DoesNotHandleRequest FeatureDisabled + else DoesNotHandleRequest (NotFormattingProvider (formattingProvider conf)) ) <> pluginSupportsFileType msgParams pluginDesc where pid = pluginId pluginDesc instance PluginMethod Request Method_TextDocumentRangeFormatting where handlesRequest _ msgParams pluginDesc conf = - if PluginId (formattingProvider conf) == pid + (if PluginId (formattingProvider conf) == pid || PluginId (cabalFormattingProvider conf) == pid then HandlesRequest - else DoesNotHandleRequest FeatureDisabled + else DoesNotHandleRequest (NotFormattingProvider (formattingProvider conf))) <> pluginSupportsFileType msgParams pluginDesc where pid = pluginId pluginDesc From 6b658e680d5cf15680d4f3e4aa95e922965c3a11 Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Wed, 3 Jan 2024 17:37:05 +0300 Subject: [PATCH 9/9] Fix wording --- 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 022d3ae107..107a02766c 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS.hs @@ -81,7 +81,7 @@ noPluginHandles recorder m fs' = do msg = noPluginHandlesMsg m fs' return $ Left err where noPluginHandlesMsg :: SMethod m -> [(PluginId, HandleRequestResult)] -> Text - noPluginHandlesMsg method [] = "No plugin installed for this " <> T.pack (show method) <> " request." + noPluginHandlesMsg method [] = "No plugins are available to handle this " <> T.pack (show method) <> " request." noPluginHandlesMsg method availPlugins = "No plugins are available to handle this " <> T.pack (show method) <> " request.\n Plugins installed for this method, but not available to handle this request are:\n" <> (T.intercalate "\n" $