From ea6093ca026dda88b9e244bc22e56dd9869089e2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ondr=CC=8Cej=20Weis?= Date: Mon, 8 Jun 2026 14:55:17 +0200 Subject: [PATCH 1/3] Add test for deleting unused bindings with Haddock docs Co-authored-by: kunduagam23@gmail.com --- plugins/hls-refactor-plugin/test/Main.hs | 39 ++++++++++++++++++++++++ 1 file changed, 39 insertions(+) diff --git a/plugins/hls-refactor-plugin/test/Main.hs b/plugins/hls-refactor-plugin/test/Main.hs index fafb0d8d28..356f7781d0 100644 --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -2533,6 +2533,45 @@ deleteUnusedDefinitionTests = testGroup "delete unused definition action" , "" , "some = ()" ] + , testSession "delete unused top level binding with Haddock comment" $ + testFor + [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" + , "module A (some) where" + , "" + , "-- | docs for f" + , "f :: Int" + , "f = 1" + , "" + , "some = ()" + ] + (5, 0) + 1 + "Delete ‘f’" + [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" + , "module A (some) where" + , "" + , "some = ()" + ] + , testSession "delete unused top level binding with block Haddock comment" $ + testFor + [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" + , "module A (some) where" + , "" + , "{-| docs for f" + , "-}" + , "f :: Int" + , "f = 1" + , "" + , "some = ()" + ] + (6, 0) + 1 + "Delete ‘f’" + [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" + , "module A (some) where" + , "" + , "some = ()" + ] , testSession "delete unused binding in where clause" $ testFor [ "{-# OPTIONS_GHC -Wunused-binds #-}" From 7ac5faf1ca0306ae07523fd874eacdc53ba0dc18 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ondr=CC=8Cej=20Weis?= Date: Mon, 8 Jun 2026 15:09:29 +0200 Subject: [PATCH 2/3] WIP: Use AST to delete the attached comments --- .../src/Development/IDE/Plugin/CodeAction.hs | 46 +++++++++++++------ 1 file changed, 31 insertions(+), 15 deletions(-) diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index 57f5f9ed18..d3d9203b3b 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -75,7 +75,7 @@ import Development.IDE.Types.Location import Development.IDE.Types.Options import GHC (DeltaPos (..), EpAnn (..), - LEpaComment) + LEpaComment, EpAnnComments (..), realSrcSpan) import GHC.Iface.Ext.Types (ContextInfo (..), IdentifierDetails (..)) import qualified GHC.LanguageExtensions as Lang @@ -128,6 +128,7 @@ import GHC (AnnsModule ( EpaLocation, EpaLocation' (..), HasLoc (..)) +import GHC.Types.SrcLoc (combineSrcSpans) #endif @@ -140,7 +141,7 @@ codeAction state _ (CodeActionParams _ _ (TextDocumentIdentifier uri) range _) = liftIO $ do let mbFile = toNormalizedFilePath' <$> uriToFilePath uri allDiags <- atomically $ fmap fdLspDiagnostic . filter (\d -> mbFile == Just (fdFilePath d)) <$> getDiagnostics state - (join -> parsedModule) <- runAction "GhcideCodeActions.getParsedModule" state $ getParsedModule `traverse` mbFile + (join -> parsedModule) <- runAction "GhcideCodeActions.getParsedModule" state $ getParsedModuleWithComments `traverse` mbFile let textContents = fmap Rope.toText contents actions = caRemoveRedundantImports parsedModule textContents allDiags range uri @@ -600,29 +601,29 @@ suggestDeleteUnusedBinding -- Foo.hs:4:1: warning: [-Wunused-binds] Defined but not used: ‘f’ | Just [name] <- matchRegexUnifySpaces _message ".*Defined but not used: ‘([^ ]+)’" , Just indexedContent <- indexedByPosition . T.unpack <$> contents - = let edits = flip TextEdit "" <$> relatedRanges indexedContent (T.unpack name) + = let edits = flip TextEdit "" <$> mergeRanges (sortOn _start $ relatedRanges indexedContent (T.unpack name)) in ([("Delete ‘" <> name <> "’", edits) | not (null edits)]) | otherwise = [] where relatedRanges indexedContent name = - concatMap (findRelatedSpans indexedContent name . reLoc) hsmodDecls + concatMap (findRelatedSpans indexedContent name) hsmodDecls toRange = realSrcSpanToRange - extendForSpaces = extendToIncludePreviousNewlineIfPossible + extendForDeletion indexedContent = extendToIncludePreviousNewlineIfPossible indexedContent - findRelatedSpans :: PositionIndexedString -> String -> Located (HsDecl GhcPs) -> [Range] - findRelatedSpans - indexedContent - name - (L (RealSrcSpan l _) (ValD _ (extractNameAndMatchesFromFunBind -> Just (lname, matches)))) = - case lname of + findRelatedSpans :: PositionIndexedString -> String -> LHsDecl GhcPs -> [Range] + findRelatedSpans indexedContent name decl = case decl of + (L (EpAnn (EpaSpan (RealSrcSpan l _)) _ c) (ValD _ (extractNameAndMatchesFromFunBind -> Just (lname, matches)))) + -> c `seq` decl `seq` case lname of (L nLoc _name) | isTheBinding nLoc -> let findSig (L (RealSrcSpan l _) (SigD _ sig)) = findRelatedSigSpan indexedContent name l sig findSig _ = [] in - extendForSpaces indexedContent (toRange l) : + extendForDeletion indexedContent (toRange l) : concatMap (findSig . reLoc) hsmodDecls _ -> concatMap (findRelatedSpanForMatch indexedContent name) matches - findRelatedSpans _ _ _ = [] + (L (EpAnn (EpaSpan (RealSrcSpan lname _)) _ c) (SigD _ bind)) + -> bind `seq` [toRange $ joinComms (commsToList c) lname] + _ -> decl `seq` [] extractNameAndMatchesFromFunBind :: HsBind GhcPs @@ -634,11 +635,26 @@ suggestDeleteUnusedBinding } = Just (reLoc lname, matches) extractNameAndMatchesFromFunBind _ = Nothing + joinComms :: [LEpaComment] -> RealSrcSpan -> RealSrcSpan + joinComms comms idL = + let locL (L l _) = l + epaL = \case + EpaSpan l -> l + EpaDelta l _ _ -> l + commsSrc = realSrcSpan . epaL . locL <$> comms + in foldl' combineRealSrcSpans idL commsSrc + + commsToList :: EpAnnComments -> [LEpaComment] + commsToList = \case + EpaComments prior -> prior + EpaCommentsBalanced prior following -> prior <> following + + findRelatedSigSpan :: PositionIndexedString -> String -> RealSrcSpan -> Sig GhcPs -> [Range] findRelatedSigSpan indexedContent name l sig = let maybeSpan = findRelatedSigSpan1 name sig in case maybeSpan of - Just (_span, True) -> pure $ extendForSpaces indexedContent $ toRange l -- a :: Int + Just (_span, True) -> pure $ extendForDeletion indexedContent $ toRange l -- a :: Int Just (RealSrcSpan span _, False) -> pure $ toRange span -- a, b :: Int, a is unused _ -> [] @@ -701,7 +717,7 @@ suggestDeleteUnusedBinding then let findSig (L (RealSrcSpan l _) sig) = findRelatedSigSpan indexedContent name l sig findSig _ = [] - in extendForSpaces indexedContent (toRange l) : concatMap (findSig . reLoc) lsigs + in extendForDeletion indexedContent (toRange l) : concatMap (findSig . reLoc) lsigs else concatMap (findRelatedSpanForMatch indexedContent name) matches findRelatedSpanForHsBind _ _ _ _ = [] From cc86bc7cbc6c86e5b66ccb57d013c815d48debef Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ondr=CC=8Cej=20Weis?= Date: Mon, 8 Jun 2026 15:09:45 +0200 Subject: [PATCH 3/3] Remove preceding white space --- .../src/Development/IDE/Plugin/CodeAction.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index d3d9203b3b..187bbf8a29 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -622,7 +622,7 @@ suggestDeleteUnusedBinding concatMap (findSig . reLoc) hsmodDecls _ -> concatMap (findRelatedSpanForMatch indexedContent name) matches (L (EpAnn (EpaSpan (RealSrcSpan lname _)) _ c) (SigD _ bind)) - -> bind `seq` [toRange $ joinComms (commsToList c) lname] + -> [extendForDeletion indexedContent $ bind `seq` toRange $ joinComms (commsToList c) lname] _ -> decl `seq` [] extractNameAndMatchesFromFunBind