diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index ef6153e3ce..ae3253f6f5 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -192,7 +192,16 @@ instance PluginMethod TextDocumentCodeAction where wasRequested (InR ca) | Nothing <- _only context = True | Just (List allowed) <- _only context - , Just caKind <- ca ^. kind = caKind `elem` allowed + -- See https://github.com/microsoft/language-server-protocol/issues/970 + -- This is somewhat vague, but due to the hierarchical nature of action kinds, we + -- should check whether the requested kind is a *prefix* of the action kind. + -- That means, for example, we will return actions with kinds `quickfix.import` and + -- `quickfix.somethingElse` if the requested kind is `quickfix`. + -- TODO: add helpers in `lsp` for handling code action hierarchies + -- For now we abuse the fact that the JSON representation gives us the hierarchical string. + , Just caKind <- ca ^. kind + , String caKindStr <- toJSON caKind = + any (\k -> k `T.isPrefixOf` caKindStr) [kstr | k <- allowed, let String kstr = toJSON k ] | otherwise = False instance PluginMethod TextDocumentCodeLens where diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs index 85264583ff..6c0bd95c4a 100644 --- a/test/functional/FunctionalCodeAction.hs +++ b/test/functional/FunctionalCodeAction.hs @@ -9,7 +9,7 @@ import Control.Monad import Data.Aeson import qualified Data.HashMap.Strict as HM import Data.List -import qualified Data.Map as M +import qualified Data.Map as M import Data.Maybe import qualified Data.Text as T import Ide.Plugin.Config @@ -527,31 +527,29 @@ unusedTermTests = testGroup "unused term code actions" [ _ <- waitForDiagnosticsFrom doc diags <- getCurrentDiagnostics doc let params = CodeActionParams Nothing Nothing doc (Range (Position 1 0) (Position 4 0)) caContext - caContext = CodeActionContext (List diags) (Just (List [CodeActionRefactorInline])) + caContext = CodeActionContext (List diags) (Just (List [CodeActionRefactor])) caContextAllActions = CodeActionContext (List diags) Nothing -- Verify that we get code actions of at least two different kinds. - ResponseMessage _ _ (Right (List allCodeActions)) + ResponseMessage _ _ (Right (List res)) <- request STextDocumentCodeAction (params & L.context .~ caContextAllActions) liftIO $ do - redundantId <- inspectCodeAction allCodeActions ["Redundant id"] - redundantId ^. L.kind @?= Just CodeActionQuickFix - unfoldFoo <- inspectCodeAction allCodeActions ["Unfold foo"] - unfoldFoo ^. L.kind @?= Just CodeActionRefactorInline + let cas = map fromAction res + kinds = map (^. L.kind) cas + nub kinds @?= [Just CodeActionRefactorInline, Just CodeActionRefactorExtract, Just CodeActionQuickFix] -- Verify that that when we set the only parameter, we only get actions -- of the right kind. ResponseMessage _ _ (Right (List res)) <- request STextDocumentCodeAction params - let cas = map fromAction res - kinds = map (^. L.kind) cas liftIO $ do - not (null kinds) @? "We found an action of kind RefactorInline" - all (Just CodeActionRefactorInline ==) kinds @? "All CodeActionRefactorInline" + let cas = map fromAction res + kinds = map (^. L.kind) cas + nub kinds @?= nub [Just CodeActionRefactorInline, Just CodeActionRefactorExtract] ] expectFailIfGhc9 :: String -> TestTree -> TestTree expectFailIfGhc9 reason = case ghcVersion of GHC90 -> expectFailBecause reason - _ -> id + _ -> id disableWingman :: Session () disableWingman =