diff --git a/src/Development/IDE/Plugin/CodeAction.hs b/src/Development/IDE/Plugin/CodeAction.hs index 3986001e..f8a72614 100644 --- a/src/Development/IDE/Plugin/CodeAction.hs +++ b/src/Development/IDE/Plugin/CodeAction.hs @@ -90,7 +90,8 @@ codeAction lsp state (TextDocumentIdentifier uri) _range CodeActionContext{_diag contents <- LSP.getVirtualFileFunc lsp $ toNormalizedUri uri let text = Rope.toText . (_text :: VirtualFile -> Rope.Rope) <$> contents mbFile = toNormalizedFilePath' <$> uriToFilePath uri - (ideOptions, parsedModule, join -> env) <- runAction "CodeAction" state $ + diag <- fmap (\(_, _, d) -> d) . filter (\(p, _, _) -> mbFile == Just p) <$> getDiagnostics state + (ideOptions, join -> parsedModule, join -> env) <- runAction "CodeAction" state $ (,,) <$> getIdeOptions <*> getParsedModule `traverse` mbFile <*> use GhcSession `traverse` mbFile @@ -99,11 +100,11 @@ codeAction lsp state (TextDocumentIdentifier uri) _range CodeActionContext{_diag localExports <- readVar (exportsMap $ shakeExtras state) let exportsMap = localExports <> fromMaybe mempty pkgExports let dflags = hsc_dflags . hscEnv <$> env - pure $ Right + pure . Right $ [ CACodeAction $ CodeAction title (Just CodeActionQuickFix) (Just $ List [x]) (Just edit) Nothing - | x <- xs, (title, tedit) <- suggestAction dflags exportsMap ideOptions ( join parsedModule ) text x + | x <- xs, (title, tedit) <- suggestAction dflags exportsMap ideOptions parsedModule text x , let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing - ] + ] <> caRemoveRedundantImports parsedModule text diag xs uri -- | Generate code lenses. codeLens @@ -173,7 +174,6 @@ suggestAction dflags packageExports ideOptions parsedModule text diag = concat ] ++ concat [ suggestConstraint pm text diag ++ suggestNewDefinition ideOptions pm text diag - ++ suggestRemoveRedundantImport pm text diag ++ suggestNewImport packageExports pm diag ++ suggestDeleteUnusedBinding pm text diag ++ suggestExportUnusedTopBinding text pm diag @@ -201,6 +201,35 @@ suggestRemoveRedundantImport ParsedModule{pm_parsed_source = L _ HsModule{hsmod = [("Remove import", [TextEdit (extendToWholeLineIfPossible contents _range) ""])] | otherwise = [] +caRemoveRedundantImports :: Maybe ParsedModule -> Maybe T.Text -> [Diagnostic] -> [Diagnostic] -> Uri -> [CAResult] +caRemoveRedundantImports m contents digs ctxDigs uri + | Just pm <- m, + r <- join $ map (\d -> repeat d `zip` suggestRemoveRedundantImport pm contents d) digs, + not $ null r, + allEdits <- [ e | (_, (_, edits)) <- r, e <- edits], + caRemoveAll <- removeAll allEdits, + ctxEdits <- [ x | x@(d, _) <- r, d `elem` ctxDigs], + caRemoveCtx <- join $ map (\(d, (title, tedit)) -> removeSingle title tedit d) ctxEdits + = caRemoveCtx ++ caRemoveAll + | otherwise = [] + where + removeSingle title tedit diagnostic = [CACodeAction CodeAction{..}] where + _changes = Just $ Map.singleton uri $ List tedit + _title = title + _kind = Just CodeActionQuickFix + _diagnostics = Just $ List [diagnostic] + _documentChanges = Nothing + _edit = Just WorkspaceEdit{..} + _command = Nothing + removeAll tedit = [CACodeAction CodeAction {..}] where + _changes = Just $ Map.singleton uri $ List tedit + _title = "Remove all redundant imports" + _kind = Just CodeActionQuickFix + _diagnostics = Nothing + _documentChanges = Nothing + _edit = Just WorkspaceEdit{..} + _command = Nothing + suggestDeleteUnusedBinding :: ParsedModule -> Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])] suggestDeleteUnusedBinding ParsedModule{pm_parsed_source = L _ HsModule{hsmodDecls}} diff --git a/test/exe/Main.hs b/test/exe/Main.hs index ddd1ca31..6c5a04c0 100644 --- a/test/exe/Main.hs +++ b/test/exe/Main.hs @@ -756,7 +756,7 @@ removeImportTests = testGroup "remove import actions" ] docB <- createDoc "ModuleB.hs" "haskell" contentB _ <- waitForDiagnostics - [CACodeAction action@CodeAction { _title = actionTitle }] + [CACodeAction action@CodeAction { _title = actionTitle }, _] <- getCodeActions docB (Range (Position 2 0) (Position 2 5)) liftIO $ "Remove import" @=? actionTitle executeCodeAction action @@ -782,7 +782,7 @@ removeImportTests = testGroup "remove import actions" ] docB <- createDoc "ModuleB.hs" "haskell" contentB _ <- waitForDiagnostics - [CACodeAction action@CodeAction { _title = actionTitle }] + [CACodeAction action@CodeAction { _title = actionTitle }, _] <- getCodeActions docB (Range (Position 2 0) (Position 2 5)) liftIO $ "Remove import" @=? actionTitle executeCodeAction action @@ -811,7 +811,7 @@ removeImportTests = testGroup "remove import actions" ] docB <- createDoc "ModuleB.hs" "haskell" contentB _ <- waitForDiagnostics - [CACodeAction action@CodeAction { _title = actionTitle }] + [CACodeAction action@CodeAction { _title = actionTitle }, _] <- getCodeActions docB (Range (Position 2 0) (Position 2 5)) liftIO $ "Remove stuffA, stuffC from import" @=? actionTitle executeCodeAction action @@ -840,7 +840,7 @@ removeImportTests = testGroup "remove import actions" ] docB <- createDoc "ModuleB.hs" "haskell" contentB _ <- waitForDiagnostics - [CACodeAction action@CodeAction { _title = actionTitle }] + [CACodeAction action@CodeAction { _title = actionTitle }, _] <- getCodeActions docB (Range (Position 2 0) (Position 2 5)) liftIO $ "Remove !!, from import" @=? actionTitle executeCodeAction action @@ -868,7 +868,7 @@ removeImportTests = testGroup "remove import actions" ] docB <- createDoc "ModuleB.hs" "haskell" contentB _ <- waitForDiagnostics - [CACodeAction action@CodeAction { _title = actionTitle }] + [CACodeAction action@CodeAction { _title = actionTitle }, _] <- getCodeActions docB (Range (Position 2 0) (Position 2 5)) liftIO $ "Remove A from import" @=? actionTitle executeCodeAction action @@ -895,7 +895,7 @@ removeImportTests = testGroup "remove import actions" ] docB <- createDoc "ModuleB.hs" "haskell" contentB _ <- waitForDiagnostics - [CACodeAction action@CodeAction { _title = actionTitle }] + [CACodeAction action@CodeAction { _title = actionTitle }, _] <- getCodeActions docB (Range (Position 2 0) (Position 2 5)) liftIO $ "Remove A, E, F from import" @=? actionTitle executeCodeAction action @@ -919,7 +919,7 @@ removeImportTests = testGroup "remove import actions" ] docB <- createDoc "ModuleB.hs" "haskell" contentB _ <- waitForDiagnostics - [CACodeAction action@CodeAction { _title = actionTitle }] + [CACodeAction action@CodeAction { _title = actionTitle }, _] <- getCodeActions docB (Range (Position 2 0) (Position 2 5)) liftIO $ "Remove import" @=? actionTitle executeCodeAction action @@ -929,6 +929,38 @@ removeImportTests = testGroup "remove import actions" , "module ModuleB where" ] liftIO $ expectedContentAfterAction @=? contentAfterAction + , testSession "remove all" $ do + let content = T.unlines + [ "{-# OPTIONS_GHC -Wunused-imports #-}" + , "module ModuleA where" + , "import Data.Function (fix, (&))" + , "import qualified Data.Functor.Const" + , "import Data.Functor.Identity" + , "import Data.Functor.Sum (Sum (InL, InR))" + , "import qualified Data.Kind as K (Constraint, Type)" + , "x = InL (Identity 123)" + , "y = fix id" + , "type T = K.Type" + ] + doc <- createDoc "ModuleC.hs" "haskell" content + _ <- waitForDiagnostics + [_, _, _, _, CACodeAction action@CodeAction { _title = actionTitle }] + <- getCodeActions doc (Range (Position 2 0) (Position 2 5)) + liftIO $ "Remove all redundant imports" @=? actionTitle + executeCodeAction action + contentAfterAction <- documentContents doc + let expectedContentAfterAction = T.unlines + [ "{-# OPTIONS_GHC -Wunused-imports #-}" + , "module ModuleA where" + , "import Data.Function (fix)" + , "import Data.Functor.Identity" + , "import Data.Functor.Sum (Sum (InL))" + , "import qualified Data.Kind as K (Type)" + , "x = InL (Identity 123)" + , "y = fix id" + , "type T = K.Type" + ] + liftIO $ expectedContentAfterAction @=? contentAfterAction ] extendImportTests :: TestTree