diff --git a/ghcide/src/Development/IDE/Plugin/HLS.hs b/ghcide/src/Development/IDE/Plugin/HLS.hs index 3e58a57ccb..107a02766c 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) @@ -36,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 @@ -65,23 +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] -> 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] -> Text - pluginNotEnabled method availPlugins = - "No plugin enabled for " <> T.pack (show method) <> ", potentially available: " - <> (T.intercalate ", " $ map (\(PluginId plid) -> plid) availPlugins) + where noPluginHandlesMsg :: SMethod m -> [(PluginId, HandleRequestResult)] -> Text + 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" $ + map (\(PluginId plid, pluginStatus) -> + plid + <> " " + <> (renderStrict . layoutCompact . pretty) pluginStatus) + availPlugins) pluginDoesntExist :: PluginId -> Text pluginDoesntExist (PluginId pid) = "Plugin " <> pid <> " doesn't exist" @@ -213,8 +221,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 (fst <$> ecs) + (Left (PluginRequestRefused r)) -> + liftIO $ noPluginHandles recorder SMethod_WorkspaceExecuteCommand [(p,DoesNotHandleRequest r)] (Left pluginErr) -> do liftIO $ logErrors recorder [(p, pluginErr)] pure $ Left $ toResponseError (p, pluginErr) @@ -236,11 +244,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 - let fs = filter (\(_, desc, _) -> pluginEnabled m params desc config) fs' + -- Only run plugins that are allowed to run on this request, save the + -- list of disabled plugins incase that's all we have + let (fs, dfs) = List.partition (\(_, desc, _) -> handlesRequest m params desc config == HandlesRequest) fs' + let disabledPluginsReason = (\(x, desc, _) -> (x, handlesRequest m params desc config)) <$> dfs -- 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 $ noPluginHandles recorder m disabledPluginsReason Just neFs -> do let plidsAndHandlers = fmap (\(plid,_,handler) -> (plid,handler)) neFs es <- runConcurrently exceptionInPlugin m plidsAndHandlers ide params @@ -251,9 +261,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, _, _) -> x) <$> fs') + (asErrors, asRefused) = List.partition noRefused errs + convertPRR (pId, PluginRequestRefused r) = Just (pId, DoesNotHandleRequest r) + convertPRR _ = Nothing + asRefusedReason = mapMaybe convertPRR asRefused + case nonEmpty asErrors of + Nothing -> liftIO $ noPluginHandles recorder m (disabledPluginsReason <> asRefusedReason) Just xs -> pure $ Left $ combineErrors xs Just xs -> do pure $ Right $ combineResponses m config caps params xs @@ -274,8 +287,8 @@ 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 - let fs = filter (\(_, desc, _) -> pluginEnabled m params desc config) fs' + -- Only run plugins that are enabled for this request + 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/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/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..20b81efa2d --- /dev/null +++ b/hls-plugin-api/src/Ide/Plugin/HandleRequestTypes.hs @@ -0,0 +1,46 @@ +{-# 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 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 + 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 (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 +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 56866ffe8c..e796994294 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 @@ -67,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)) @@ -96,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 @@ -243,7 +245,7 @@ instance Default PluginConfig where , plcCompletionOn = True , plcRenameOn = True , plcSelectionRangeOn = True - , plcFoldingRangeOn = True + , plcFoldingRangeOn = True , plcConfig = mempty } @@ -293,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 -> Bool -pluginResponsible uri pluginDesc - | Just fp <- mfp - , T.pack (takeExtension fp) `elem` pluginFileType pluginDesc = True - | otherwise = False - where - mfp = uriToFilePath uri -- | An existential wrapper of 'Properties' data CustomConfig = forall r. CustomConfig (Properties r) @@ -344,26 +336,72 @@ defaultConfigDescriptor :: ConfigDescriptor defaultConfigDescriptor = ConfigDescriptor Data.Default.def False (mkCustomConfig emptyProperties) +-- | 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 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 + +-- | 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) + then HandlesRequest + else DoesNotHandleRequest FeatureDisabled + +-- |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 +-- 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 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 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 + 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) @@ -371,7 +409,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 @@ -383,168 +421,180 @@ class HasTracing (MessageParams m) => PluginMethod (k :: MessageKind) (m :: Meth -> Config -- ^ Generic config description, expected to contain 'PluginConfig' configuration -- for this plugin - -> Bool + -> 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 -> Bool - pluginEnabled _ params desc conf = pluginResponsible uri desc && plcGlobalOn (configForPlugin conf 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 - - default combineResponses :: Semigroup (MessageResult m) - => SMethod m -> Config -> ClientCapabilities -> MessageParams m -> NonEmpty (MessageResult m) -> MessageResult m - combineResponses _method _config _caps _params = sconcat + 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 -> HandleRequestResult +pluginEnabledWithFeature feature _ msgParams pluginDesc config = + 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 -> HandleRequestResult +pluginEnabledResolve feature _ msgParams pluginDesc config = + pluginEnabledGlobally pluginDesc config + <> pluginFeatureEnabled feature pluginDesc config + <> pluginResolverResponsible msgParams pluginDesc instance PluginMethod Request Method_TextDocumentCodeAction where - pluginEnabled _ msgParams pluginDesc config = - pluginResponsible uri pluginDesc && pluginEnabledConfig plcCodeActionsOn (configForPlugin config pluginDesc) - where - uri = msgParams ^. L.textDocument . L.uri + handlesRequest = 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) + handlesRequest = pluginEnabledResolve plcCodeActionsOn instance PluginMethod Request Method_TextDocumentDefinition where - pluginEnabled _ msgParams pluginDesc _ = - pluginResponsible uri pluginDesc - where - uri = msgParams ^. L.textDocument . L.uri + handlesRequest _ msgParams pluginDesc _ = pluginSupportsFileType msgParams pluginDesc instance PluginMethod Request Method_TextDocumentTypeDefinition where - pluginEnabled _ msgParams pluginDesc _ = - pluginResponsible uri pluginDesc - where - uri = msgParams ^. L.textDocument . L.uri + handlesRequest _ msgParams pluginDesc _ = pluginSupportsFileType msgParams pluginDesc instance PluginMethod Request Method_TextDocumentDocumentHighlight where - pluginEnabled _ msgParams pluginDesc _ = - pluginResponsible uri pluginDesc - where - uri = msgParams ^. L.textDocument . L.uri + handlesRequest _ msgParams pluginDesc _ = pluginSupportsFileType msgParams pluginDesc instance PluginMethod Request Method_TextDocumentReferences where - pluginEnabled _ msgParams pluginDesc _ = - pluginResponsible uri pluginDesc - where - uri = msgParams ^. L.textDocument . L.uri + handlesRequest _ msgParams pluginDesc _ = pluginSupportsFileType msgParams pluginDesc instance PluginMethod Request Method_WorkspaceSymbol where -- Unconditionally enabled, but should it really be? - pluginEnabled _ _ _ _ = True + handlesRequest _ _ _ _ = HandlesRequest 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 + handlesRequest = 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) + handlesRequest = 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 + handlesRequest = 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 + handlesRequest = 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 + handlesRequest = 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) + handlesRequest = pluginEnabledResolve plcCompletionOn 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 + handlesRequest = 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) + handlesRequest _ msgParams pluginDesc conf = + (if PluginId (formattingProvider conf) == pid + || PluginId (cabalFormattingProvider conf) == pid + then HandlesRequest + else DoesNotHandleRequest (NotFormattingProvider (formattingProvider conf)) ) + <> pluginSupportsFileType msgParams 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) + handlesRequest _ msgParams pluginDesc conf = + (if PluginId (formattingProvider conf) == pid + || PluginId (cabalFormattingProvider conf) == pid + then HandlesRequest + else DoesNotHandleRequest (NotFormattingProvider (formattingProvider conf))) + <> pluginSupportsFileType msgParams 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 + handlesRequest = 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 + handlesRequest = 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 + 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 _ _ _ _= True + handlesRequest _ _ _ _= HandlesRequest instance PluginMethod Request (Method_CustomMethod m) where - pluginEnabled _ _ _ _ = True + handlesRequest _ _ _ _ = HandlesRequest + +-- 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'. + handlesRequest _ _ desc conf = pluginEnabledGlobally desc conf + +instance PluginMethod Notification Method_WorkspaceDidChangeWorkspaceFolders where + -- This method has no URI parameter, thus no call to 'pluginResponsible'. + handlesRequest _ _ desc conf = pluginEnabledGlobally desc conf + +instance PluginMethod Notification Method_WorkspaceDidChangeConfiguration where + -- This method has no URI parameter, thus no call to 'pluginResponsible'. + handlesRequest _ _ desc conf = pluginEnabledGlobally desc conf + +instance PluginMethod Notification Method_Initialized where + -- This method has no URI parameter, thus no call to 'pluginResponsible'. + handlesRequest _ _ desc conf = pluginEnabledGlobally desc conf + + +-- --------------------------------------------------------------------- +-- 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 @@ -756,31 +806,6 @@ downgradeLinks defs = defs 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 @@ -977,7 +1002,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 @@ -987,7 +1012,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 @@ -1023,15 +1049,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 given plugin is both enabled and the specific feature is --- enabled -pluginEnabledConfig :: (PluginConfig -> Bool) -> PluginConfig -> Bool -pluginEnabledConfig f pluginConfig = plcGlobalOn pluginConfig && f pluginConfig -- --------------------------------------------------------------------- @@ -1156,14 +1173,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 -> Bool -pluginResolverResponsible (Just (fromJSON -> (Success (PluginResolveData o _ _)))) pluginDesc = - pluginId pluginDesc == o --- We want to fail closed -pluginResolverResponsible _ _ = False - {- 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 24636236e5..0c47287183 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 (WithPriority Log) -> PluginId -> Rules () rules recorder plugin = do define (cmapWithPrio LogShake recorder) $ \GetHlintDiagnostics file -> do config <- getPluginConfigAction plugin - let hlintOn = pluginEnabledConfig plcDiagnosticsOn config + let hlintOn = plcGlobalOn config && plcDiagnosticsOn config ideas <- if hlintOn then getIdeas recorder file else return (Right []) return (diagnostics file ideas, Just ()) diff --git a/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs b/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs index 63e4de376d..576cbe9c5d 100644 --- a/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs +++ b/plugins/hls-stan-plugin/src/Ide/Plugin/Stan.hs @@ -34,8 +34,7 @@ import Ide.Types (PluginDescriptor (..), PluginId, configHasDiagnostics, configInitialGenericConfig, defaultConfigDescriptor, - defaultPluginDescriptor, - pluginEnabledConfig) + defaultPluginDescriptor) import qualified Language.LSP.Protocol.Types as LSP import Stan.Analysis (Analysis (..), runAnalysis) import Stan.Category (Category (..)) @@ -80,7 +79,7 @@ rules recorder plId = do define (cmapWithPrio LogShake recorder) $ \GetStanDiagnostics file -> do config <- getPluginConfigAction plId - if pluginEnabledConfig plcDiagnosticsOn config 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