Adds a code action to delete all unused bindings. (#4958)

The action finds the suggested bindings to delete, then groups them together based on whether the ranges subsumes each other, and finally deletes the groups.

Closes #4909

Author: olaberglund

plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs

@@ -49,6 +49,7 @@ import           Development.IDE.Core.Service
 import           Development.IDE.Core.Shake                        hiding (Log)
 import           Development.IDE.GHC.Compat                        hiding
                                                                    (ImplicitPrelude)
+import qualified Language.LSP.Protocol.Types                       as TE (TextEdit (..))
 #if !MIN_VERSION_ghc(9,11,0)
 import           Development.IDE.GHC.Compat.Util
 #endif
@@ -144,6 +145,7 @@ codeAction state _ (CodeActionParams _ _ (TextDocumentIdentifier uri) range _) =
       textContents = fmap Rope.toText contents
       actions = caRemoveRedundantImports parsedModule textContents allDiags range uri
                <> caRemoveInvalidExports parsedModule textContents allDiags range uri
+               <> caDeleteUnusedBindings parsedModule textContents allDiags range uri
     pure $ InL actions
 
 -------------------------------------------------------------------------------------------------
@@ -185,7 +187,6 @@ bindingsPluginDescriptor recorder plId = mkExactprintPluginDescriptor recorder $
     , wrap suggestImplicitParameter
     , wrap suggestNewDefinition
     , wrap Development.IDE.Plugin.Plugins.AddArgument.plugin
-    , wrap suggestDeleteUnusedBinding
     ]
     plId
     "Provides various quick fixes for bindings"
@@ -710,6 +711,47 @@ suggestDeleteUnusedBinding
       isSameName :: IdP GhcPs -> String -> Bool
       isSameName x name = T.unpack (printOutputable x) == name
 
+caDeleteUnusedBindings :: Maybe ParsedModule -> Maybe T.Text -> [Diagnostic] -> Range -> Uri -> [Command |? CodeAction]
+caDeleteUnusedBindings m contents allDiags contextRange uri
+  | Just pm <- m,
+    r <- join $ map (\d -> repeat d `zip` suggestDeleteUnusedBinding pm contents d) allDiags,
+    -- `allEdits` contains the representative edits to make.
+    -- Representative means the edit with a range that subsumes the others,
+    -- because GHC emits diagnostics for the top level binding *and* the where clause.
+    allEdits <-
+      -- take the representative and drop the others
+      concatMap headToList $
+      -- deduplicate by creating groups of ranges (same group if any subsumes the other)
+      groupBy subsumesEither
+      -- Sort to put related ranges next to each other
+      (sortOn TE._range [ e | (_, (_, edits)) <- r, e <- edits]),
+    caRemoveAll <- removeAll allEdits,
+    ctxEdits <- [ x | x@(d, _) <- r, d `diagInRange` contextRange],
+    not $ null ctxEdits,
+    caRemoveCtx <- map (\(d, (title, tedit)) -> removeSingle title tedit d) ctxEdits
+      = caRemoveCtx ++ [caRemoveAll]
+  | otherwise = []
+  where
+    removeSingle title tedit diagnostic = mkCA title (Just CodeActionKind_QuickFix) Nothing [diagnostic] WorkspaceEdit{..} where
+        _changes = Just $ M.singleton uri tedit
+        _documentChanges = Nothing
+        _changeAnnotations = Nothing
+    removeAll tedit = InR $ CodeAction{..} where
+        _changes = Just $ M.singleton uri tedit
+        _title = "Delete all unused bindings"
+        _kind = Just CodeActionKind_QuickFix
+        _diagnostics = Nothing
+        _documentChanges = Nothing
+        _edit = Just WorkspaceEdit{..}
+        _isPreferred = Just False
+        _command = Nothing
+        _disabled = Nothing
+        _data_ = Nothing
+        _changeAnnotations = Nothing
+    headToList []      = []
+    headToList (x : _) = [x]
+    subsumesEither (TE._range -> range1) (TE._range -> range2) = subRange range1 range2 || subRange range1 range2
+
 data ExportsAs = ExportName | ExportPattern | ExportFamily | ExportAll
   deriving (Eq)
 

plugins/hls-refactor-plugin/test/Main.hs

@@ -2508,6 +2508,7 @@ deleteUnusedDefinitionTests = testGroup "delete unused definition action"
       , "some = ()"
       ]
       (4, 0)
+      1
       "Delete ‘f’"
       [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
       , "module A (some) where"
@@ -2525,6 +2526,7 @@ deleteUnusedDefinitionTests = testGroup "delete unused definition action"
       , "some = ()"
       ]
       (4, 2)
+      1
       "Delete ‘myPlus’"
       [ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
       , "module A (some) where"
@@ -2547,6 +2549,7 @@ deleteUnusedDefinitionTests = testGroup "delete unused definition action"
       , ""
       ]
       (10, 4)
+      1
       "Delete ‘h’"
       [ "{-# OPTIONS_GHC -Wunused-binds #-}"
       , "module A (h, g) where"
@@ -2570,6 +2573,7 @@ deleteUnusedDefinitionTests = testGroup "delete unused definition action"
       , "c = 5"
       ]
       (4, 0)
+      1
       "Delete ‘a’"
       [ "{-# OPTIONS_GHC -Wunused-binds #-}"
       , "module A (b, c) where"
@@ -2589,6 +2593,7 @@ deleteUnusedDefinitionTests = testGroup "delete unused definition action"
       , "c = 5"
       ]
       (5, 0)
+      1
       "Delete ‘b’"
       [ "{-# OPTIONS_GHC -Wunused-binds #-}"
       , "module A (a, c) where"
@@ -2608,19 +2613,46 @@ deleteUnusedDefinitionTests = testGroup "delete unused definition action"
       , "c = 5"
       ]
       (6, 0)
+      1
       "Delete ‘c’"
       [ "{-# OPTIONS_GHC -Wunused-binds #-}"
       , "module A (a, b) where"
       , ""
       , "a, b :: Int"
       , "a = 3"
       , "b = 4"
+      ],
+  testSession "delete all unused level bindings" $
+    testFor
+      [ "{-# OPTIONS_GHC -Wunused-binds #-}"
+      , "module A (some) where"
+      , ""
+      , "f :: Int -> Int"
+      , "f 1 = let a = 1"
+      , "      in a"
+      , "f 2 = 2"
+      , ""
+      , "some = ()"
+      , "  where"
+      , "    a = 2"
+      , ""
+      , "unusedSome :: ()"
+      , "unusedSome = ()"
+      ]
+      (4, 0)
+      3
+      "Delete all unused bindings"
+      [ "{-# OPTIONS_GHC -Wunused-binds #-}"
+      , "module A (some) where"
+      , ""
+      , "some = ()"
+      , "  where"
       ]
   ]
   where
-    testFor sourceLines pos@(l,c) expectedTitle expectedLines = do
+    testFor sourceLines pos@(l,c) expectedNbrWarnings expectedTitle expectedLines = do
       docId <- createDoc "A.hs" "haskell" $ T.unlines sourceLines
-      expectDiagnostics [ ("A.hs", [(DiagnosticSeverity_Warning, pos, "not used", Nothing)]) ]
+      expectDiagnostics [ ("A.hs", replicate expectedNbrWarnings (DiagnosticSeverity_Warning, pos, "not used", Nothing)) ]
       action <- pickActionWithTitle expectedTitle =<< getCodeActions docId  (R l c l c)
       executeCodeAction action
       contentAfterAction <- documentContents docId