From 48fcff2ed10efc12134b959f7d93bd4693ccc728 Mon Sep 17 00:00:00 2001 From: Potato Hatsue <1793913507@qq.com> Date: Fri, 12 Mar 2021 14:49:30 +0800 Subject: [PATCH 1/4] Add custom code action kinds for import related code actions --- .../src/Development/IDE/Plugin/CodeAction.hs | 38 ++++++++++++------- .../Development/IDE/Plugin/CodeAction/Args.hs | 2 +- 2 files changed, 25 insertions(+), 15 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index 547f99d154..3e74545333 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -35,6 +35,7 @@ import Data.Maybe import qualified Data.Rope.UTF16 as Rope import qualified Data.Set as S import qualified Data.Text as T +import Data.Tuple.Extra (fst3) import Development.IDE.Core.RuleTypes import Development.IDE.Core.Rules import Development.IDE.Core.Service @@ -740,7 +741,7 @@ getIndentedGroupsBy pred inp = case dropWhile (not.pred) inp of indentation :: T.Text -> Int indentation = T.length . T.takeWhile isSpace -suggestExtendImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, Rewrite)] +suggestExtendImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, CodeActionKind, Rewrite)] suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_range,..} | Just [binding, mod, srcspan] <- matchRegexUnifySpaces _message @@ -759,6 +760,7 @@ suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_ Just decl <- findImportDeclByRange decls range, Just ident <- lookupExportMap binding mod = [ ( "Add " <> renderImportStyle importStyle <> " to the import list of " <> mod + , quickFixImportKind' "extend" importStyle , uncurry extendImport (unImportStyle importStyle) decl ) | importStyle <- NE.toList $ importStyles ident @@ -1138,7 +1140,7 @@ removeRedundantConstraints mContents Diagnostic{..} ------------------------------------------------------------------------------------------------- -suggestNewOrExtendImportForClassMethod :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, [Either TextEdit Rewrite])] +suggestNewOrExtendImportForClassMethod :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, CodeActionKind, [Either TextEdit Rewrite])] suggestNewOrExtendImportForClassMethod packageExportsMap ps Diagnostic {_message} | Just [methodName, className] <- matchRegexUnifySpaces @@ -1157,6 +1159,7 @@ suggestNewOrExtendImportForClassMethod packageExportsMap ps Diagnostic {_message -- extend Just decl -> [ ( "Add " <> renderImportStyle style <> " to the import list of " <> moduleNameText, + quickFixImportKind' "extend" style, [Right $ uncurry extendImport (unImportStyle style) decl] ) | style <- importStyle @@ -1165,15 +1168,15 @@ suggestNewOrExtendImportForClassMethod packageExportsMap ps Diagnostic {_message _ | Just (range, indent) <- newImportInsertRange ps -> - (\(unNewImport -> x) -> (x, [Left $ TextEdit range (x <> "\n" <> T.replicate indent " ")])) <$> - [ newUnqualImport moduleNameText rendered False + (\(kind, unNewImport -> x) -> (x, kind, [Left $ TextEdit range (x <> "\n" <> T.replicate indent " ")])) <$> + [ (quickFixImportKind' "new" style, newUnqualImport moduleNameText rendered False) | style <- importStyle, let rendered = renderImportStyle style ] - <> [newImportAll moduleNameText] + <> [(quickFixImportKind "new.all", newImportAll moduleNameText)] | otherwise -> [] -suggestNewImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, TextEdit)] +suggestNewImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)] suggestNewImport packageExportsMap ps@(L _ HsModule {..}) Diagnostic{_message} | msg <- unifySpaces _message , Just thingMissing <- extractNotInScopeName msg @@ -1186,14 +1189,14 @@ suggestNewImport packageExportsMap ps@(L _ HsModule {..}) Diagnostic{_message} , Just (range, indent) <- newImportInsertRange ps , extendImportSuggestions <- matchRegexUnifySpaces msg "Perhaps you want to add ‘[^’]*’ to the import list in the import of ‘([^’]*)’" - = sortOn fst [(imp, TextEdit range (imp <> "\n" <> T.replicate indent " ")) - | (unNewImport -> imp) <- constructNewImportSuggestions packageExportsMap (qual <|> qual', thingMissing) extendImportSuggestions + = sortOn fst3 [(imp, kind, TextEdit range (imp <> "\n" <> T.replicate indent " ")) + | (kind, unNewImport -> imp) <- constructNewImportSuggestions packageExportsMap (qual <|> qual', thingMissing) extendImportSuggestions ] suggestNewImport _ _ _ = [] constructNewImportSuggestions - :: ExportsMap -> (Maybe T.Text, NotInScope) -> Maybe [T.Text] -> [NewImport] -constructNewImportSuggestions exportsMap (qual, thingMissing) notTheseModules = nubOrd + :: ExportsMap -> (Maybe T.Text, NotInScope) -> Maybe [T.Text] -> [(CodeActionKind, NewImport)] +constructNewImportSuggestions exportsMap (qual, thingMissing) notTheseModules = nubOrdOn snd [ suggestion | Just name <- [T.stripPrefix (maybe "" (<> ".") qual) $ notInScope thingMissing] , identInfo <- maybe [] Set.toList $ Map.lookup name (getExportsMap exportsMap) @@ -1202,14 +1205,14 @@ constructNewImportSuggestions exportsMap (qual, thingMissing) notTheseModules = , suggestion <- renderNewImport identInfo ] where - renderNewImport :: IdentInfo -> [NewImport] + renderNewImport :: IdentInfo -> [(CodeActionKind, NewImport)] renderNewImport identInfo | Just q <- qual - = [newQualImport m q] + = [(quickFixImportKind "new.qualified", newQualImport m q)] | otherwise - = [newUnqualImport m (renderImportStyle importStyle) False + = [(quickFixImportKind' "new" importStyle, newUnqualImport m (renderImportStyle importStyle) False) | importStyle <- NE.toList $ importStyles identInfo] ++ - [newImportAll m] + [(quickFixImportKind "new.all", newImportAll m)] where m = moduleNameText identInfo @@ -1554,3 +1557,10 @@ renderImportStyle (ImportViaParent x p) = p <> "(" <> x <> ")" unImportStyle :: ImportStyle -> (Maybe String, String) unImportStyle (ImportTopLevel x) = (Nothing, T.unpack x) unImportStyle (ImportViaParent x y) = (Just $ T.unpack y, T.unpack x) + +quickFixImportKind' :: T.Text -> ImportStyle -> CodeActionKind +quickFixImportKind' x (ImportTopLevel _) = CodeActionUnknown $ "quickfix.import." <> x <> ".identifier.top" +quickFixImportKind' x (ImportViaParent _ _) = CodeActionUnknown $ "quickfix.import." <> x <> ".identifier.parent" + +quickFixImportKind :: T.Text -> CodeActionKind +quickFixImportKind x = CodeActionUnknown $ "quickfix.import." <> x diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs index 167d237519..a5d29bce7e 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs @@ -116,7 +116,7 @@ instance ToTextEdit a => ToCodeAction (CodeActionTitle, CodeActionKind, a) where toCodeAction caa (title, kind, te) = [(title, Just kind, Nothing, toTextEdit caa te)] instance ToTextEdit a => ToCodeAction (CodeActionTitle, CodeActionPreferred, a) where - toCodeAction caa (title, isPreferred, te) = [(title, Nothing, Just isPreferred, toTextEdit caa te)] + toCodeAction caa (title, isPreferred, te) = [(title, Just CodeActionQuickFix, Just isPreferred, toTextEdit caa te)] instance ToTextEdit a => ToCodeAction (CodeActionTitle, CodeActionKind, CodeActionPreferred, a) where toCodeAction caa (title, kind, isPreferred, te) = [(title, Just kind, Just isPreferred, toTextEdit caa te)] From 92636f1be4c15fe50206db5de181bf6e5d84ce95 Mon Sep 17 00:00:00 2001 From: Potato Hatsue <1793913507@qq.com> Date: Sun, 14 Mar 2021 13:17:17 +0800 Subject: [PATCH 2/4] Rename: identifier -> thing --- ghcide/src/Development/IDE/Plugin/CodeAction.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index 3e74545333..4556af361f 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -1559,8 +1559,8 @@ unImportStyle (ImportTopLevel x) = (Nothing, T.unpack x) unImportStyle (ImportViaParent x y) = (Just $ T.unpack y, T.unpack x) quickFixImportKind' :: T.Text -> ImportStyle -> CodeActionKind -quickFixImportKind' x (ImportTopLevel _) = CodeActionUnknown $ "quickfix.import." <> x <> ".identifier.top" -quickFixImportKind' x (ImportViaParent _ _) = CodeActionUnknown $ "quickfix.import." <> x <> ".identifier.parent" +quickFixImportKind' x (ImportTopLevel _) = CodeActionUnknown $ "quickfix.import." <> x <> ".thing.topLevel" +quickFixImportKind' x (ImportViaParent _ _) = CodeActionUnknown $ "quickfix.import." <> x <> ".thing.withParent" quickFixImportKind :: T.Text -> CodeActionKind quickFixImportKind x = CodeActionUnknown $ "quickfix.import." <> x From 573ba1a192850fe785947b5bfe26dc3081b02233 Mon Sep 17 00:00:00 2001 From: Potato Hatsue <1793913507@qq.com> Date: Sun, 14 Mar 2021 15:03:22 +0800 Subject: [PATCH 3/4] Rename: thing -> list --- ghcide/src/Development/IDE/Plugin/CodeAction.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index 4556af361f..a1b54841bc 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -1559,8 +1559,8 @@ unImportStyle (ImportTopLevel x) = (Nothing, T.unpack x) unImportStyle (ImportViaParent x y) = (Just $ T.unpack y, T.unpack x) quickFixImportKind' :: T.Text -> ImportStyle -> CodeActionKind -quickFixImportKind' x (ImportTopLevel _) = CodeActionUnknown $ "quickfix.import." <> x <> ".thing.topLevel" -quickFixImportKind' x (ImportViaParent _ _) = CodeActionUnknown $ "quickfix.import." <> x <> ".thing.withParent" +quickFixImportKind' x (ImportTopLevel _) = CodeActionUnknown $ "quickfix.import." <> x <> ".list.topLevel" +quickFixImportKind' x (ImportViaParent _ _) = CodeActionUnknown $ "quickfix.import." <> x <> ".list.withParent" quickFixImportKind :: T.Text -> CodeActionKind quickFixImportKind x = CodeActionUnknown $ "quickfix.import." <> x From 28807edfaf339cbfc1141f6ddeb4baefc3cec4c7 Mon Sep 17 00:00:00 2001 From: Potato Hatsue <1793913507@qq.com> Date: Sun, 14 Mar 2021 15:04:54 +0800 Subject: [PATCH 4/4] Remove an assertion of code action kinds in func-test --- test/functional/FunctionalCodeAction.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs index 8bf0803799..f9d4fe8376 100644 --- a/test/functional/FunctionalCodeAction.hs +++ b/test/functional/FunctionalCodeAction.hs @@ -275,8 +275,6 @@ importTests = testGroup "import suggestions" [ importControlMonad <- liftIO $ inspectCodeAction actionsOrCommands ["import Control.Monad"] liftIO $ do expectCodeAction actionsOrCommands ["import Control.Monad (when)"] - forM_ actns $ \a -> do - a ^. L.kind @?= Just CodeActionQuickFix length actns >= 10 @? "There are some actions" executeCodeAction importControlMonad