From 6bd943edb0a94957b44fec142e4542ef7bab9f7b Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Wed, 5 Jul 2023 15:24:21 +0300 Subject: [PATCH 1/2] Addresses michealpj's pr comments --- hls-plugin-api/src/Ide/Types.hs | 53 +++++++++++----- .../hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 63 ++++++++++--------- 2 files changed, 71 insertions(+), 45 deletions(-) diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index b7aaa6e231..b3dec68a33 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -11,6 +11,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MonadComprehensions #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} @@ -76,6 +77,7 @@ import Data.GADT.Compare import Data.Hashable (Hashable) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap +import Data.Kind (Type) import Data.List.Extra (find, sortOn) import Data.List.NonEmpty (NonEmpty (..), toList) import qualified Data.Map as Map @@ -264,7 +266,7 @@ instance ToJSON PluginConfig where -- --------------------------------------------------------------------- -data PluginDescriptor (ideState :: *) = +data PluginDescriptor (ideState :: Type) = PluginDescriptor { pluginId :: !PluginId -- ^ Unique identifier of the plugin. , pluginPriority :: Natural @@ -477,7 +479,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 @@ -1048,11 +1052,13 @@ mkCodeActionHandlerWithResolve codeActionMethod codeResolveMethod = 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. +-- |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. PluginId @@ -1069,8 +1075,17 @@ mkCodeActionWithResolveAndCommand plId codeActionMethod codeResolveMethod = -- 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. + {- 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! + -} | otherwise -> pure $ InL $ moveDataToCommand <$> ls newCodeResolveMethod ideState pid params = codeResolveMethod ideState pid (unwrapCodeActionResolveData params) @@ -1081,19 +1096,29 @@ mkCodeActionWithResolveAndCommand plId codeActionMethod codeResolveMethod = 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) + -- 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 & _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 + withIndefiniteProgress "Applying edits for 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 CodeAction {_edit = Just wedits, ..} -> + if | ca ^. L.title == _title + , ca ^. L.kind == _kind + , ca ^. L.diagnostics == _diagnostics + , ca ^. L.command == _command + , ca ^. L.isPreferred == _isPreferred + , ca ^. L.data_ == _data_ + , ca ^. L.disabled == _disabled -> do + _ <- sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedits) (\_ -> pure ()) + pure $ Right Data.Aeson.Null + | otherwise -> pure $ Left $ responseError "CodeAction fields beside edit changed during resolve" Right _ -> pure $ Left $ responseError "No edit in CodeAction" Left err -> pure $ Left err diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 4faefa7a24..81d991db2b 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -15,9 +15,9 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StrictData #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} - {-# OPTIONS_GHC -Wno-orphans #-} -- On 9.4 we get a new redundant constraint warning, but deleting the @@ -423,7 +423,7 @@ codeActionProvider ideState _pluginId (CodeActionParams _ _ documentId _ context where applyAllAction verTxtDocId = - let args = Just $ toJSON (AA verTxtDocId) + let args = Just $ toJSON (ApplyHint verTxtDocId Nothing) in LSP.CodeAction "Apply all hints" (Just LSP.CodeActionKind_QuickFix) Nothing Nothing Nothing Nothing Nothing args -- |Some hints do not have an associated refactoring @@ -435,23 +435,21 @@ 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 - edit <- ExceptT $ liftIO $ applyHint recorder ideState file Nothing verTxtDocId - pure $ ca & LSP.edit ?~ edit - (Success (AO verTxtDocId@(VersionedTextDocumentIdentifier uri _) pos hintTitle)) -> do - let oneHint = OneHint pos hintTitle - file <- getNormalizedFilePath uri - edit <- ExceptT $ liftIO $ applyHint recorder ideState file (Just oneHint) verTxtDocId +resolveProvider recorder ideState _ + ca@CodeAction {_data_ = Just (fromJSON -> (Success (ApplyHint verTxtDocId oneHint)))} = pluginResponse $ do + file <- getNormalizedFilePath (verTxtDocId ^. LSP.uri) + edit <- ExceptT $ liftIO $ applyHint recorder ideState file oneHint verTxtDocId pure $ ca & LSP.edit ?~ edit - (Success (IH verTxtDocId@(VersionedTextDocumentIdentifier uri _) hintTitle )) -> do - file <- getNormalizedFilePath uri +resolveProvider recorder ideState _ + ca@CodeAction {_data_ = Just (fromJSON -> (Success (IgnoreHint verTxtDocId hintTitle)))} = pluginResponse $ do + file <- getNormalizedFilePath (verTxtDocId ^. LSP.uri) 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" +resolveProvider _ _ _ + CodeAction {_data_ = Just (fromJSON @HlintResolveCommands -> (Error (T.pack -> str)))} = + pure $ Left $ ResponseError (InR ErrorCodes_ParseError) str Nothing +resolveProvider _ _ _ CodeAction {_data_ = _} = + pure $ Left $ ResponseError (InR ErrorCodes_InvalidParams) "Unexpected argument for code action resolve handler: (Probably Nothing)" Nothing -- | Convert a hlint diagnostic into an apply and an ignore code action -- if applicable @@ -461,13 +459,13 @@ diagnosticToCodeActions verTxtDocId diagnostic , let isHintApplicable = "refact:" `T.isPrefixOf` code , let hint = T.replace "refact:" "" code , let suppressHintTitle = "Ignore hint \"" <> hint <> "\" in this module" - , let suppressHintArguments = IH verTxtDocId hint + , let suppressHintArguments = IgnoreHint verTxtDocId hint = catMaybes -- Applying the hint is marked preferred because it addresses the underlying error. -- Disabling the rule isn't, because less often used and configuration can be adapted. [ if | isHintApplicable , let applyHintTitle = "Apply hint \"" <> hint <> "\"" - applyHintArguments = AO verTxtDocId start hint -> + applyHintArguments = ApplyHint verTxtDocId (Just $ OneHint start hint) -> Just (mkCodeAction applyHintTitle diagnostic (Just (toJSON applyHintArguments)) True) | otherwise -> Nothing , Just (mkCodeAction suppressHintTitle diagnostic (Just (toJSON suppressHintArguments)) False) @@ -525,22 +523,25 @@ ignoreHint _recorder ideState nfp verTxtDocId ignoreHintTitle = do Nothing -> pure $ Left "Unable to get fileContents" -- --------------------------------------------------------------------- -data HlintResolveCommands = AA { verTxtDocId :: VersionedTextDocumentIdentifier} - | AO { verTxtDocId :: VersionedTextDocumentIdentifier - , start_pos :: Position - -- | There can be more than one hint suggested at the same position, so HintTitle is used to distinguish between them. - , hintTitle :: HintTitle - } - | IH { verTxtDocId :: VersionedTextDocumentIdentifier - , ignoreHintTitle :: HintTitle - } deriving (Generic, ToJSON, FromJSON) +data HlintResolveCommands = + ApplyHint + { verTxtDocId :: VersionedTextDocumentIdentifier + -- |If Nothing, apply all hints, otherise only apply + -- the given hint + , oneHint :: Maybe OneHint + } + | IgnoreHint + { verTxtDocId :: VersionedTextDocumentIdentifier + , ignoreHintTitle :: HintTitle + } deriving (Generic, ToJSON, FromJSON) type HintTitle = T.Text -data OneHint = OneHint - { oneHintPos :: Position - , oneHintTitle :: HintTitle - } deriving (Eq, Show) +data OneHint = + OneHint + { oneHintPos :: Position + , oneHintTitle :: HintTitle + } deriving (Generic, Eq, Show, ToJSON, FromJSON) applyHint :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> Maybe OneHint -> VersionedTextDocumentIdentifier -> IO (Either String WorkspaceEdit) applyHint recorder ide nfp mhint verTxtDocId = From e9b2661fee41c9988a0e3adfe2eacca944e7f650 Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Wed, 12 Jul 2023 13:19:08 +0300 Subject: [PATCH 2/2] Move Types.hs changes to general-resolve-improvements branch --- hls-plugin-api/src/Ide/Types.hs | 53 +++++++++------------------------ 1 file changed, 14 insertions(+), 39 deletions(-) diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index b3dec68a33..b7aaa6e231 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -11,7 +11,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MonadComprehensions #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} @@ -77,7 +76,6 @@ import Data.GADT.Compare import Data.Hashable (Hashable) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap -import Data.Kind (Type) import Data.List.Extra (find, sortOn) import Data.List.NonEmpty (NonEmpty (..), toList) import qualified Data.Map as Map @@ -266,7 +264,7 @@ instance ToJSON PluginConfig where -- --------------------------------------------------------------------- -data PluginDescriptor (ideState :: Type) = +data PluginDescriptor (ideState :: *) = PluginDescriptor { pluginId :: !PluginId -- ^ Unique identifier of the plugin. , pluginPriority :: Natural @@ -479,9 +477,7 @@ instance PluginMethod Request Method_TextDocumentDocumentSymbol 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) + pluginEnabled _ msgParams pluginDesc config = pluginEnabledConfig plcCompletionOn (configForPlugin config pluginDesc) instance PluginMethod Request Method_TextDocumentCompletion where pluginEnabled _ msgParams pluginDesc config = pluginResponsible uri pluginDesc @@ -1052,13 +1048,11 @@ mkCodeActionHandlerWithResolve codeActionMethod codeResolveMethod = resolveCodeAction ideState pid (InR codeAction) = fmap (InR . dropData) $ ExceptT $ codeResolveMethod ideState pid codeAction --- |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. +-- |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 @@ -1075,17 +1069,8 @@ mkCodeActionWithResolveAndCommand plId codeActionMethod codeResolveMethod = -- resolve data type to allow the server to know who to send the resolve request to supportsCodeActionResolve caps -> pure $ InL (wrapCodeActionResolveData pid <$> ls) - {- 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! - -} + -- 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) @@ -1096,29 +1081,19 @@ mkCodeActionWithResolveAndCommand plId codeActionMethod codeResolveMethod = 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 - -- 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. + -- 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 "Applying edits for code action..." Cancellable $ do + withIndefiniteProgress "Executing code action..." Cancellable $ do resolveResult <- resolveProvider ideState pluginId ca case resolveResult of - Right CodeAction {_edit = Just wedits, ..} -> - if | ca ^. L.title == _title - , ca ^. L.kind == _kind - , ca ^. L.diagnostics == _diagnostics - , ca ^. L.command == _command - , ca ^. L.isPreferred == _isPreferred - , ca ^. L.data_ == _data_ - , ca ^. L.disabled == _disabled -> do - _ <- sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedits) (\_ -> pure ()) - pure $ Right Data.Aeson.Null - | otherwise -> pure $ Left $ responseError "CodeAction fields beside edit changed during resolve" + 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