From 0443319f76798c8eb426c08f73d2c7367f44f28d Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Wed, 5 Jul 2023 23:42:07 +0300 Subject: [PATCH 01/12] WIP --- hls-plugin-api/hls-plugin-api.cabal | 1 + hls-plugin-api/src/Ide/Plugin/Resolve.hs | 108 +++++++++++ hls-plugin-api/src/Ide/Types.hs | 231 +++++++++-------------- 3 files changed, 194 insertions(+), 146 deletions(-) create mode 100644 hls-plugin-api/src/Ide/Plugin/Resolve.hs diff --git a/hls-plugin-api/hls-plugin-api.cabal b/hls-plugin-api/hls-plugin-api.cabal index 64d1aa8263..4a4c370f5d 100644 --- a/hls-plugin-api/hls-plugin-api.cabal +++ b/hls-plugin-api/hls-plugin-api.cabal @@ -38,6 +38,7 @@ library Ide.Plugin.ConfigUtils Ide.Plugin.Properties Ide.Plugin.RangeMap + Ide.Plugin.Resolve Ide.PluginUtils Ide.Types diff --git a/hls-plugin-api/src/Ide/Plugin/Resolve.hs b/hls-plugin-api/src/Ide/Plugin/Resolve.hs new file mode 100644 index 0000000000..7e477e180b --- /dev/null +++ b/hls-plugin-api/src/Ide/Plugin/Resolve.hs @@ -0,0 +1,108 @@ +{-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Ide.Plugin.Resolve (mkCodeActionHandlerWithResolve, +mkCodeActionWithResolveAndCommand) where + +import Control.Lens (_Just, (&), (.~), (?~), (^?)) +import Control.Monad.Trans.Class (MonadTrans (lift)) +import Control.Monad.Trans.Except (ExceptT (..), runExceptT) +import Data.Aeson (ToJSON (toJSON)) +import qualified Data.Aeson +import Data.Row ((.!)) +import Ide.Types +import qualified Language.LSP.Protocol.Lens as L +import Language.LSP.Protocol.Message +import Language.LSP.Protocol.Types +import Language.LSP.Server (LspM, LspT, + ProgressCancellable (Cancellable), + getClientCapabilities, + sendRequest, + withIndefiniteProgress) + + -- |When provided with both a codeAction provider and an affiliated codeAction +-- resolve provider, this function creates a handler that automatically uses +-- your resolve provider to fill out you original codeAction if the client doesn't +-- have codeAction resolve support. This means you don't have to check whether +-- the client supports resolve and act accordingly in your own providers. +mkCodeActionHandlerWithResolve + :: forall ideState. (ideState -> PluginId -> CodeActionParams -> LspM Config (Either ResponseError ([Command |? CodeAction] |? Null))) + -> (ideState -> PluginId -> CodeAction -> LspM Config (Either ResponseError CodeAction)) + -> PluginHandlers ideState +mkCodeActionHandlerWithResolve codeActionMethod codeResolveMethod = + let newCodeActionMethod ideState pid params = runExceptT $ + do codeActionReturn <- ExceptT $ codeActionMethod ideState pid params + caps <- lift getClientCapabilities + case codeActionReturn of + r@(InR Null) -> pure r + (InL ls) | -- If the client supports resolve, we will wrap the resolve data in a owned + -- resolve data type to allow the server to know who to send the resolve request to + supportsCodeActionResolve caps -> pure $ InL ls + --This is the actual part where we call resolveCodeAction which fills in the edit data for the client + | otherwise -> InL <$> traverse (resolveCodeAction ideState pid) ls + in mkPluginHandler SMethod_TextDocumentCodeAction newCodeActionMethod + <> mkPluginHandler SMethod_CodeActionResolve codeResolveMethod + where + dropData :: CodeAction -> CodeAction + dropData ca = ca & L.data_ .~ Nothing + resolveCodeAction :: ideState -> PluginId -> (Command |? CodeAction) -> ExceptT ResponseError (LspT Config IO) (Command |? CodeAction) + resolveCodeAction _ideState _pid c@(InL _) = pure c + resolveCodeAction ideState pid (InR codeAction) = + fmap (InR . dropData) $ ExceptT $ codeResolveMethod ideState pid codeAction + +-- |When provided with both a codeAction provider that includes both a command +-- and a data field and a resolve provider, this function creates a handler that +-- defaults to using your command if the client doesn't have code action resolve +-- support. This means you don't have to check whether the client supports resolve +-- and act accordingly in your own providers. +mkCodeActionWithResolveAndCommand + :: forall ideState. + PluginId + -> (ideState -> PluginId -> CodeActionParams -> LspM Config (Either ResponseError ([Command |? CodeAction] |? Null))) + -> (ideState -> PluginId -> CodeAction -> LspM Config (Either ResponseError CodeAction)) + -> ([PluginCommand ideState], PluginHandlers ideState) +mkCodeActionWithResolveAndCommand plId codeActionMethod codeResolveMethod = + let newCodeActionMethod ideState pid params = runExceptT $ + do codeActionReturn <- ExceptT $ codeActionMethod ideState pid params + caps <- lift getClientCapabilities + case codeActionReturn of + r@(InR Null) -> pure r + (InL ls) | -- If the client supports resolve, we will wrap the resolve data in a owned + -- resolve data type to allow the server to know who to send the resolve request to + supportsCodeActionResolve caps -> + pure $ InL ls + -- If they do not we will drop the data field, in addition we will populate the command + -- field with our command to execute the resolve, with the whole code action as it's argument. + | otherwise -> pure $ InL $ moveDataToCommand <$> ls + in ([PluginCommand "codeActionResolve" "Executes resolve for code action" (executeResolveCmd plId codeResolveMethod)], + mkPluginHandler SMethod_TextDocumentCodeAction newCodeActionMethod + <> mkPluginHandler SMethod_CodeActionResolve codeResolveMethod) + where moveDataToCommand :: Command |? CodeAction -> Command |? CodeAction + moveDataToCommand ca = + let dat = toJSON <$> ca ^? _R -- We need to take the whole codeAction + -- And put it in the argument for the Command, that way we can later + -- pas it to the resolve handler (which expects a whole code action) + cmd = mkLspCommand plId (CommandId "codeActionResolve") "Execute Code Action" (pure <$> dat) + in ca + & _R . L.data_ .~ Nothing -- Set the data field to nothing + & _R . L.command ?~ cmd -- And set the command to our previously created command + executeResolveCmd :: PluginId -> PluginMethodHandler ideState Method_CodeActionResolve -> CommandFunction ideState CodeAction + executeResolveCmd pluginId resolveProvider ideState ca = do + withIndefiniteProgress "Executing code action..." Cancellable $ do + resolveResult <- resolveProvider ideState pluginId ca + case resolveResult of + Right CodeAction {_edit = Just wedits } -> do + _ <- sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedits) (\_ -> pure ()) + pure $ Right Data.Aeson.Null + Right _ -> pure $ Left $ responseError "No edit in CodeAction" + Left err -> pure $ Left err + +supportsCodeActionResolve :: ClientCapabilities -> Bool +supportsCodeActionResolve caps = + caps ^? L.textDocument . _Just . L.codeAction . _Just . L.dataSupport . _Just == Just True + && case caps ^? L.textDocument . _Just . L.codeAction . _Just . L.resolveSupport . _Just of + Just row -> "edit" `elem` row .! #properties + _ -> False diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index b7aaa6e231..195b6b2c2b 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -48,9 +48,7 @@ module Ide.Types , installSigUsr1Handler , responseError , lookupCommandProvider -, OwnedResolveData(..) -, mkCodeActionHandlerWithResolve -, mkCodeActionWithResolveAndCommand +, PluginResolveData(..) ) where @@ -64,10 +62,7 @@ import System.Posix.Signals import Control.Applicative ((<|>)) import Control.Arrow ((&&&)) import Control.Lens (_Just, (.~), (?~), (^.), (^?)) -import Control.Monad.Trans.Class (lift) -import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Data.Aeson hiding (Null, defaultOptions) -import qualified Data.Aeson import Data.Default import Data.Dependent.Map (DMap) import qualified Data.Dependent.Map as DMap @@ -81,7 +76,6 @@ import Data.List.NonEmpty (NonEmpty (..), toList) import qualified Data.Map as Map import Data.Maybe import Data.Ord -import Data.Row ((.!)) import Data.Semigroup import Data.String import qualified Data.Text as T @@ -93,11 +87,7 @@ import Ide.Plugin.Properties import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types -import Language.LSP.Server (LspM, LspT, - ProgressCancellable (Cancellable), - getClientCapabilities, - getVirtualFile, sendRequest, - withIndefiniteProgress) +import Language.LSP.Server (LspM, LspT, getVirtualFile) import Language.LSP.VFS import Numeric.Natural import OpenTelemetry.Eventlog @@ -477,7 +467,9 @@ instance PluginMethod Request Method_TextDocumentDocumentSymbol where uri = msgParams ^. L.textDocument . L.uri instance PluginMethod Request Method_CompletionItemResolve where - pluginEnabled _ msgParams pluginDesc config = pluginEnabledConfig plcCompletionOn (configForPlugin config pluginDesc) + pluginEnabled _ msgParams pluginDesc config = + pluginResolverResponsible (msgParams ^. L.data_) pluginDesc + && pluginEnabledConfig plcCompletionOn (configForPlugin config pluginDesc) instance PluginMethod Request Method_TextDocumentCompletion where pluginEnabled _ msgParams pluginDesc config = pluginResponsible uri pluginDesc @@ -558,9 +550,8 @@ instance PluginRequestMethod Method_TextDocumentCodeAction where | otherwise = False instance PluginRequestMethod Method_CodeActionResolve where - -- CodeAction resolve is currently only used to changed the edit field, thus - -- that's the only field we are combining. - combineResponses _ _ _ codeAction (toList -> codeActions) = codeAction & L.edit .~ mconcat ((^. L.edit) <$> codeActions) + -- Resolve method should only ever get one response + combineResponses _ _ _ _ (x :| _) = x instance PluginRequestMethod Method_TextDocumentDefinition where combineResponses _ _ _ _ (x :| _) = x @@ -624,16 +615,8 @@ instance PluginRequestMethod Method_TextDocumentDocumentSymbol where in [si] <> children' instance PluginRequestMethod Method_CompletionItemResolve where - -- resolving completions can only change the detail, additionalTextEdit or documentation fields - combineResponses _ _ _ _ (x :| xs) = go x xs - where go :: CompletionItem -> [CompletionItem] -> CompletionItem - go !comp [] = comp - go !comp1 (comp2:xs) - = go (comp1 - & L.detail .~ comp1 ^. L.detail <> comp2 ^. L.detail - & L.documentation .~ ((comp1 ^. L.documentation) <|> (comp2 ^. L.documentation)) -- difficult to write generic concatentation for docs - & L.additionalTextEdits .~ comp1 ^. L.additionalTextEdits <> comp2 ^. L.additionalTextEdits) - xs + -- resolve method's should only ever get one response + combineResponses _ _ _ _ (x :| _) = x instance PluginRequestMethod Method_TextDocumentCompletion where combineResponses _ conf _ _ (toList -> xs) = snd $ consumeCompletionResponse limit $ combine xs @@ -792,13 +775,71 @@ type PluginNotificationMethodHandler a m = a -> VFS -> PluginId -> MessageParams -- | Make a handler for plugins with no extra data mkPluginHandler - :: PluginRequestMethod m + :: forall ideState m. PluginRequestMethod m => SClientMethod m -> PluginMethodHandler ideState m -> PluginHandlers ideState -mkPluginHandler m f = PluginHandlers $ DMap.singleton (IdeMethod m) (PluginHandler f') +mkPluginHandler m f = PluginHandlers $ DMap.singleton (IdeMethod m) (PluginHandler (f' m)) where - f' pid ide params = pure <$> f ide pid params + f' :: SMethod m -> PluginId -> ideState -> MessageParams m -> LspT Config IO (NonEmpty (Either ResponseError (MessageResult m))) + -- We need to have separate functions for each method that supports resolve, so far we only support CodeActions + -- CodeLens, and Completion methods. + f' SMethod_TextDocumentCodeAction pid ide params@CodeActionParams{_textDocument=TextDocumentIdentifier {_uri}} = + pure . fmap (wrapCodeActions pid _uri) <$> f ide pid params + f' SMethod_TextDocumentCodeLens pid ide params@CodeLensParams{_textDocument=TextDocumentIdentifier {_uri}} = + pure . fmap (wrapCodeLenses pid _uri) <$> f ide pid params + f' SMethod_TextDocumentCompletion pid ide params@CompletionParams{_textDocument=TextDocumentIdentifier {_uri}} = + pure . fmap (wrapCompletions pid _uri) <$> f ide pid params + + -- If resolve handlers aren't declared with mkPluginHandler we won't need these here anymore + f' SMethod_CodeActionResolve pid ide params = + pure <$> f ide pid (unwrapResolveData params) + f' SMethod_CodeLensResolve pid ide params = + pure <$> f ide pid (unwrapResolveData params) + f' SMethod_CompletionItemResolve pid ide params = + pure <$> f ide pid (unwrapResolveData params) + + -- This is the default case for all other methods + f' _ pid ide params = pure <$> f ide pid params + + -- Todo: use fancy pancy lenses to make this a few lines + wrapCodeActions pid uri (InL ls) = + let wrapCodeActionItem pid uri (InR c) = InR $ wrapResolveData pid uri c + wrapCodeActionItem _ _ command@(InL _) = command + in InL $ wrapCodeActionItem pid uri <$> ls + wrapCodeActions _ _ (InR r) = InR r + + wrapCodeLenses pid uri (InL ls) = InL $ wrapResolveData pid uri <$> ls + wrapCodeLenses _ _ (InR r) = InR r + + wrapCompletions pid uri (InL ls) = InL $ wrapResolveData pid uri <$> ls + wrapCompletions pid uri (InR (InL cl@(CompletionList{_items}))) = + InR $ InL $ cl & L.items .~ (wrapResolveData pid uri <$> _items) + wrapCompletions _ _ (InR (InR r)) = InR $ InR r + +wrapResolveData :: L.HasData_ a (Maybe Value) => PluginId -> Uri -> a -> a +wrapResolveData pid uri hasData = + hasData & L.data_ .~ (toJSON .PRD pid uri <$> data_) + where data_ = hasData ^? L.data_ . _Just + +unwrapResolveData :: L.HasData_ a (Maybe Value) => a -> a +unwrapResolveData hasData + | Just x <- hasData ^. L.data_ + , Success PRD {value = v} <- fromJSON x = hasData & L.data_ ?~ v +-- If we can't successfully decode the value as a ORD type than +-- we just return the type untouched? +unwrapResolveData c = c + +-- |Allow plugins to "own" resolve data, allowing only them to be queried for +-- the resolve action. This design has added flexibility at the cost of nested +-- Value types +data PluginResolveData = PRD { + owner :: PluginId +, uri :: Uri +, value :: Value +} deriving (Generic, Show) +instance ToJSON PluginResolveData +instance FromJSON PluginResolveData -- | Make a handler for plugins with no extra data mkPluginNotificationHandler @@ -877,6 +918,17 @@ type CommandFunction ideState a -- --------------------------------------------------------------------- +-- Will something like this work? +type ResolveFunction ideState a m + = ideState + -> PluginId + -> MessageParams m + -> Uri + -> a + -> LspM Config (Either ResponseError (MessageResult m)) + + + newtype PluginId = PluginId T.Text deriving (Show, Read, Eq, Ord) deriving newtype (ToJSON, FromJSON, Hashable) @@ -1016,124 +1068,11 @@ getProcessID = fromIntegral <$> P.getProcessID installSigUsr1Handler h = void $ installHandler sigUSR1 (Catch h) Nothing #endif --- |When provided with both a codeAction provider and an affiliated codeAction --- resolve provider, this function creates a handler that automatically uses --- your resolve provider to fill out you original codeAction if the client doesn't --- have codeAction resolve support. This means you don't have to check whether --- the client supports resolve and act accordingly in your own providers. -mkCodeActionHandlerWithResolve - :: forall ideState. (ideState -> PluginId -> CodeActionParams -> LspM Config (Either ResponseError ([Command |? CodeAction] |? Null))) - -> (ideState -> PluginId -> CodeAction -> LspM Config (Either ResponseError CodeAction)) - -> PluginHandlers ideState -mkCodeActionHandlerWithResolve codeActionMethod codeResolveMethod = - let newCodeActionMethod ideState pid params = runExceptT $ - do codeActionReturn <- ExceptT $ codeActionMethod ideState pid params - caps <- lift getClientCapabilities - case codeActionReturn of - r@(InR Null) -> pure r - (InL ls) | -- If the client supports resolve, we will wrap the resolve data in a owned - -- resolve data type to allow the server to know who to send the resolve request to - supportsCodeActionResolve caps -> pure $ InL (wrapCodeActionResolveData pid <$> ls) - --This is the actual part where we call resolveCodeAction which fills in the edit data for the client - | otherwise -> InL <$> traverse (resolveCodeAction ideState pid) ls - newCodeResolveMethod ideState pid params = - codeResolveMethod ideState pid (unwrapCodeActionResolveData params) - in mkPluginHandler SMethod_TextDocumentCodeAction newCodeActionMethod - <> mkPluginHandler SMethod_CodeActionResolve newCodeResolveMethod - where - dropData :: CodeAction -> CodeAction - dropData ca = ca & L.data_ .~ Nothing - resolveCodeAction :: ideState -> PluginId -> (Command |? CodeAction) -> ExceptT ResponseError (LspT Config IO) (Command |? CodeAction) - resolveCodeAction _ideState _pid c@(InL _) = pure c - resolveCodeAction ideState pid (InR codeAction) = - fmap (InR . dropData) $ ExceptT $ codeResolveMethod ideState pid codeAction - --- |When provided with both a codeAction provider that includes both a command --- and a data field and a resolve provider, this function creates a handler that --- defaults to using your command if the client doesn't have code action resolve --- support. This means you don't have to check whether the client supports resolve --- and act accordingly in your own providers. -mkCodeActionWithResolveAndCommand - :: forall ideState. - PluginId - -> (ideState -> PluginId -> CodeActionParams -> LspM Config (Either ResponseError ([Command |? CodeAction] |? Null))) - -> (ideState -> PluginId -> CodeAction -> LspM Config (Either ResponseError CodeAction)) - -> ([PluginCommand ideState], PluginHandlers ideState) -mkCodeActionWithResolveAndCommand plId codeActionMethod codeResolveMethod = - let newCodeActionMethod ideState pid params = runExceptT $ - do codeActionReturn <- ExceptT $ codeActionMethod ideState pid params - caps <- lift getClientCapabilities - case codeActionReturn of - r@(InR Null) -> pure r - (InL ls) | -- If the client supports resolve, we will wrap the resolve data in a owned - -- resolve data type to allow the server to know who to send the resolve request to - supportsCodeActionResolve caps -> - pure $ InL (wrapCodeActionResolveData pid <$> ls) - -- If they do not we will drop the data field, in addition we will populate the command - -- field with our command to execute the resolve, with the whole code action as it's argument. - | otherwise -> pure $ InL $ moveDataToCommand <$> ls - newCodeResolveMethod ideState pid params = - codeResolveMethod ideState pid (unwrapCodeActionResolveData params) - in ([PluginCommand "codeActionResolve" "Executes resolve for code action" (executeResolveCmd plId codeResolveMethod)], - mkPluginHandler SMethod_TextDocumentCodeAction newCodeActionMethod - <> mkPluginHandler SMethod_CodeActionResolve newCodeResolveMethod) - where moveDataToCommand :: Command |? CodeAction -> Command |? CodeAction - moveDataToCommand ca = - let dat = toJSON <$> ca ^? _R -- We need to take the whole codeAction - -- And put it in the argument for the Command, that way we can later - -- pas it to the resolve handler (which expects a whole code action) - cmd = mkLspCommand plId (CommandId "codeActionResolve") "Execute Code Action" (pure <$> dat) - in ca - & _R . L.data_ .~ Nothing -- Set the data field to nothing - & _R . L.command ?~ cmd -- And set the command to our previously created command - executeResolveCmd :: PluginId -> PluginMethodHandler ideState Method_CodeActionResolve -> CommandFunction ideState CodeAction - executeResolveCmd pluginId resolveProvider ideState ca = do - withIndefiniteProgress "Executing code action..." Cancellable $ do - resolveResult <- resolveProvider ideState pluginId ca - case resolveResult of - Right CodeAction {_edit = Just wedits } -> do - _ <- sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedits) (\_ -> pure ()) - pure $ Right Data.Aeson.Null - Right _ -> pure $ Left $ responseError "No edit in CodeAction" - Left err -> pure $ Left err - -supportsCodeActionResolve :: ClientCapabilities -> Bool -supportsCodeActionResolve caps = - caps ^? L.textDocument . _Just . L.codeAction . _Just . L.dataSupport . _Just == Just True - && case caps ^? L.textDocument . _Just . L.codeAction . _Just . L.resolveSupport . _Just of - Just row -> "edit" `elem` row .! #properties - _ -> False - --- We don't wrap commands -wrapCodeActionResolveData :: PluginId -> (a |? CodeAction) -> a |? CodeAction -wrapCodeActionResolveData _pid c@(InL _) = c -wrapCodeActionResolveData pid (InR c@(CodeAction{_data_=Just x})) = - InR $ c & L.data_ ?~ toJSON (ORD pid x) --- Neither do we wrap code actions's without data fields, -wrapCodeActionResolveData _pid c@(InR (CodeAction{_data_=Nothing})) = c - -unwrapCodeActionResolveData :: CodeAction -> CodeAction -unwrapCodeActionResolveData c@CodeAction{_data_ = Just x} - | Success ORD {value = v} <- fromJSON x = c & L.data_ ?~ v --- If we can't successfully decode the value as a ORD type than --- we just return the codeAction untouched. -unwrapCodeActionResolveData c = c - --- |Allow plugins to "own" resolve data, allowing only them to be queried for --- the resolve action. This design has added flexibility at the cost of nested --- Value types -data OwnedResolveData = ORD { - owner :: PluginId -, value :: Value -} deriving (Generic, Show) -instance ToJSON OwnedResolveData -instance FromJSON OwnedResolveData pluginResolverResponsible :: Maybe Value -> PluginDescriptor c -> Bool pluginResolverResponsible (Just val) pluginDesc = case fromJSON val of - (Success (ORD o _)) -> pluginId pluginDesc == o - _ -> True -- We want to fail open in case our resolver is not using the ORD type --- This is a wierd case, because anything that gets resolved should have a data --- field, but in any case, failing open is safe enough. -pluginResolverResponsible Nothing _ = True + (Success (PRD o _ _)) -> pluginId pluginDesc == o + _ -> False -- If we can't decode the data, something is seriously wrong +-- If there is no data stored, than we can't resolve it +pluginResolverResponsible Nothing _ = False From b1d666e7d7a56d5039f27c662d1619dc3ca05260 Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Fri, 7 Jul 2023 20:38:57 +0300 Subject: [PATCH 02/12] Separate resolve logic from method handling --- .../src/Development/IDE/Plugin/Completions.hs | 12 +- ghcide/src/Development/IDE/Plugin/HLS.hs | 64 ++++++++ hls-plugin-api/src/Ide/Plugin/Resolve.hs | 107 +++++++++---- hls-plugin-api/src/Ide/Types.hs | 146 +++++++++--------- .../hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 22 ++- .../src/Ide/Plugin/OverloadedRecordDot.hs | 39 +++-- 6 files changed, 247 insertions(+), 143 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 2a1841131c..9bcf77a2fb 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -66,7 +66,7 @@ descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeSta descriptor recorder plId = (defaultPluginDescriptor plId) { pluginRules = produceCompletions recorder , pluginHandlers = mkPluginHandler SMethod_TextDocumentCompletion getCompletionsLSP - <> mkPluginHandler SMethod_CompletionItemResolve resolveCompletion + , pluginResolveHandlers = mkResolveHandler SMethod_CompletionItemResolve resolveCompletion , pluginConfigDescriptor = defaultConfigDescriptor {configCustomConfig = mkCustomConfig properties} , pluginPriority = ghcideCompletionsPluginPriority } @@ -119,11 +119,9 @@ dropListFromImportDecl iDecl = let f x = x in f <$> iDecl -resolveCompletion :: IdeState -> PluginId -> CompletionItem -> LSP.LspM Config (Either ResponseError CompletionItem) -resolveCompletion ide _ comp@CompletionItem{_detail,_documentation,_data_} - | Just resolveData <- _data_ - , Success (CompletionResolveData uri needType (NameDetails mod occ)) <- fromJSON resolveData - , Just file <- uriToNormalizedFilePath $ toNormalizedUri uri +resolveCompletion :: ResolveFunction IdeState CompletionResolveData 'Method_CompletionItemResolve +resolveCompletion ide _pid comp@CompletionItem{_detail,_documentation,_data_} uri (CompletionResolveData _ needType (NameDetails mod occ)) + | Just file <- uriToNormalizedFilePath $ toNormalizedUri uri = liftIO $ runIdeAction "Completion resolve" (shakeExtras ide) $ do msess <- useWithStaleFast GhcSessionDeps file case msess of @@ -160,7 +158,7 @@ resolveCompletion ide _ comp@CompletionItem{_detail,_documentation,_data_} where stripForall ty = case splitForAllTyCoVars ty of (_,res) -> res -resolveCompletion _ _ comp = pure (Right comp) +resolveCompletion _ _ _ _ _ = pure $ Left $ ResponseError (InR ErrorCodes_InvalidParams) "Unable to get normalized file path for url" Nothing -- | Generate code actions. getCompletionsLSP diff --git a/ghcide/src/Development/IDE/Plugin/HLS.hs b/ghcide/src/Development/IDE/Plugin/HLS.hs index c134a26045..ad8054cad3 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS.hs @@ -54,12 +54,16 @@ data Log = LogPluginError PluginId ResponseError | LogNoPluginForMethod (Some SMethod) | LogInvalidCommandIdentifier + | LogNoResolveData + | LogParseError String (Maybe A.Value) instance Pretty Log where pretty = \case LogPluginError (PluginId pId) err -> pretty pId <> ":" <+> prettyResponseError err LogNoPluginForMethod (Some method) -> "No plugin enabled for " <> pretty (show method) LogInvalidCommandIdentifier-> "Invalid command identifier" + LogNoResolveData -> "No resolve data in resolve request" + LogParseError msg value -> "Error while parsing: " <> pretty msg <> ", value = " <> viaShow value instance Show Log where show = renderString . layoutCompact . pretty @@ -99,11 +103,19 @@ logAndReturnError recorder p errCode msg = do logWith recorder Warning $ LogPluginError p err pure $ Left err +-- | Build a ResponseError and log it before returning to the caller +logAndReturnError' :: Recorder (WithPriority Log) -> (LSPErrorCodes |? ErrorCodes) -> Log -> LSP.LspT Config IO (Either ResponseError a) +logAndReturnError' recorder errCode msg = do + let err = ResponseError errCode (T.pack $ show msg) Nothing + logWith recorder Warning $ msg + pure $ Left err + -- | Map a set of plugins to the underlying ghcide engine. asGhcIdePlugin :: Recorder (WithPriority Log) -> IdePlugins IdeState -> Plugin Config asGhcIdePlugin recorder (IdePlugins ls) = mkPlugin rulesPlugins HLS.pluginRules <> mkPlugin (executeCommandPlugins recorder) HLS.pluginCommands <> + mkPlugin (extensibleResolvePlugins recorder) id <> mkPlugin (extensiblePlugins recorder) id <> mkPlugin (extensibleNotificationPlugins recorder) id <> mkPluginFromDescriptor dynFlagsPlugins HLS.pluginModifyDynflags @@ -201,6 +213,46 @@ executeCommandHandlers recorder ecs = requestHandler SMethod_WorkspaceExecuteCom -- --------------------------------------------------------------------- +extensibleResolvePlugins :: Recorder (WithPriority Log) -> [(PluginId, PluginDescriptor IdeState)] -> Plugin Config +extensibleResolvePlugins recorder xs = mempty { P.pluginHandlers = handlers } + where + IdeResolveHandlers handlers' = foldMap bakePluginId xs + bakePluginId :: (PluginId, PluginDescriptor IdeState) -> IdeResolveHandlers + bakePluginId (pid,pluginDesc) = IdeResolveHandlers $ DMap.map + (\f -> IdeResolveHandler [(pid,pluginDesc,f)]) + hs + where + PluginResolveHandlers hs = HLS.pluginResolveHandlers pluginDesc + handlers = mconcat $ do + (ResolveMethod m :=> IdeResolveHandler fs') <- DMap.assocs handlers' + pure $ requestHandler m $ \ide params -> do + case A.fromJSON <$> (params ^. L.data_) of + (Just (A.Success (HLS.PluginResolveData owner uri value) )) -> do + -- Only run plugins that are allowed to run on this request + let fs = filter (\(pid,_ , _) -> pid == owner) fs' + -- Clients generally don't display ResponseErrors so instead we log any that we come across + case nonEmpty fs of + Nothing -> do + logWith recorder Warning (LogNoPluginForMethod $ Some m) + let err = ResponseError (InR ErrorCodes_InvalidRequest) msg Nothing + msg = pluginNotEnabled m fs' + return $ Left err + Just ((pid, _, ResolveHandler handler) NE.:| _) -> do + let msg e pid = "Exception in plugin " <> T.pack (show pid) <> " while processing " <> T.pack (show m) <> ": " <> T.pack (show e) + case A.fromJSON value of + A.Success decodedValue -> do + otTracedProvider pid (fromString $ show m) $ do + handler ide pid params uri decodedValue + `catchAny` (\e -> pure $ Left $ ResponseError (InR ErrorCodes_InternalError) (msg e pid) Nothing) + A.Error err -> do + logAndReturnError' recorder (InR ErrorCodes_ParseError) (LogParseError err (Just value)) + + Nothing -> do + logAndReturnError' recorder (InR ErrorCodes_InvalidParams) LogNoResolveData + (Just (A.Error str)) -> do + logAndReturnError' recorder (InR ErrorCodes_ParseError) (LogParseError str (params ^. L.data_)) +-- --------------------------------------------------------------------- + extensiblePlugins :: Recorder (WithPriority Log) -> [(PluginId, PluginDescriptor IdeState)] -> Plugin Config extensiblePlugins recorder xs = mempty { P.pluginHandlers = handlers } where @@ -286,6 +338,10 @@ combineErrors xs = ResponseError (InR ErrorCodes_InternalError) (T.pack (show x newtype IdeHandler (m :: Method ClientToServer Request) = IdeHandler [(PluginId, PluginDescriptor IdeState, IdeState -> MessageParams m -> LSP.LspM Config (NonEmpty (Either ResponseError (MessageResult m))))] +newtype IdeResolveHandler (m :: Method ClientToServer Request) + = IdeResolveHandler [(PluginId, PluginDescriptor IdeState, PluginResolveHandler IdeState m)] + + -- | Combine the 'PluginHandler' for all plugins newtype IdeNotificationHandler (m :: Method ClientToServer Notification) = IdeNotificationHandler [(PluginId, PluginDescriptor IdeState, IdeState -> VFS -> MessageParams m -> LSP.LspM Config ())] @@ -293,6 +349,7 @@ newtype IdeNotificationHandler (m :: Method ClientToServer Notification) -- | Combine the 'PluginHandlers' for all plugins newtype IdeHandlers = IdeHandlers (DMap IdeMethod IdeHandler) +newtype IdeResolveHandlers = IdeResolveHandlers (DMap ResolveMethod IdeResolveHandler) newtype IdeNotificationHandlers = IdeNotificationHandlers (DMap IdeNotification IdeNotificationHandler) instance Semigroup IdeHandlers where @@ -302,6 +359,13 @@ instance Semigroup IdeHandlers where instance Monoid IdeHandlers where mempty = IdeHandlers mempty +instance Semigroup IdeResolveHandlers where + (IdeResolveHandlers a) <> (IdeResolveHandlers b) = IdeResolveHandlers $ DMap.unionWithKey go a b + where + go _ (IdeResolveHandler a) (IdeResolveHandler b) = IdeResolveHandler (a <> b) +instance Monoid IdeResolveHandlers where + mempty = IdeResolveHandlers mempty + instance Semigroup IdeNotificationHandlers where (IdeNotificationHandlers a) <> (IdeNotificationHandlers b) = IdeNotificationHandlers $ DMap.unionWithKey go a b where diff --git a/hls-plugin-api/src/Ide/Plugin/Resolve.hs b/hls-plugin-api/src/Ide/Plugin/Resolve.hs index 7e477e180b..7d2fe74d4b 100644 --- a/hls-plugin-api/src/Ide/Plugin/Resolve.hs +++ b/hls-plugin-api/src/Ide/Plugin/Resolve.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} @@ -7,12 +8,15 @@ module Ide.Plugin.Resolve (mkCodeActionHandlerWithResolve, mkCodeActionWithResolveAndCommand) where -import Control.Lens (_Just, (&), (.~), (?~), (^?)) +import Control.Lens (_Just, (&), (.~), (?~), (^.), + (^?)) import Control.Monad.Trans.Class (MonadTrans (lift)) -import Control.Monad.Trans.Except (ExceptT (..), runExceptT) -import Data.Aeson (ToJSON (toJSON)) -import qualified Data.Aeson +import Control.Monad.Trans.Except (ExceptT (..), runExceptT, + throwE) +import qualified Data.Aeson as A import Data.Row ((.!)) +import qualified Data.Text as T +import GHC.Generics (Generic) import Ide.Types import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Message @@ -29,9 +33,10 @@ import Language.LSP.Server (LspM, LspT, -- have codeAction resolve support. This means you don't have to check whether -- the client supports resolve and act accordingly in your own providers. mkCodeActionHandlerWithResolve - :: forall ideState. (ideState -> PluginId -> CodeActionParams -> LspM Config (Either ResponseError ([Command |? CodeAction] |? Null))) - -> (ideState -> PluginId -> CodeAction -> LspM Config (Either ResponseError CodeAction)) - -> PluginHandlers ideState + :: forall ideState a. (A.FromJSON a) => + (ideState -> PluginId -> CodeActionParams -> LspM Config (Either ResponseError ([Command |? CodeAction] |? Null))) + -> (ideState -> PluginId -> CodeAction -> Uri -> a -> LspM Config (Either ResponseError CodeAction)) + -> (PluginHandlers ideState, PluginResolveHandlers ideState) mkCodeActionHandlerWithResolve codeActionMethod codeResolveMethod = let newCodeActionMethod ideState pid params = runExceptT $ do codeActionReturn <- ExceptT $ codeActionMethod ideState pid params @@ -42,16 +47,24 @@ mkCodeActionHandlerWithResolve codeActionMethod codeResolveMethod = -- resolve data type to allow the server to know who to send the resolve request to supportsCodeActionResolve caps -> pure $ InL ls --This is the actual part where we call resolveCodeAction which fills in the edit data for the client - | otherwise -> InL <$> traverse (resolveCodeAction ideState pid) ls - in mkPluginHandler SMethod_TextDocumentCodeAction newCodeActionMethod - <> mkPluginHandler SMethod_CodeActionResolve codeResolveMethod + | otherwise -> InL <$> traverse (resolveCodeAction (params ^. L.textDocument . L.uri) ideState pid) ls + in (mkPluginHandler SMethod_TextDocumentCodeAction newCodeActionMethod + , mkResolveHandler SMethod_CodeActionResolve codeResolveMethod) where dropData :: CodeAction -> CodeAction dropData ca = ca & L.data_ .~ Nothing - resolveCodeAction :: ideState -> PluginId -> (Command |? CodeAction) -> ExceptT ResponseError (LspT Config IO) (Command |? CodeAction) - resolveCodeAction _ideState _pid c@(InL _) = pure c - resolveCodeAction ideState pid (InR codeAction) = - fmap (InR . dropData) $ ExceptT $ codeResolveMethod ideState pid codeAction + resolveCodeAction :: Uri -> ideState -> PluginId -> (Command |? CodeAction) -> ExceptT ResponseError (LspT Config IO) (Command |? CodeAction) + resolveCodeAction _uri _ideState _plId c@(InL _) = pure c + resolveCodeAction uri ideState pid (InR codeAction@CodeAction{_data_=Just value}) = do + case A.fromJSON value of + A.Error err -> throwE $ parseError (Just value) (T.pack err) + A.Success innerValueDecoded -> do + resolveResult <- ExceptT $ codeResolveMethod ideState pid codeAction uri innerValueDecoded + case resolveResult of + CodeAction {_edit = Just _ } -> do + pure $ InR $ dropData resolveResult + _ -> throwE $ invalidParamsError "Returned CodeAction has no data field" + resolveCodeAction _ _ _ (InR CodeAction{_data_=Nothing}) = throwE $ invalidParamsError "CodeAction has no data field" -- |When provided with both a codeAction provider that includes both a command -- and a data field and a resolve provider, this function creates a handler that @@ -59,11 +72,11 @@ mkCodeActionHandlerWithResolve codeActionMethod codeResolveMethod = -- support. This means you don't have to check whether the client supports resolve -- and act accordingly in your own providers. mkCodeActionWithResolveAndCommand - :: forall ideState. + :: forall ideState a. (A.FromJSON a) => PluginId -> (ideState -> PluginId -> CodeActionParams -> LspM Config (Either ResponseError ([Command |? CodeAction] |? Null))) - -> (ideState -> PluginId -> CodeAction -> LspM Config (Either ResponseError CodeAction)) - -> ([PluginCommand ideState], PluginHandlers ideState) + -> (ideState -> PluginId -> CodeAction -> Uri -> a -> LspM Config (Either ResponseError CodeAction)) + -> ([PluginCommand ideState], PluginHandlers ideState, PluginResolveHandlers ideState) mkCodeActionWithResolveAndCommand plId codeActionMethod codeResolveMethod = let newCodeActionMethod ideState pid params = runExceptT $ do codeActionReturn <- ExceptT $ codeActionMethod ideState pid params @@ -76,29 +89,51 @@ mkCodeActionWithResolveAndCommand plId codeActionMethod codeResolveMethod = pure $ InL ls -- If they do not we will drop the data field, in addition we will populate the command -- field with our command to execute the resolve, with the whole code action as it's argument. - | otherwise -> pure $ InL $ moveDataToCommand <$> ls - in ([PluginCommand "codeActionResolve" "Executes resolve for code action" (executeResolveCmd plId codeResolveMethod)], - mkPluginHandler SMethod_TextDocumentCodeAction newCodeActionMethod - <> mkPluginHandler SMethod_CodeActionResolve codeResolveMethod) - where moveDataToCommand :: Command |? CodeAction -> Command |? CodeAction - moveDataToCommand ca = - let dat = toJSON <$> ca ^? _R -- We need to take the whole codeAction + | otherwise -> pure $ InL $ moveDataToCommand (params ^. L.textDocument . L.uri) <$> ls + in ([PluginCommand "codeActionResolve" "Executes resolve for code action" (executeResolveCmd (codeResolveMethod))], + mkPluginHandler SMethod_TextDocumentCodeAction newCodeActionMethod, + mkResolveHandler SMethod_CodeActionResolve codeResolveMethod) + where moveDataToCommand :: Uri -> Command |? CodeAction -> Command |? CodeAction + moveDataToCommand uri ca = + let dat = A.toJSON . wrapWithURI uri <$> ca ^? _R -- We need to take the whole codeAction -- And put it in the argument for the Command, that way we can later -- pas it to the resolve handler (which expects a whole code action) cmd = mkLspCommand plId (CommandId "codeActionResolve") "Execute Code Action" (pure <$> dat) in ca & _R . L.data_ .~ Nothing -- Set the data field to nothing & _R . L.command ?~ cmd -- And set the command to our previously created command - executeResolveCmd :: PluginId -> PluginMethodHandler ideState Method_CodeActionResolve -> CommandFunction ideState CodeAction - executeResolveCmd pluginId resolveProvider ideState ca = do + wrapWithURI :: Uri -> CodeAction -> CodeAction + wrapWithURI uri codeAction = + codeAction & L.data_ .~ (A.toJSON .WithURI uri <$> data_) + where data_ = codeAction ^? L.data_ . _Just + executeResolveCmd :: (ideState -> PluginId -> CodeAction -> Uri -> a -> LspM Config (Either ResponseError CodeAction))-> CommandFunction ideState CodeAction + executeResolveCmd resolveProvider ideState ca@CodeAction{_data_=Just value} = do withIndefiniteProgress "Executing code action..." Cancellable $ do - resolveResult <- resolveProvider ideState pluginId ca - case resolveResult of - Right CodeAction {_edit = Just wedits } -> do - _ <- sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedits) (\_ -> pure ()) - pure $ Right Data.Aeson.Null - Right _ -> pure $ Left $ responseError "No edit in CodeAction" - Left err -> pure $ Left err + case A.fromJSON value of + A.Error err -> pure $ Left $ parseError (Just value) (T.pack err) + A.Success (WithURI uri innerValue) -> do + case A.fromJSON innerValue of + A.Error err -> pure $ Left $ parseError (Just value) (T.pack err) + A.Success innerValueDecoded -> do + resolveResult <- resolveProvider ideState plId ca uri innerValueDecoded + case resolveResult of + Right CodeAction {_edit = Just wedits } -> do + _ <- sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedits) (\_ -> pure ()) + pure $ Right A.Null + Right _ -> pure $ Left $ invalidParamsError "Returned CodeAction has no data field" + Left err -> pure $ Left err + executeResolveCmd _ _ CodeAction{_data_= value} = pure $ Left $ invalidParamsError ("CodeAction data field empty: " <> (T.pack $ show value)) + + +-- |Allow plugins to "own" resolve data, allowing only them to be queried for +-- the resolve action. This design has added flexibility at the cost of nested +-- Value types +data WithURI = WithURI { + _uri :: Uri +, _value :: A.Value +} deriving (Generic, Show) +instance A.ToJSON WithURI +instance A.FromJSON WithURI supportsCodeActionResolve :: ClientCapabilities -> Bool supportsCodeActionResolve caps = @@ -106,3 +141,9 @@ supportsCodeActionResolve caps = && case caps ^? L.textDocument . _Just . L.codeAction . _Just . L.resolveSupport . _Just of Just row -> "edit" `elem` row .! #properties _ -> False + +invalidParamsError :: T.Text -> ResponseError +invalidParamsError msg = ResponseError (InR ErrorCodes_InternalError) ("Ide.Plugin.Resolve: " <> msg) Nothing + +parseError :: Maybe A.Value -> T.Text -> ResponseError +parseError value errMsg = ResponseError (InR ErrorCodes_InternalError) ("Ide.Plugin.Resolve: Error parsing value:"<> (T.pack $ show value) <> " Error: "<> errMsg) Nothing diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index 195b6b2c2b..ce4f793023 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -49,6 +49,11 @@ module Ide.Types , responseError , lookupCommandProvider , PluginResolveData(..) +, PluginResolveHandlers(..) +, PluginResolveHandler(..) +, ResolveFunction +, ResolveMethod(..) +, mkResolveHandler ) where @@ -61,7 +66,7 @@ import System.Posix.Signals #endif import Control.Applicative ((<|>)) import Control.Arrow ((&&&)) -import Control.Lens (_Just, (.~), (?~), (^.), (^?)) +import Control.Lens (_Just, (.~), (^.), (^?)) import Data.Aeson hiding (Null, defaultOptions) import Data.Default import Data.Dependent.Map (DMap) @@ -262,6 +267,7 @@ data PluginDescriptor (ideState :: *) = , pluginRules :: !(Rules ()) , pluginCommands :: ![PluginCommand ideState] , pluginHandlers :: PluginHandlers ideState + , pluginResolveHandlers:: PluginResolveHandlers ideState , pluginConfigDescriptor :: ConfigDescriptor , pluginNotificationHandlers :: PluginNotificationHandlers ideState , pluginModifyDynflags :: DynFlagsModifications @@ -405,11 +411,6 @@ instance PluginMethod Request Method_TextDocumentCodeAction where where uri = msgParams ^. L.textDocument . L.uri -instance PluginMethod Request Method_CodeActionResolve where - pluginEnabled _ msgParams pluginDesc config = - pluginResolverResponsible (msgParams ^. L.data_) pluginDesc - && pluginEnabledConfig plcCodeActionsOn (configForPlugin config pluginDesc) - instance PluginMethod Request Method_TextDocumentDefinition where pluginEnabled _ msgParams pluginDesc _ = pluginResponsible uri pluginDesc @@ -444,11 +445,6 @@ instance PluginMethod Request Method_TextDocumentCodeLens where where uri = msgParams ^. L.textDocument . L.uri -instance PluginMethod Request Method_CodeLensResolve where - pluginEnabled _ msgParams pluginDesc config = - pluginResolverResponsible (msgParams ^. L.data_) pluginDesc - && pluginEnabledConfig plcCodeActionsOn (configForPlugin config pluginDesc) - instance PluginMethod Request Method_TextDocumentRename where pluginEnabled _ msgParams pluginDesc config = pluginResponsible uri pluginDesc && pluginEnabledConfig plcRenameOn (configForPlugin config pluginDesc) @@ -466,11 +462,6 @@ instance PluginMethod Request Method_TextDocumentDocumentSymbol where where uri = msgParams ^. L.textDocument . L.uri -instance PluginMethod Request Method_CompletionItemResolve where - pluginEnabled _ msgParams pluginDesc config = - pluginResolverResponsible (msgParams ^. L.data_) pluginDesc - && pluginEnabledConfig plcCompletionOn (configForPlugin config pluginDesc) - instance PluginMethod Request Method_TextDocumentCompletion where pluginEnabled _ msgParams pluginDesc config = pluginResponsible uri pluginDesc && pluginEnabledConfig plcCompletionOn (configForPlugin config pluginDesc) @@ -549,10 +540,6 @@ instance PluginRequestMethod Method_TextDocumentCodeAction where , Just caKind <- ca ^. L.kind = any (\k -> k `codeActionKindSubsumes` caKind) allowed | otherwise = False -instance PluginRequestMethod Method_CodeActionResolve where - -- Resolve method should only ever get one response - combineResponses _ _ _ _ (x :| _) = x - instance PluginRequestMethod Method_TextDocumentDefinition where combineResponses _ _ _ _ (x :| _) = x @@ -570,9 +557,6 @@ instance PluginRequestMethod Method_WorkspaceSymbol where instance PluginRequestMethod Method_TextDocumentCodeLens where -instance PluginRequestMethod Method_CodeLensResolve where - -- A resolve request should only ever get one response - combineResponses _ _ _ _ (x :| _) = x instance PluginRequestMethod Method_TextDocumentRename where @@ -614,10 +598,6 @@ instance PluginRequestMethod Method_TextDocumentDocumentSymbol where si = SymbolInformation name' (ds ^. L.kind) Nothing parent (ds ^. L.deprecated) loc in [si] <> children' -instance PluginRequestMethod Method_CompletionItemResolve where - -- resolve method's should only ever get one response - combineResponses _ _ _ _ (x :| _) = x - instance PluginRequestMethod Method_TextDocumentCompletion where combineResponses _ conf _ _ (toList -> xs) = snd $ consumeCompletionResponse limit $ combine xs where @@ -791,14 +771,6 @@ mkPluginHandler m f = PluginHandlers $ DMap.singleton (IdeMethod m) (PluginHandl f' SMethod_TextDocumentCompletion pid ide params@CompletionParams{_textDocument=TextDocumentIdentifier {_uri}} = pure . fmap (wrapCompletions pid _uri) <$> f ide pid params - -- If resolve handlers aren't declared with mkPluginHandler we won't need these here anymore - f' SMethod_CodeActionResolve pid ide params = - pure <$> f ide pid (unwrapResolveData params) - f' SMethod_CodeLensResolve pid ide params = - pure <$> f ide pid (unwrapResolveData params) - f' SMethod_CompletionItemResolve pid ide params = - pure <$> f ide pid (unwrapResolveData params) - -- This is the default case for all other methods f' _ pid ide params = pure <$> f ide pid params @@ -817,30 +789,6 @@ mkPluginHandler m f = PluginHandlers $ DMap.singleton (IdeMethod m) (PluginHandl InR $ InL $ cl & L.items .~ (wrapResolveData pid uri <$> _items) wrapCompletions _ _ (InR (InR r)) = InR $ InR r -wrapResolveData :: L.HasData_ a (Maybe Value) => PluginId -> Uri -> a -> a -wrapResolveData pid uri hasData = - hasData & L.data_ .~ (toJSON .PRD pid uri <$> data_) - where data_ = hasData ^? L.data_ . _Just - -unwrapResolveData :: L.HasData_ a (Maybe Value) => a -> a -unwrapResolveData hasData - | Just x <- hasData ^. L.data_ - , Success PRD {value = v} <- fromJSON x = hasData & L.data_ ?~ v --- If we can't successfully decode the value as a ORD type than --- we just return the type untouched? -unwrapResolveData c = c - --- |Allow plugins to "own" resolve data, allowing only them to be queried for --- the resolve action. This design has added flexibility at the cost of nested --- Value types -data PluginResolveData = PRD { - owner :: PluginId -, uri :: Uri -, value :: Value -} deriving (Generic, Show) -instance ToJSON PluginResolveData -instance FromJSON PluginResolveData - -- | Make a handler for plugins with no extra data mkPluginNotificationHandler :: PluginNotificationMethod m @@ -872,6 +820,7 @@ defaultPluginDescriptor plId = mempty mempty mempty + mempty defaultConfigDescriptor mempty mempty @@ -892,6 +841,7 @@ defaultCabalPluginDescriptor plId = mempty mempty mempty + mempty defaultConfigDescriptor mempty mempty @@ -918,17 +868,74 @@ type CommandFunction ideState a -- --------------------------------------------------------------------- +newtype PluginResolveHandlers ideState = PluginResolveHandlers (DMap ResolveMethod (PluginResolveHandler ideState)) +instance Semigroup (PluginResolveHandlers a) where + (PluginResolveHandlers a) <> (PluginResolveHandlers b) = PluginResolveHandlers $ DMap.union a b + +instance Monoid (PluginResolveHandlers a) where + mempty = PluginResolveHandlers mempty + +class (HasTracing (MessageParams m), L.HasData_ (MessageParams m) (Maybe Value)) => PluginResolveMethod (m :: Method ClientToServer Request) where +instance PluginResolveMethod Method_CodeActionResolve +instance PluginResolveMethod Method_CodeLensResolve +instance PluginResolveMethod Method_CompletionItemResolve +instance PluginResolveMethod Method_DocumentLinkResolve +instance PluginResolveMethod Method_InlayHintResolve +instance PluginResolveMethod Method_WorkspaceSymbolResolve + + +data ResolveMethod (m :: Method ClientToServer Request) = PluginResolveMethod m => ResolveMethod (SMethod m) +instance GEq ResolveMethod where + geq (ResolveMethod a) (ResolveMethod b) = geq a b +instance GCompare ResolveMethod where + gcompare (ResolveMethod a) (ResolveMethod b) = gcompare a b + -- Will something like this work? -type ResolveFunction ideState a m - = ideState +data PluginResolveHandler ideState (m :: Method ClientToServer Request) + = forall a. (FromJSON a) => ResolveHandler + (ideState + -> PluginId + -> MessageParams m + -> Uri + -> a + -> LspM Config (Either ResponseError (MessageResult m))) + +type ResolveFunction ideState a (m :: Method ClientToServer Request) = + ideState -> PluginId -> MessageParams m -> Uri -> a -> LspM Config (Either ResponseError (MessageResult m)) +-- | Make a handler for plugins with no extra data +mkResolveHandler + :: forall ideState a m. (FromJSON a, PluginResolveMethod m) + => SClientMethod m + -> (ideState + ->PluginId + -> MessageParams m + -> Uri + -> a + -> LspM Config (Either ResponseError (MessageResult m))) + -> PluginResolveHandlers ideState +mkResolveHandler m f = PluginResolveHandlers $ DMap.singleton (ResolveMethod m) (ResolveHandler f) +wrapResolveData :: L.HasData_ a (Maybe Value) => PluginId -> Uri -> a -> a +wrapResolveData pid uri hasData = + hasData & L.data_ .~ (toJSON .PluginResolveData pid uri <$> data_) + where data_ = hasData ^? L.data_ . _Just +-- |Allow plugins to "own" resolve data, allowing only them to be queried for +-- the resolve action. This design has added flexibility at the cost of nested +-- Value types +data PluginResolveData = PluginResolveData { + resolvePlugin :: PluginId +, resolveURI :: Uri +, resolveValue :: Value +} deriving (Generic, Show) +instance ToJSON PluginResolveData +instance FromJSON PluginResolveData newtype PluginId = PluginId T.Text deriving (Show, Read, Eq, Ord) deriving newtype (ToJSON, FromJSON, Hashable) @@ -1031,11 +1038,16 @@ instance HasTracing WorkspaceSymbolParams where traceWithSpan sp (WorkspaceSymbolParams _ _ query) = setTag sp "query" (encodeUtf8 query) instance HasTracing CallHierarchyIncomingCallsParams instance HasTracing CallHierarchyOutgoingCallsParams -instance HasTracing CompletionItem + +-- Instances for resolve types instance HasTracing CodeAction instance HasTracing CodeLens +instance HasTracing CompletionItem +instance HasTracing DocumentLink +instance HasTracing InlayHint +instance HasTracing WorkspaceSymbol -- --------------------------------------------------------------------- - +--Experimental resolve refactoring {-# NOINLINE pROCESS_ID #-} pROCESS_ID :: T.Text pROCESS_ID = unsafePerformIO getPid @@ -1068,11 +1080,3 @@ getProcessID = fromIntegral <$> P.getProcessID installSigUsr1Handler h = void $ installHandler sigUSR1 (Catch h) Nothing #endif - -pluginResolverResponsible :: Maybe Value -> PluginDescriptor c -> Bool -pluginResolverResponsible (Just val) pluginDesc = - case fromJSON val of - (Success (PRD o _ _)) -> pluginId pluginDesc == o - _ -> False -- If we can't decode the data, something is seriously wrong --- If there is no data stored, than we can't resolve it -pluginResolverResponsible Nothing _ = False diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 4faefa7a24..1842e9bf95 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -117,6 +117,7 @@ import qualified Refact.Fixity as Refact import Ide.Plugin.Config hiding (Config) import Ide.Plugin.Properties +import Ide.Plugin.Resolve import Ide.PluginUtils import Ide.Types hiding (Config) @@ -188,11 +189,12 @@ fromStrictMaybe Strict.Nothing = Nothing descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState descriptor recorder plId = - let (pluginCommands, pluginHandlers) = mkCodeActionWithResolveAndCommand plId codeActionProvider (resolveProvider recorder) + let (pluginCommands, pluginHandlers, resolveHandlers) = mkCodeActionWithResolveAndCommand plId codeActionProvider (resolveProvider recorder) in (defaultPluginDescriptor plId) { pluginRules = rules recorder plId , pluginCommands = pluginCommands , pluginHandlers = pluginHandlers + , pluginResolveHandlers = resolveHandlers , pluginConfigDescriptor = defaultConfigDescriptor { configHasDiagnostics = True , configCustomConfig = mkCustomConfig properties @@ -434,24 +436,20 @@ codeActionProvider ideState _pluginId (CodeActionParams _ _ documentId _ context diags = context ^. LSP.diagnostics -resolveProvider :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_CodeActionResolve -resolveProvider recorder ideState _pluginId ca@CodeAction {_data_ = Just data_} = pluginResponse $ do - case fromJSON data_ of - (Success (AA verTxtDocId@(VersionedTextDocumentIdentifier uri _))) -> do - file <- getNormalizedFilePath uri +resolveProvider :: Recorder (WithPriority Log) -> ResolveFunction IdeState HlintResolveCommands Method_CodeActionResolve +resolveProvider recorder ideState _plId ca uri resolveValue = pluginResponse $ do + file <- getNormalizedFilePath uri + case resolveValue of + (AA verTxtDocId) -> do edit <- ExceptT $ liftIO $ applyHint recorder ideState file Nothing verTxtDocId pure $ ca & LSP.edit ?~ edit - (Success (AO verTxtDocId@(VersionedTextDocumentIdentifier uri _) pos hintTitle)) -> do + (AO verTxtDocId pos hintTitle) -> do let oneHint = OneHint pos hintTitle - file <- getNormalizedFilePath uri edit <- ExceptT $ liftIO $ applyHint recorder ideState file (Just oneHint) verTxtDocId pure $ ca & LSP.edit ?~ edit - (Success (IH verTxtDocId@(VersionedTextDocumentIdentifier uri _) hintTitle )) -> do - file <- getNormalizedFilePath uri + (IH verTxtDocId hintTitle ) -> do edit <- ExceptT $ liftIO $ ignoreHint recorder ideState file verTxtDocId hintTitle pure $ ca & LSP.edit ?~ edit - Error s-> throwE ("JSON decoding error: " <> s) -resolveProvider _ _ _ _ = pluginResponse $ throwE "CodeAction with no data field" -- | Convert a hlint diagnostic into an apply and an ignore code action -- if applicable diff --git a/plugins/hls-overloaded-record-dot-plugin/src/Ide/Plugin/OverloadedRecordDot.hs b/plugins/hls-overloaded-record-dot-plugin/src/Ide/Plugin/OverloadedRecordDot.hs index 7a743bcdd5..9aef0beb11 100644 --- a/plugins/hls-overloaded-record-dot-plugin/src/Ide/Plugin/OverloadedRecordDot.hs +++ b/plugins/hls-overloaded-record-dot-plugin/src/Ide/Plugin/OverloadedRecordDot.hs @@ -76,14 +76,15 @@ import Development.IDE.Types.Logger (Priority (..), import GHC.Generics (Generic) import Ide.Plugin.RangeMap (RangeMap) import qualified Ide.Plugin.RangeMap as RangeMap +import Ide.Plugin.Resolve (mkCodeActionHandlerWithResolve) import Ide.PluginUtils (getNormalizedFilePath, handleMaybeM, pluginResponse) import Ide.Types (PluginDescriptor (..), PluginId (..), PluginMethodHandler, + ResolveFunction, defaultPluginDescriptor, - mkCodeActionHandlerWithResolve, mkPluginHandler) import Language.LSP.Protocol.Lens (HasChanges (changes)) import qualified Language.LSP.Protocol.Lens as L @@ -167,28 +168,26 @@ instance FromJSON ORDResolveData descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState -descriptor recorder plId = (defaultPluginDescriptor plId) - { pluginHandlers = - mkCodeActionHandlerWithResolve codeActionProvider resolveProvider +descriptor recorder plId = let (pluginHandler, resolveHandler) = mkCodeActionHandlerWithResolve codeActionProvider resolveProvider + in (defaultPluginDescriptor plId) + { pluginHandlers = pluginHandler + , pluginResolveHandlers = resolveHandler , pluginRules = collectRecSelsRule recorder } -resolveProvider :: PluginMethodHandler IdeState 'Method_CodeActionResolve -resolveProvider ideState pId ca@(CodeAction _ _ _ _ _ _ _ (Just resData)) = - pluginResponse $ do - case fromJSON resData of - Success (ORDRD uri int) -> do - nfp <- getNormalizedFilePath uri - CRSR _ crsDetails exts <- collectRecSelResult ideState nfp - pragma <- getFirstPragma pId ideState nfp - case IntMap.lookup int crsDetails of - Just rse -> pure $ ca {_edit = mkWorkspaceEdit uri rse exts pragma} - -- We need to throw a content modified error here, see - -- https://github.com/microsoft/language-server-protocol/issues/1738 - -- but we need fendor's plugin error response pr to make it - -- convenient to use here, so we will wait to do that till that's merged - _ -> throwE "Content Modified Error" - _ -> throwE "Unable to deserialize the data" +resolveProvider :: ResolveFunction IdeState ORDResolveData 'Method_CodeActionResolve +resolveProvider ideState plId ca uri (ORDRD _ int) = + pluginResponse $ do + nfp <- getNormalizedFilePath uri + CRSR _ crsDetails exts <- collectRecSelResult ideState nfp + pragma <- getFirstPragma plId ideState nfp + case IntMap.lookup int crsDetails of + Just rse -> pure $ ca {_edit = mkWorkspaceEdit uri rse exts pragma} + -- We need to throw a content modified error here, see + -- https://github.com/microsoft/language-server-protocol/issues/1738 + -- but we need fendor's plugin error response pr to make it + -- convenient to use here, so we will wait to do that till that's merged + _ -> throwE "Content Modified Error" codeActionProvider :: PluginMethodHandler IdeState 'Method_TextDocumentCodeAction codeActionProvider ideState pId (CodeActionParams _ _ caDocId caRange _) = From 7954c724331ebc8db7b013a12620867045caee85 Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Sat, 8 Jul 2023 17:31:16 +0300 Subject: [PATCH 03/12] Flag and test fixes --- ghcide/test/exe/Main.hs | 13 ++++++++----- hls-plugin-api/src/Ide/Plugin/Resolve.hs | 10 +++++----- test/functional/Completion.hs | 12 ++++++++---- 3 files changed, 21 insertions(+), 14 deletions(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 1b825e9d0d..208871a933 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -1571,7 +1571,7 @@ completionTest name src pos expected = testSessionWait name $ do [ (l, Just k, emptyToMaybe t, at) | (l,k,t,_,_,at) <- expected] forM_ (zip compls expected) $ \(item, (_,_,_,expectedSig, expectedDocs, _)) -> do CompletionItem{..} <- - if expectedSig || expectedDocs + if (expectedSig || expectedDocs) && isJust (item ^. L.data_) then do rsp <- request SMethod_CompletionItemResolve item case rsp ^. L.result of @@ -2081,10 +2081,13 @@ completionDocTests = _ <- waitForDiagnostics compls <- getCompletions doc pos rcompls <- forM compls $ \item -> do - rsp <- request SMethod_CompletionItemResolve item - case rsp ^. L.result of - Left err -> liftIO $ assertFailure ("completionItem/resolve failed with: " <> show err) - Right x -> pure x + if isJust (item ^. L.data_) + then do + rsp <- request SMethod_CompletionItemResolve item + case rsp ^. L.result of + Left err -> liftIO $ assertFailure ("completionItem/resolve failed with: " <> show err) + Right x -> pure x + else pure item let compls' = [ -- We ignore doc uris since it points to the local path which determined by specific machines case mn of diff --git a/hls-plugin-api/src/Ide/Plugin/Resolve.hs b/hls-plugin-api/src/Ide/Plugin/Resolve.hs index 7d2fe74d4b..4eae148d2f 100644 --- a/hls-plugin-api/src/Ide/Plugin/Resolve.hs +++ b/hls-plugin-api/src/Ide/Plugin/Resolve.hs @@ -5,7 +5,8 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -module Ide.Plugin.Resolve (mkCodeActionHandlerWithResolve, +module Ide.Plugin.Resolve +(mkCodeActionHandlerWithResolve, mkCodeActionWithResolveAndCommand) where import Control.Lens (_Just, (&), (.~), (?~), (^.), @@ -27,7 +28,7 @@ import Language.LSP.Server (LspM, LspT, sendRequest, withIndefiniteProgress) - -- |When provided with both a codeAction provider and an affiliated codeAction +-- |When provided with both a codeAction provider and an affiliated codeAction -- resolve provider, this function creates a handler that automatically uses -- your resolve provider to fill out you original codeAction if the client doesn't -- have codeAction resolve support. This means you don't have to check whether @@ -125,9 +126,8 @@ mkCodeActionWithResolveAndCommand plId codeActionMethod codeResolveMethod = executeResolveCmd _ _ CodeAction{_data_= value} = pure $ Left $ invalidParamsError ("CodeAction data field empty: " <> (T.pack $ show value)) --- |Allow plugins to "own" resolve data, allowing only them to be queried for --- the resolve action. This design has added flexibility at the cost of nested --- Value types +-- |To execute the resolve provider as a command, we need to additionally store +-- the URI that was provided to the original code action. data WithURI = WithURI { _uri :: Uri , _value :: A.Value diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs index 08280d4c4f..f5132a1b62 100644 --- a/test/functional/Completion.hs +++ b/test/functional/Completion.hs @@ -7,6 +7,7 @@ import Control.Lens hiding ((.=)) import Control.Monad import Data.Aeson (object, (.=)) import Data.Foldable (find) +import Data.Maybe (isJust) import Data.Row.Records (focus) import qualified Data.Text as T import Ide.Plugin.Config (maxCompletions) @@ -18,10 +19,13 @@ getResolvedCompletions :: TextDocumentIdentifier -> Position -> Session [Complet getResolvedCompletions doc pos = do xs <- getCompletions doc pos forM xs $ \item -> do - rsp <- request SMethod_CompletionItemResolve item - case rsp ^. result of - Left err -> liftIO $ assertFailure ("completionItem/resolve failed with: " <> show err) - Right x -> pure x + if isJust (item ^. detail) + then do + rsp <- request SMethod_CompletionItemResolve item + case rsp ^. result of + Left err -> liftIO $ assertFailure ("completionItem/resolve failed with: " <> show err) + Right x -> pure x + else pure item tests :: TestTree tests = testGroup "completions" [ From 2995b506b68f2b0fe625b6dba78208afc3791d3b Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Sat, 8 Jul 2023 18:05:29 +0300 Subject: [PATCH 04/12] Fix typo --- test/functional/Completion.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs index f5132a1b62..0511e75fcc 100644 --- a/test/functional/Completion.hs +++ b/test/functional/Completion.hs @@ -19,7 +19,7 @@ getResolvedCompletions :: TextDocumentIdentifier -> Position -> Session [Complet getResolvedCompletions doc pos = do xs <- getCompletions doc pos forM xs $ \item -> do - if isJust (item ^. detail) + if isJust (item ^. data_) then do rsp <- request SMethod_CompletionItemResolve item case rsp ^. result of From 84e0f3cb43f405f2f197e29b416e08f841cb0e90 Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Tue, 11 Jul 2023 18:51:49 +0300 Subject: [PATCH 05/12] Dump most of the special resolve logic --- .../src/Development/IDE/Plugin/Completions.hs | 2 +- ghcide/src/Development/IDE/Plugin/HLS.hs | 64 ------------- hls-plugin-api/src/Ide/Plugin/Resolve.hs | 12 +-- hls-plugin-api/src/Ide/Types.hs | 89 ++++++++++--------- .../hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 3 +- .../src/Ide/Plugin/OverloadedRecordDot.hs | 3 +- 6 files changed, 56 insertions(+), 117 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 9bcf77a2fb..4f6b8cfa97 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -66,7 +66,7 @@ descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeSta descriptor recorder plId = (defaultPluginDescriptor plId) { pluginRules = produceCompletions recorder , pluginHandlers = mkPluginHandler SMethod_TextDocumentCompletion getCompletionsLSP - , pluginResolveHandlers = mkResolveHandler SMethod_CompletionItemResolve resolveCompletion + <> mkResolveHandler SMethod_CompletionItemResolve resolveCompletion , pluginConfigDescriptor = defaultConfigDescriptor {configCustomConfig = mkCustomConfig properties} , pluginPriority = ghcideCompletionsPluginPriority } diff --git a/ghcide/src/Development/IDE/Plugin/HLS.hs b/ghcide/src/Development/IDE/Plugin/HLS.hs index ad8054cad3..c134a26045 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS.hs @@ -54,16 +54,12 @@ data Log = LogPluginError PluginId ResponseError | LogNoPluginForMethod (Some SMethod) | LogInvalidCommandIdentifier - | LogNoResolveData - | LogParseError String (Maybe A.Value) instance Pretty Log where pretty = \case LogPluginError (PluginId pId) err -> pretty pId <> ":" <+> prettyResponseError err LogNoPluginForMethod (Some method) -> "No plugin enabled for " <> pretty (show method) LogInvalidCommandIdentifier-> "Invalid command identifier" - LogNoResolveData -> "No resolve data in resolve request" - LogParseError msg value -> "Error while parsing: " <> pretty msg <> ", value = " <> viaShow value instance Show Log where show = renderString . layoutCompact . pretty @@ -103,19 +99,11 @@ logAndReturnError recorder p errCode msg = do logWith recorder Warning $ LogPluginError p err pure $ Left err --- | Build a ResponseError and log it before returning to the caller -logAndReturnError' :: Recorder (WithPriority Log) -> (LSPErrorCodes |? ErrorCodes) -> Log -> LSP.LspT Config IO (Either ResponseError a) -logAndReturnError' recorder errCode msg = do - let err = ResponseError errCode (T.pack $ show msg) Nothing - logWith recorder Warning $ msg - pure $ Left err - -- | Map a set of plugins to the underlying ghcide engine. asGhcIdePlugin :: Recorder (WithPriority Log) -> IdePlugins IdeState -> Plugin Config asGhcIdePlugin recorder (IdePlugins ls) = mkPlugin rulesPlugins HLS.pluginRules <> mkPlugin (executeCommandPlugins recorder) HLS.pluginCommands <> - mkPlugin (extensibleResolvePlugins recorder) id <> mkPlugin (extensiblePlugins recorder) id <> mkPlugin (extensibleNotificationPlugins recorder) id <> mkPluginFromDescriptor dynFlagsPlugins HLS.pluginModifyDynflags @@ -213,46 +201,6 @@ executeCommandHandlers recorder ecs = requestHandler SMethod_WorkspaceExecuteCom -- --------------------------------------------------------------------- -extensibleResolvePlugins :: Recorder (WithPriority Log) -> [(PluginId, PluginDescriptor IdeState)] -> Plugin Config -extensibleResolvePlugins recorder xs = mempty { P.pluginHandlers = handlers } - where - IdeResolveHandlers handlers' = foldMap bakePluginId xs - bakePluginId :: (PluginId, PluginDescriptor IdeState) -> IdeResolveHandlers - bakePluginId (pid,pluginDesc) = IdeResolveHandlers $ DMap.map - (\f -> IdeResolveHandler [(pid,pluginDesc,f)]) - hs - where - PluginResolveHandlers hs = HLS.pluginResolveHandlers pluginDesc - handlers = mconcat $ do - (ResolveMethod m :=> IdeResolveHandler fs') <- DMap.assocs handlers' - pure $ requestHandler m $ \ide params -> do - case A.fromJSON <$> (params ^. L.data_) of - (Just (A.Success (HLS.PluginResolveData owner uri value) )) -> do - -- Only run plugins that are allowed to run on this request - let fs = filter (\(pid,_ , _) -> pid == owner) fs' - -- Clients generally don't display ResponseErrors so instead we log any that we come across - case nonEmpty fs of - Nothing -> do - logWith recorder Warning (LogNoPluginForMethod $ Some m) - let err = ResponseError (InR ErrorCodes_InvalidRequest) msg Nothing - msg = pluginNotEnabled m fs' - return $ Left err - Just ((pid, _, ResolveHandler handler) NE.:| _) -> do - let msg e pid = "Exception in plugin " <> T.pack (show pid) <> " while processing " <> T.pack (show m) <> ": " <> T.pack (show e) - case A.fromJSON value of - A.Success decodedValue -> do - otTracedProvider pid (fromString $ show m) $ do - handler ide pid params uri decodedValue - `catchAny` (\e -> pure $ Left $ ResponseError (InR ErrorCodes_InternalError) (msg e pid) Nothing) - A.Error err -> do - logAndReturnError' recorder (InR ErrorCodes_ParseError) (LogParseError err (Just value)) - - Nothing -> do - logAndReturnError' recorder (InR ErrorCodes_InvalidParams) LogNoResolveData - (Just (A.Error str)) -> do - logAndReturnError' recorder (InR ErrorCodes_ParseError) (LogParseError str (params ^. L.data_)) --- --------------------------------------------------------------------- - extensiblePlugins :: Recorder (WithPriority Log) -> [(PluginId, PluginDescriptor IdeState)] -> Plugin Config extensiblePlugins recorder xs = mempty { P.pluginHandlers = handlers } where @@ -338,10 +286,6 @@ combineErrors xs = ResponseError (InR ErrorCodes_InternalError) (T.pack (show x newtype IdeHandler (m :: Method ClientToServer Request) = IdeHandler [(PluginId, PluginDescriptor IdeState, IdeState -> MessageParams m -> LSP.LspM Config (NonEmpty (Either ResponseError (MessageResult m))))] -newtype IdeResolveHandler (m :: Method ClientToServer Request) - = IdeResolveHandler [(PluginId, PluginDescriptor IdeState, PluginResolveHandler IdeState m)] - - -- | Combine the 'PluginHandler' for all plugins newtype IdeNotificationHandler (m :: Method ClientToServer Notification) = IdeNotificationHandler [(PluginId, PluginDescriptor IdeState, IdeState -> VFS -> MessageParams m -> LSP.LspM Config ())] @@ -349,7 +293,6 @@ newtype IdeNotificationHandler (m :: Method ClientToServer Notification) -- | Combine the 'PluginHandlers' for all plugins newtype IdeHandlers = IdeHandlers (DMap IdeMethod IdeHandler) -newtype IdeResolveHandlers = IdeResolveHandlers (DMap ResolveMethod IdeResolveHandler) newtype IdeNotificationHandlers = IdeNotificationHandlers (DMap IdeNotification IdeNotificationHandler) instance Semigroup IdeHandlers where @@ -359,13 +302,6 @@ instance Semigroup IdeHandlers where instance Monoid IdeHandlers where mempty = IdeHandlers mempty -instance Semigroup IdeResolveHandlers where - (IdeResolveHandlers a) <> (IdeResolveHandlers b) = IdeResolveHandlers $ DMap.unionWithKey go a b - where - go _ (IdeResolveHandler a) (IdeResolveHandler b) = IdeResolveHandler (a <> b) -instance Monoid IdeResolveHandlers where - mempty = IdeResolveHandlers mempty - instance Semigroup IdeNotificationHandlers where (IdeNotificationHandlers a) <> (IdeNotificationHandlers b) = IdeNotificationHandlers $ DMap.unionWithKey go a b where diff --git a/hls-plugin-api/src/Ide/Plugin/Resolve.hs b/hls-plugin-api/src/Ide/Plugin/Resolve.hs index 4eae148d2f..e692e33008 100644 --- a/hls-plugin-api/src/Ide/Plugin/Resolve.hs +++ b/hls-plugin-api/src/Ide/Plugin/Resolve.hs @@ -37,7 +37,7 @@ mkCodeActionHandlerWithResolve :: forall ideState a. (A.FromJSON a) => (ideState -> PluginId -> CodeActionParams -> LspM Config (Either ResponseError ([Command |? CodeAction] |? Null))) -> (ideState -> PluginId -> CodeAction -> Uri -> a -> LspM Config (Either ResponseError CodeAction)) - -> (PluginHandlers ideState, PluginResolveHandlers ideState) + -> PluginHandlers ideState mkCodeActionHandlerWithResolve codeActionMethod codeResolveMethod = let newCodeActionMethod ideState pid params = runExceptT $ do codeActionReturn <- ExceptT $ codeActionMethod ideState pid params @@ -50,7 +50,7 @@ mkCodeActionHandlerWithResolve codeActionMethod codeResolveMethod = --This is the actual part where we call resolveCodeAction which fills in the edit data for the client | otherwise -> InL <$> traverse (resolveCodeAction (params ^. L.textDocument . L.uri) ideState pid) ls in (mkPluginHandler SMethod_TextDocumentCodeAction newCodeActionMethod - , mkResolveHandler SMethod_CodeActionResolve codeResolveMethod) + <> mkResolveHandler SMethod_CodeActionResolve codeResolveMethod) where dropData :: CodeAction -> CodeAction dropData ca = ca & L.data_ .~ Nothing @@ -77,7 +77,7 @@ mkCodeActionWithResolveAndCommand PluginId -> (ideState -> PluginId -> CodeActionParams -> LspM Config (Either ResponseError ([Command |? CodeAction] |? Null))) -> (ideState -> PluginId -> CodeAction -> Uri -> a -> LspM Config (Either ResponseError CodeAction)) - -> ([PluginCommand ideState], PluginHandlers ideState, PluginResolveHandlers ideState) + -> ([PluginCommand ideState], PluginHandlers ideState) mkCodeActionWithResolveAndCommand plId codeActionMethod codeResolveMethod = let newCodeActionMethod ideState pid params = runExceptT $ do codeActionReturn <- ExceptT $ codeActionMethod ideState pid params @@ -91,9 +91,9 @@ mkCodeActionWithResolveAndCommand plId codeActionMethod codeResolveMethod = -- If they do not we will drop the data field, in addition we will populate the command -- field with our command to execute the resolve, with the whole code action as it's argument. | otherwise -> pure $ InL $ moveDataToCommand (params ^. L.textDocument . L.uri) <$> ls - in ([PluginCommand "codeActionResolve" "Executes resolve for code action" (executeResolveCmd (codeResolveMethod))], - mkPluginHandler SMethod_TextDocumentCodeAction newCodeActionMethod, - mkResolveHandler SMethod_CodeActionResolve codeResolveMethod) + in ([PluginCommand "codeActionResolve" "Executes resolve for code action" (executeResolveCmd codeResolveMethod)], + mkPluginHandler SMethod_TextDocumentCodeAction newCodeActionMethod + <> mkResolveHandler SMethod_CodeActionResolve codeResolveMethod) where moveDataToCommand :: Uri -> Command |? CodeAction -> Command |? CodeAction moveDataToCommand uri ca = let dat = A.toJSON . wrapWithURI uri <$> ca ^? _R -- We need to take the whole codeAction diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index ce4f793023..8ef05dc690 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -48,11 +48,7 @@ module Ide.Types , installSigUsr1Handler , responseError , lookupCommandProvider -, PluginResolveData(..) -, PluginResolveHandlers(..) -, PluginResolveHandler(..) , ResolveFunction -, ResolveMethod(..) , mkResolveHandler ) where @@ -267,7 +263,6 @@ data PluginDescriptor (ideState :: *) = , pluginRules :: !(Rules ()) , pluginCommands :: ![PluginCommand ideState] , pluginHandlers :: PluginHandlers ideState - , pluginResolveHandlers:: PluginResolveHandlers ideState , pluginConfigDescriptor :: ConfigDescriptor , pluginNotificationHandlers :: PluginNotificationHandlers ideState , pluginModifyDynflags :: DynFlagsModifications @@ -411,6 +406,11 @@ instance PluginMethod Request Method_TextDocumentCodeAction where where uri = msgParams ^. L.textDocument . L.uri +instance PluginMethod Request Method_CodeActionResolve where + pluginEnabled _ msgParams pluginDesc config = + pluginResolverResponsible (msgParams ^. L.data_) pluginDesc + && pluginEnabledConfig plcCodeActionsOn (configForPlugin config pluginDesc) + instance PluginMethod Request Method_TextDocumentDefinition where pluginEnabled _ msgParams pluginDesc _ = pluginResponsible uri pluginDesc @@ -445,6 +445,11 @@ instance PluginMethod Request Method_TextDocumentCodeLens where where uri = msgParams ^. L.textDocument . L.uri +instance PluginMethod Request Method_CodeLensResolve where + pluginEnabled _ msgParams pluginDesc config = + pluginResolverResponsible (msgParams ^. L.data_) pluginDesc + && pluginEnabledConfig plcCodeActionsOn (configForPlugin config pluginDesc) + instance PluginMethod Request Method_TextDocumentRename where pluginEnabled _ msgParams pluginDesc config = pluginResponsible uri pluginDesc && pluginEnabledConfig plcRenameOn (configForPlugin config pluginDesc) @@ -462,6 +467,10 @@ instance PluginMethod Request Method_TextDocumentDocumentSymbol where where uri = msgParams ^. L.textDocument . L.uri +instance PluginMethod Request Method_CompletionItemResolve where + pluginEnabled _ msgParams pluginDesc config = pluginResolverResponsible (msgParams ^. L.data_) pluginDesc + && pluginEnabledConfig plcCompletionOn (configForPlugin config pluginDesc) + instance PluginMethod Request Method_TextDocumentCompletion where pluginEnabled _ msgParams pluginDesc config = pluginResponsible uri pluginDesc && pluginEnabledConfig plcCompletionOn (configForPlugin config pluginDesc) @@ -540,6 +549,10 @@ instance PluginRequestMethod Method_TextDocumentCodeAction where , Just caKind <- ca ^. L.kind = any (\k -> k `codeActionKindSubsumes` caKind) allowed | otherwise = False +instance PluginRequestMethod Method_CodeActionResolve where + -- Resolve methods should only have one response + combineResponses _ _ _ _ (x :| _) = x + instance PluginRequestMethod Method_TextDocumentDefinition where combineResponses _ _ _ _ (x :| _) = x @@ -557,6 +570,9 @@ instance PluginRequestMethod Method_WorkspaceSymbol where instance PluginRequestMethod Method_TextDocumentCodeLens where +instance PluginRequestMethod Method_CodeLensResolve where + -- A resolve request should only ever get one response + combineResponses _ _ _ _ (x :| _) = x instance PluginRequestMethod Method_TextDocumentRename where @@ -598,6 +614,10 @@ instance PluginRequestMethod Method_TextDocumentDocumentSymbol where si = SymbolInformation name' (ds ^. L.kind) Nothing parent (ds ^. L.deprecated) loc in [si] <> children' +instance PluginRequestMethod Method_CompletionItemResolve where + -- resolve methods should only have one response + combineResponses _ _ _ _ (x :| _) = x + instance PluginRequestMethod Method_TextDocumentCompletion where combineResponses _ conf _ _ (toList -> xs) = snd $ consumeCompletionResponse limit $ combine xs where @@ -820,7 +840,6 @@ defaultPluginDescriptor plId = mempty mempty mempty - mempty defaultConfigDescriptor mempty mempty @@ -841,7 +860,6 @@ defaultCabalPluginDescriptor plId = mempty mempty mempty - mempty defaultConfigDescriptor mempty mempty @@ -868,38 +886,6 @@ type CommandFunction ideState a -- --------------------------------------------------------------------- -newtype PluginResolveHandlers ideState = PluginResolveHandlers (DMap ResolveMethod (PluginResolveHandler ideState)) -instance Semigroup (PluginResolveHandlers a) where - (PluginResolveHandlers a) <> (PluginResolveHandlers b) = PluginResolveHandlers $ DMap.union a b - -instance Monoid (PluginResolveHandlers a) where - mempty = PluginResolveHandlers mempty - -class (HasTracing (MessageParams m), L.HasData_ (MessageParams m) (Maybe Value)) => PluginResolveMethod (m :: Method ClientToServer Request) where -instance PluginResolveMethod Method_CodeActionResolve -instance PluginResolveMethod Method_CodeLensResolve -instance PluginResolveMethod Method_CompletionItemResolve -instance PluginResolveMethod Method_DocumentLinkResolve -instance PluginResolveMethod Method_InlayHintResolve -instance PluginResolveMethod Method_WorkspaceSymbolResolve - - -data ResolveMethod (m :: Method ClientToServer Request) = PluginResolveMethod m => ResolveMethod (SMethod m) -instance GEq ResolveMethod where - geq (ResolveMethod a) (ResolveMethod b) = geq a b -instance GCompare ResolveMethod where - gcompare (ResolveMethod a) (ResolveMethod b) = gcompare a b - --- Will something like this work? -data PluginResolveHandler ideState (m :: Method ClientToServer Request) - = forall a. (FromJSON a) => ResolveHandler - (ideState - -> PluginId - -> MessageParams m - -> Uri - -> a - -> LspM Config (Either ResponseError (MessageResult m))) - type ResolveFunction ideState a (m :: Method ClientToServer Request) = ideState -> PluginId @@ -910,7 +896,7 @@ type ResolveFunction ideState a (m :: Method ClientToServer Request) = -- | Make a handler for plugins with no extra data mkResolveHandler - :: forall ideState a m. (FromJSON a, PluginResolveMethod m) + :: forall ideState a m. (FromJSON a, PluginRequestMethod m, L.HasData_ (MessageParams m) (Maybe Value)) => SClientMethod m -> (ideState ->PluginId @@ -918,8 +904,22 @@ mkResolveHandler -> Uri -> a -> LspM Config (Either ResponseError (MessageResult m))) - -> PluginResolveHandlers ideState -mkResolveHandler m f = PluginResolveHandlers $ DMap.singleton (ResolveMethod m) (ResolveHandler f) + -> PluginHandlers ideState +mkResolveHandler m f = mkPluginHandler m f' + where f' ideState plId params = do + case fromJSON <$> (params ^. L.data_) of + (Just (Success (PluginResolveData owner uri value) )) -> do + if owner == plId + then + case fromJSON value of + Success decodedValue -> do + f ideState plId params uri decodedValue + Error err -> do + pure $ Left $ ResponseError (InR ErrorCodes_ParseError) (parseError value err) Nothing + else pure $ Left $ ResponseError (InR ErrorCodes_InvalidRequest) invalidRequest Nothing + _ -> pure $ Left $ ResponseError (InR ErrorCodes_InvalidRequest) invalidRequest Nothing + invalidRequest = "The resolve request incorrectly got routed to the wrong resolve handler!" + parseError value err = "Unable to decode: " <> (T.pack $ show value) <> ". Error: " <> (T.pack $ show err) wrapResolveData :: L.HasData_ a (Maybe Value) => PluginId -> Uri -> a -> a wrapResolveData pid uri hasData = @@ -1080,3 +1080,8 @@ getProcessID = fromIntegral <$> P.getProcessID installSigUsr1Handler h = void $ installHandler sigUSR1 (Catch h) Nothing #endif +pluginResolverResponsible :: Maybe Value -> PluginDescriptor c -> Bool +pluginResolverResponsible (Just (fromJSON -> (Success (PluginResolveData o _ _)))) pluginDesc = + pluginId pluginDesc == o +-- We want to fail closed +pluginResolverResponsible _ _ = False diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 1842e9bf95..4a5099b842 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -189,12 +189,11 @@ fromStrictMaybe Strict.Nothing = Nothing descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState descriptor recorder plId = - let (pluginCommands, pluginHandlers, resolveHandlers) = mkCodeActionWithResolveAndCommand plId codeActionProvider (resolveProvider recorder) + let (pluginCommands, pluginHandlers) = mkCodeActionWithResolveAndCommand plId codeActionProvider (resolveProvider recorder) in (defaultPluginDescriptor plId) { pluginRules = rules recorder plId , pluginCommands = pluginCommands , pluginHandlers = pluginHandlers - , pluginResolveHandlers = resolveHandlers , pluginConfigDescriptor = defaultConfigDescriptor { configHasDiagnostics = True , configCustomConfig = mkCustomConfig properties diff --git a/plugins/hls-overloaded-record-dot-plugin/src/Ide/Plugin/OverloadedRecordDot.hs b/plugins/hls-overloaded-record-dot-plugin/src/Ide/Plugin/OverloadedRecordDot.hs index 9aef0beb11..174358e79e 100644 --- a/plugins/hls-overloaded-record-dot-plugin/src/Ide/Plugin/OverloadedRecordDot.hs +++ b/plugins/hls-overloaded-record-dot-plugin/src/Ide/Plugin/OverloadedRecordDot.hs @@ -168,10 +168,9 @@ instance FromJSON ORDResolveData descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState -descriptor recorder plId = let (pluginHandler, resolveHandler) = mkCodeActionHandlerWithResolve codeActionProvider resolveProvider +descriptor recorder plId = let pluginHandler = mkCodeActionHandlerWithResolve codeActionProvider resolveProvider in (defaultPluginDescriptor plId) { pluginHandlers = pluginHandler - , pluginResolveHandlers = resolveHandler , pluginRules = collectRecSelsRule recorder } From 1587dd70bd6cd37b63c131c8937c33b93b1d16f6 Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Wed, 12 Jul 2023 13:21:49 +0300 Subject: [PATCH 06/12] Incorporate changes from hlint-suggestions branch --- hls-plugin-api/src/Ide/Plugin/Resolve.hs | 62 +++++++++++++++++++----- 1 file changed, 50 insertions(+), 12 deletions(-) diff --git a/hls-plugin-api/src/Ide/Plugin/Resolve.hs b/hls-plugin-api/src/Ide/Plugin/Resolve.hs index e692e33008..4fa602568f 100644 --- a/hls-plugin-api/src/Ide/Plugin/Resolve.hs +++ b/hls-plugin-api/src/Ide/Plugin/Resolve.hs @@ -15,6 +15,7 @@ import Control.Monad.Trans.Class (MonadTrans (lift)) import Control.Monad.Trans.Except (ExceptT (..), runExceptT, throwE) import qualified Data.Aeson as A +import Data.Maybe (catMaybes) import Data.Row ((.!)) import qualified Data.Text as T import GHC.Generics (Generic) @@ -67,11 +68,13 @@ mkCodeActionHandlerWithResolve codeActionMethod codeResolveMethod = _ -> throwE $ invalidParamsError "Returned CodeAction has no data field" resolveCodeAction _ _ _ (InR CodeAction{_data_=Nothing}) = throwE $ invalidParamsError "CodeAction has no data field" --- |When provided with both a codeAction provider that includes both a command --- and a data field and a resolve provider, this function creates a handler that --- defaults to using your command if the client doesn't have code action resolve --- support. This means you don't have to check whether the client supports resolve --- and act accordingly in your own providers. +-- |When provided with both a codeAction provider with a data field and a resolve +-- provider, this function creates a handler that creates a command that uses +-- your resolve if the client doesn't have code action resolve support. This means +-- you don't have to check whether the client supports resolve and act +-- accordingly in your own providers. see Note [Code action resolve fallback to commands] +-- Also: This helper only works with workspace edits, not commands. Any command set +-- either in the original code action or in the resolve will be ignored. mkCodeActionWithResolveAndCommand :: forall ideState a. (A.FromJSON a) => PluginId @@ -98,7 +101,9 @@ mkCodeActionWithResolveAndCommand plId codeActionMethod codeResolveMethod = moveDataToCommand uri ca = let dat = A.toJSON . wrapWithURI uri <$> ca ^? _R -- We need to take the whole codeAction -- And put it in the argument for the Command, that way we can later - -- pas it to the resolve handler (which expects a whole code action) + -- pass it to the resolve handler (which expects a whole code action) + -- It should be noted that mkLspCommand already specifies the command + -- to the plugin, so we don't need to do that here. cmd = mkLspCommand plId (CommandId "codeActionResolve") "Execute Code Action" (pure <$> dat) in ca & _R . L.data_ .~ Nothing -- Set the data field to nothing @@ -109,7 +114,7 @@ mkCodeActionWithResolveAndCommand plId codeActionMethod codeResolveMethod = where data_ = codeAction ^? L.data_ . _Just executeResolveCmd :: (ideState -> PluginId -> CodeAction -> Uri -> a -> LspM Config (Either ResponseError CodeAction))-> CommandFunction ideState CodeAction executeResolveCmd resolveProvider ideState ca@CodeAction{_data_=Just value} = do - withIndefiniteProgress "Executing code action..." Cancellable $ do + withIndefiniteProgress "Applying edits for code action..." Cancellable $ do case A.fromJSON value of A.Error err -> pure $ Left $ parseError (Just value) (T.pack err) A.Success (WithURI uri innerValue) -> do @@ -118,14 +123,33 @@ mkCodeActionWithResolveAndCommand plId codeActionMethod codeResolveMethod = A.Success innerValueDecoded -> do resolveResult <- resolveProvider ideState plId ca uri innerValueDecoded case resolveResult of - Right CodeAction {_edit = Just wedits } -> do + Right ca2@CodeAction {_edit = Just wedits } | diffCodeActions ca ca2 == ["edit"] -> do _ <- sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedits) (\_ -> pure ()) pure $ Right A.Null - Right _ -> pure $ Left $ invalidParamsError "Returned CodeAction has no data field" + Right ca2@CodeAction {_edit = Just _ } -> + pure $ Left $ + internalError $ + "The resolve provider unexpectedly returned a code action with the following differing fields: " + <> (T.pack $ show $ diffCodeActions ca ca2) + Right _ -> pure $ Left $ internalError "The resolve provider unexpectedly returned a result with no data field" Left err -> pure $ Left err - executeResolveCmd _ _ CodeAction{_data_= value} = pure $ Left $ invalidParamsError ("CodeAction data field empty: " <> (T.pack $ show value)) + executeResolveCmd _ _ CodeAction{_data_= value} = pure $ Left $ invalidParamsError ("The code action to resolve has an illegal data field: " <> (T.pack $ show value)) +-- TODO: Remove once provided by lsp-types +-- |Compares two CodeActions and returns a list of fields that are not equal +diffCodeActions :: CodeAction -> CodeAction -> [T.Text] +diffCodeActions ca ca2 = + let titleDiff = if ca ^. L.title == ca2 ^. L.title then Nothing else Just "title" + kindDiff = if ca ^. L.kind == ca2 ^. L.kind then Nothing else Just "kind" + diagnosticsDiff = if ca ^. L.diagnostics == ca2 ^. L.diagnostics then Nothing else Just "diagnostics" + commandDiff = if ca ^. L.command == ca2 ^. L.command then Nothing else Just "diagnostics" + isPreferredDiff = if ca ^. L.isPreferred == ca2 ^. L.isPreferred then Nothing else Just "isPreferred" + dataDiff = if ca ^. L.data_ == ca2 ^. L.data_ then Nothing else Just "data" + disabledDiff = if ca ^. L.disabled == ca2 ^. L.disabled then Nothing else Just "disabled" + editDiff = if ca ^. L.edit == ca2 ^. L.edit then Nothing else Just "edit" + in catMaybes [titleDiff, kindDiff, diagnosticsDiff, commandDiff, isPreferredDiff, dataDiff, disabledDiff, editDiff] + -- |To execute the resolve provider as a command, we need to additionally store -- the URI that was provided to the original code action. data WithURI = WithURI { @@ -142,8 +166,22 @@ supportsCodeActionResolve caps = Just row -> "edit" `elem` row .! #properties _ -> False +internalError :: T.Text -> ResponseError +internalError msg = ResponseError (InR ErrorCodes_InternalError) ("Ide.Plugin.Resolve: Internal Error : " <> msg) Nothing + invalidParamsError :: T.Text -> ResponseError -invalidParamsError msg = ResponseError (InR ErrorCodes_InternalError) ("Ide.Plugin.Resolve: " <> msg) Nothing +invalidParamsError msg = ResponseError (InR ErrorCodes_InvalidParams) ("Ide.Plugin.Resolve: : " <> msg) Nothing parseError :: Maybe A.Value -> T.Text -> ResponseError -parseError value errMsg = ResponseError (InR ErrorCodes_InternalError) ("Ide.Plugin.Resolve: Error parsing value:"<> (T.pack $ show value) <> " Error: "<> errMsg) Nothing +parseError value errMsg = ResponseError (InR ErrorCodes_ParseError) ("Ide.Plugin.Resolve: Error parsing value:"<> (T.pack $ show value) <> " Error: "<> errMsg) Nothing + +{- Note [Code action resolve fallback to commands] + To make supporting code action resolve easy for plugins, we want to let them + provide one implementation that can be used both when clients support + resolve, and when they don't. + The way we do this is to have them always implement a resolve handler. + Then, if the client doesn't support resolve, we instead install the resolve + handler as a _command_ handler, passing the code action literal itself + as the command argument. This allows the command handler to have + the same interface as the resolve handler! + -} From 5291541222431a66ba8a384749b6ad14208bf020 Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Wed, 12 Jul 2023 13:24:08 +0300 Subject: [PATCH 07/12] updates due to merge --- hls-plugin-api/src/Ide/Plugin/Resolve.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hls-plugin-api/src/Ide/Plugin/Resolve.hs b/hls-plugin-api/src/Ide/Plugin/Resolve.hs index 4fa602568f..b9111c6a87 100644 --- a/hls-plugin-api/src/Ide/Plugin/Resolve.hs +++ b/hls-plugin-api/src/Ide/Plugin/Resolve.hs @@ -125,7 +125,7 @@ mkCodeActionWithResolveAndCommand plId codeActionMethod codeResolveMethod = case resolveResult of Right ca2@CodeAction {_edit = Just wedits } | diffCodeActions ca ca2 == ["edit"] -> do _ <- sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedits) (\_ -> pure ()) - pure $ Right A.Null + pure $ Right $ InR Null Right ca2@CodeAction {_edit = Just _ } -> pure $ Left $ internalError $ From 1405a0c588861c38d42b5f400b2b6cd35cbd13bb Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Wed, 12 Jul 2023 13:58:18 +0300 Subject: [PATCH 08/12] Convert ExplicitImport to use ResolveFunction --- .../src/Ide/Plugin/ExplicitImports.hs | 28 ++++++------------- 1 file changed, 9 insertions(+), 19 deletions(-) diff --git a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs index c99ff2ee1d..eff8a242a1 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -6,7 +6,6 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} @@ -25,9 +24,7 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Maybe -import qualified Data.Aeson as A (Result (..), - ToJSON (toJSON), - fromJSON) +import qualified Data.Aeson as A (ToJSON (toJSON)) import Data.Aeson.Types (FromJSON) import qualified Data.IntMap as IM (IntMap, elems, fromList, (!?)) @@ -47,6 +44,7 @@ import Development.IDE.Graph.Classes import GHC.Generics (Generic) import Ide.Plugin.RangeMap (filterByRange) import qualified Ide.Plugin.RangeMap as RM (RangeMap, fromList) +import Ide.Plugin.Resolve import Ide.PluginUtils (getNormalizedFilePath, handleMaybe, handleMaybeM, @@ -92,7 +90,7 @@ descriptorForModules recorder modFilter plId = pluginHandlers = -- This plugin provides code lenses mkPluginHandler SMethod_TextDocumentCodeLens (lensProvider recorder) - <> mkPluginHandler SMethod_CodeLensResolve (lensResolveProvider recorder) + <> mkResolveHandler SMethod_CodeLensResolve (lensResolveProvider recorder) -- This plugin provides code actions <> mkCodeActionHandlerWithResolve (codeActionProvider recorder) (codeActionResolveProvider recorder) @@ -139,8 +137,8 @@ lensProvider _ state _ CodeLensParams {_textDocument = TextDocumentIdentifier { , _range = range , _command = Nothing } -lensResolveProvider :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_CodeLensResolve -lensResolveProvider _ ideState plId cl@(CodeLens {_data_ = Just data_@(A.fromJSON -> A.Success (ResolveOne uri uid))}) +lensResolveProvider :: Recorder (WithPriority Log) -> ResolveFunction IdeState EIResolveData 'Method_CodeLensResolve +lensResolveProvider _ ideState plId cl@(CodeLens {_data_ = data_}) uri (ResolveOne _ uid) = pluginResponse $ do nfp <- getNormalizedFilePath uri (MinimalImportsResult{forResolve}) <- @@ -153,14 +151,10 @@ lensResolveProvider _ ideState plId cl@(CodeLens {_data_ = Just data_@(A.fromJSO where mkCommand :: PluginId -> TextEdit -> Command mkCommand pId TextEdit{_newText} = let title = abbreviateImportTitle _newText - _arguments = Just [data_] + _arguments = pure <$> data_ in mkLspCommand pId importCommandId title _arguments -lensResolveProvider _ _ _ (CodeLens {_data_ = Just (A.fromJSON -> A.Success (ResolveAll _))}) = do +lensResolveProvider _ _ _ _ _ (ResolveAll _) = do pure $ Left $ ResponseError (InR ErrorCodes_InvalidParams) "Unexpected argument for lens resolve handler: ResolveAll" Nothing -lensResolveProvider _ _ _ (CodeLens {_data_ = Just (A.fromJSON @EIResolveData -> (A.Error (T.pack -> str)))}) = - pure $ Left $ ResponseError (InR ErrorCodes_ParseError) str Nothing -lensResolveProvider _ _ _ (CodeLens {_data_ = v}) = do - pure $ Left $ ResponseError (InR ErrorCodes_InvalidParams) ("Unexpected argument for lens resolve handler: " <> (T.pack $ show v)) Nothing -- | If there are any implicit imports, provide both one code action per import -- to make that specific import explicit, and one code action to turn them all @@ -191,15 +185,11 @@ codeActionProvider _ ideState _pId (CodeActionParams _ _ TextDocumentIdentifier , _disabled = Nothing , _data_ = data_} -codeActionResolveProvider :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_CodeActionResolve -codeActionResolveProvider _ ideState _ ca@(CodeAction{_data_= Just (A.fromJSON -> A.Success rd)}) = +codeActionResolveProvider :: Recorder (WithPriority Log) -> ResolveFunction IdeState EIResolveData 'Method_CodeActionResolve +codeActionResolveProvider _ ideState _ ca _ rd = pluginResponse $ do wedit <- resolveWTextEdit ideState rd pure $ ca & L.edit ?~ wedit -codeActionResolveProvider _ _ _ (CodeAction{_data_= Just (A.fromJSON @EIResolveData -> A.Error (T.pack -> str))}) = - pure $ Left $ ResponseError (InR ErrorCodes_ParseError) str Nothing -codeActionResolveProvider _ _ _ (CodeAction {_data_ = v}) = do - pure $ Left $ ResponseError (InR ErrorCodes_InvalidParams) ("Unexpected argument for code action resolve handler: " <> (T.pack $ show v)) Nothing -------------------------------------------------------------------------------- resolveWTextEdit :: IdeState -> EIResolveData -> ExceptT String (LspT Config IO) WorkspaceEdit From aa3f2819c970b06f72dce5970a29a74cb71ef2f3 Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Wed, 12 Jul 2023 16:07:51 +0300 Subject: [PATCH 09/12] Fix flags and test issues --- hls-plugin-api/src/Ide/Types.hs | 9 +++++---- .../src/Ide/Plugin/ExplicitImports.hs | 5 ++--- plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 2 -- 3 files changed, 7 insertions(+), 9 deletions(-) diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index 7ea396380a..0ce64f4623 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -62,7 +62,7 @@ import System.Posix.Signals #endif import Control.Applicative ((<|>)) import Control.Arrow ((&&&)) -import Control.Lens (_Just, (.~), (^.), (^?)) +import Control.Lens (_Just, (.~), (?~), (^.), (^?)) import Data.Aeson hiding (Null, defaultOptions) import Data.Default import Data.Dependent.Map (DMap) @@ -912,9 +912,10 @@ mkResolveHandler m f = mkPluginHandler m f' if owner == plId then case fromJSON value of - Success decodedValue -> do - f ideState plId params uri decodedValue - Error err -> do + Success decodedValue -> + let newParams = params & L.data_ ?~ value + in f ideState plId newParams uri decodedValue + Error err -> pure $ Left $ ResponseError (InR ErrorCodes_ParseError) (parseError value err) Nothing else pure $ Left $ ResponseError (InR ErrorCodes_InvalidRequest) invalidRequest Nothing _ -> pure $ Left $ ResponseError (InR ErrorCodes_InvalidRequest) invalidRequest Nothing diff --git a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs index eff8a242a1..5a3e47bf5e 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -138,7 +138,7 @@ lensProvider _ state _ CodeLensParams {_textDocument = TextDocumentIdentifier { , _command = Nothing } lensResolveProvider :: Recorder (WithPriority Log) -> ResolveFunction IdeState EIResolveData 'Method_CodeLensResolve -lensResolveProvider _ ideState plId cl@(CodeLens {_data_ = data_}) uri (ResolveOne _ uid) +lensResolveProvider _ ideState plId cl uri rd@(ResolveOne _ uid) = pluginResponse $ do nfp <- getNormalizedFilePath uri (MinimalImportsResult{forResolve}) <- @@ -151,8 +151,7 @@ lensResolveProvider _ ideState plId cl@(CodeLens {_data_ = data_}) uri (ResolveO where mkCommand :: PluginId -> TextEdit -> Command mkCommand pId TextEdit{_newText} = let title = abbreviateImportTitle _newText - _arguments = pure <$> data_ - in mkLspCommand pId importCommandId title _arguments + in mkLspCommand pId importCommandId title (Just $ [A.toJSON rd]) lensResolveProvider _ _ _ _ _ (ResolveAll _) = do pure $ Left $ ResponseError (InR ErrorCodes_InvalidParams) "Unexpected argument for lens resolve handler: ResolveAll" Nothing diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 4a5099b842..75e1cd0ebd 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -144,8 +144,6 @@ import GHC.Generics (Generic) import System.Environment (setEnv, unsetEnv) #endif -import Data.Aeson (Result (Error, Success), - fromJSON) import Text.Regex.TDFA.Text () -- --------------------------------------------------------------------- From 0c132c40e73e7d1eab6b1a46563e705945ee3d57 Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Thu, 13 Jul 2023 19:38:50 +0300 Subject: [PATCH 10/12] Implemented michaelpj's suggestions --- hls-plugin-api/src/Ide/Plugin/Resolve.hs | 3 ++ hls-plugin-api/src/Ide/Types.hs | 45 +++++++++++++----------- 2 files changed, 27 insertions(+), 21 deletions(-) diff --git a/hls-plugin-api/src/Ide/Plugin/Resolve.hs b/hls-plugin-api/src/Ide/Plugin/Resolve.hs index b9111c6a87..9f5ab76014 100644 --- a/hls-plugin-api/src/Ide/Plugin/Resolve.hs +++ b/hls-plugin-api/src/Ide/Plugin/Resolve.hs @@ -159,6 +159,9 @@ data WithURI = WithURI { instance A.ToJSON WithURI instance A.FromJSON WithURI +-- |Checks if the the client supports resolve for code action. We currently only check +-- whether resolve for the edit field is supported, because that's the only one we care +-- about at the moment. supportsCodeActionResolve :: ClientCapabilities -> Bool supportsCodeActionResolve caps = caps ^? L.textDocument . _Just . L.codeAction . _Just . L.dataSupport . _Just == Just True diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index 0ce64f4623..de65416ccd 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BlockArguments #-} {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DefaultSignatures #-} @@ -773,7 +774,7 @@ type PluginMethodHandler a m = a -> PluginId -> MessageParams m -> LspM Config ( type PluginNotificationMethodHandler a m = a -> VFS -> PluginId -> MessageParams m -> LspM Config () --- | Make a handler for plugins with no extra data +-- | Make a handler for plugins mkPluginHandler :: forall ideState m. PluginRequestMethod m => SClientMethod m @@ -894,7 +895,8 @@ type ResolveFunction ideState a (m :: Method ClientToServer Request) = -> a -> LspM Config (Either ResponseError (MessageResult m)) --- | Make a handler for plugins with no extra data +-- | Make a handler for resolve methods. In here we take your provided ResolveFunction +-- and turn it into a PluginHandlers mkResolveHandler :: forall ideState a m. (FromJSON a, PluginRequestMethod m, L.HasData_ (MessageParams m) (Maybe Value)) => SClientMethod m @@ -905,26 +907,26 @@ mkResolveHandler -> a -> LspM Config (Either ResponseError (MessageResult m))) -> PluginHandlers ideState -mkResolveHandler m f = mkPluginHandler m f' - where f' ideState plId params = do - case fromJSON <$> (params ^. L.data_) of - (Just (Success (PluginResolveData owner uri value) )) -> do - if owner == plId - then - case fromJSON value of - Success decodedValue -> - let newParams = params & L.data_ ?~ value - in f ideState plId newParams uri decodedValue - Error err -> - pure $ Left $ ResponseError (InR ErrorCodes_ParseError) (parseError value err) Nothing - else pure $ Left $ ResponseError (InR ErrorCodes_InvalidRequest) invalidRequest Nothing - _ -> pure $ Left $ ResponseError (InR ErrorCodes_InvalidRequest) invalidRequest Nothing - invalidRequest = "The resolve request incorrectly got routed to the wrong resolve handler!" +mkResolveHandler m f = mkPluginHandler m $ \ideState plId params -> do + case fromJSON <$> (params ^. L.data_) of + (Just (Success (PluginResolveData owner uri value) )) -> do + if owner == plId + then + case fromJSON value of + Success decodedValue -> + let newParams = params & L.data_ ?~ value + in f ideState plId newParams uri decodedValue + Error err -> + pure $ Left $ ResponseError (InR ErrorCodes_ParseError) (parseError value err) Nothing + else pure $ Left $ ResponseError (InR ErrorCodes_InternalError) invalidRequest Nothing + (Just (Error err)) -> pure $ Left $ ResponseError (InR ErrorCodes_ParseError) (parseError value err) Nothing + _ -> pure $ Left $ ResponseError (InR ErrorCodes_InternalError) invalidRequest Nothing + where invalidRequest = "The resolve request incorrectly got routed to the wrong resolve handler!" parseError value err = "Unable to decode: " <> (T.pack $ show value) <> ". Error: " <> (T.pack $ show err) wrapResolveData :: L.HasData_ a (Maybe Value) => PluginId -> Uri -> a -> a wrapResolveData pid uri hasData = - hasData & L.data_ .~ (toJSON .PluginResolveData pid uri <$> data_) + hasData & L.data_ .~ (toJSON . PluginResolveData pid uri <$> data_) where data_ = hasData ^? L.data_ . _Just -- |Allow plugins to "own" resolve data, allowing only them to be queried for @@ -934,9 +936,10 @@ data PluginResolveData = PluginResolveData { resolvePlugin :: PluginId , resolveURI :: Uri , resolveValue :: Value -} deriving (Generic, Show) -instance ToJSON PluginResolveData -instance FromJSON PluginResolveData +} + deriving (Generic, Show) + deriving anyclass (ToJSON, FromJSON) + newtype PluginId = PluginId T.Text deriving (Show, Read, Eq, Ord) deriving newtype (ToJSON, FromJSON, Hashable) From da22773231d8222572aa9ac1ce8a0289a24c9397 Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Fri, 14 Jul 2023 19:49:06 +0300 Subject: [PATCH 11/12] Fix error --- hls-plugin-api/src/Ide/Types.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index de65416ccd..d779bc6756 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -919,7 +919,7 @@ mkResolveHandler m f = mkPluginHandler m $ \ideState plId params -> do Error err -> pure $ Left $ ResponseError (InR ErrorCodes_ParseError) (parseError value err) Nothing else pure $ Left $ ResponseError (InR ErrorCodes_InternalError) invalidRequest Nothing - (Just (Error err)) -> pure $ Left $ ResponseError (InR ErrorCodes_ParseError) (parseError value err) Nothing + (Just (Error err)) -> pure $ Left $ ResponseError (InR ErrorCodes_ParseError) (parseError (params ^. L.data_) err) Nothing _ -> pure $ Left $ ResponseError (InR ErrorCodes_InternalError) invalidRequest Nothing where invalidRequest = "The resolve request incorrectly got routed to the wrong resolve handler!" parseError value err = "Unable to decode: " <> (T.pack $ show value) <> ". Error: " <> (T.pack $ show err) From 6c0652f103be1054884d09572366531ee00e6787 Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Fri, 14 Jul 2023 20:16:32 +0300 Subject: [PATCH 12/12] Added note on resolve --- hls-plugin-api/src/Ide/Types.hs | 48 +++++++++++++++++++++++++++++---- 1 file changed, 43 insertions(+), 5 deletions(-) diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index d779bc6756..bd35a3312d 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -408,6 +408,7 @@ instance PluginMethod Request Method_TextDocumentCodeAction where uri = msgParams ^. L.textDocument . L.uri 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) @@ -447,6 +448,7 @@ instance PluginMethod Request Method_TextDocumentCodeLens where uri = msgParams ^. L.textDocument . L.uri 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) @@ -469,6 +471,7 @@ instance PluginMethod Request Method_TextDocumentDocumentSymbol where uri = msgParams ^. L.textDocument . L.uri 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) @@ -551,7 +554,8 @@ instance PluginRequestMethod Method_TextDocumentCodeAction where | otherwise = False instance PluginRequestMethod Method_CodeActionResolve where - -- Resolve methods should only have one response + -- A resolve request should only have one response. + -- See Note [Resolve in PluginHandlers]. combineResponses _ _ _ _ (x :| _) = x instance PluginRequestMethod Method_TextDocumentDefinition where @@ -572,7 +576,8 @@ instance PluginRequestMethod Method_WorkspaceSymbol where instance PluginRequestMethod Method_TextDocumentCodeLens where instance PluginRequestMethod Method_CodeLensResolve where - -- A resolve request should only ever get one response + -- A resolve request should only ever get one response. + -- See note Note [Resolve in PluginHandlers] combineResponses _ _ _ _ (x :| _) = x instance PluginRequestMethod Method_TextDocumentRename where @@ -616,7 +621,8 @@ instance PluginRequestMethod Method_TextDocumentDocumentSymbol where in [si] <> children' instance PluginRequestMethod Method_CompletionItemResolve where - -- resolve methods should only have one response + -- A resolve request should only have one response. + -- See Note [Resolve in PluginHandlers] combineResponses _ _ _ _ (x :| _) = x instance PluginRequestMethod Method_TextDocumentCompletion where @@ -774,7 +780,8 @@ type PluginMethodHandler a m = a -> PluginId -> MessageParams m -> LspM Config ( type PluginNotificationMethodHandler a m = a -> VFS -> PluginId -> MessageParams m -> LspM Config () --- | Make a handler for plugins +-- | Make a handler for plugins. For how resolve works with this see +-- Note [Resolve in PluginHandlers] mkPluginHandler :: forall ideState m. PluginRequestMethod m => SClientMethod m @@ -896,7 +903,7 @@ type ResolveFunction ideState a (m :: Method ClientToServer Request) = -> LspM Config (Either ResponseError (MessageResult m)) -- | Make a handler for resolve methods. In here we take your provided ResolveFunction --- and turn it into a PluginHandlers +-- and turn it into a PluginHandlers. See Note [Resolve in PluginHandlers] mkResolveHandler :: forall ideState a m. (FromJSON a, PluginRequestMethod m, L.HasData_ (MessageParams m) (Maybe Value)) => SClientMethod m @@ -1084,8 +1091,39 @@ 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 + their responses can be easily combined. Whereas commands, which similarly have + the same requirements have their own codepaths for execution, for resolve + methods we are relying on the standard PluginHandlers codepath. + That isn't a problem, but it does mean we need to do some things extra for + these methods. + - First of all, whenever a handler that can be resolved sets the data_ field + in their response, we need to intercept it, and wrap it in a data type + PluginResolveData that allows us to route the future resolve request to the + specific plugin which is responsible for it. (We also throw in the URI for + convenience, because everyone needs that). We do that in mkPluginHandler. + - When we get any resolve requests we check their data field for our + PluginResolveData that will allow us to route the request to the right + plugin. If we can't find out which plugin to route the request to, then we + just don't route it at all. This is done in pluginEnabled, and + pluginResolverResponsible. + - Finally we have mkResolveHandler, which takes the resolve request and + unwraps the plugins data from our PluginResolveData, parses it and passes it + it on to the registered handler. + It should be noted that there are some restrictions with this approach: First, + if a plugin does not set the data_ field, than the request will not be able + to be resolved. This is because we only wrap data_ fields that have been set + with our PluginResolvableData tag. Second, if a plugin were to register two + resolve handlers for the same method, than our assumptions that we never have + two responses break, and behavior is undefined. + -}