From ab1746cba0c60d9e425420020df30521ef887ff1 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/5] 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 eccd810c5b..1c5a4e6388 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 2c0a412dcdb45730dd250ed21498a2340c08013b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ondr=CC=8Cej=20Weis?= Date: Sat, 13 Jun 2026 22:48:58 +0200 Subject: [PATCH 2/5] Remove unused function haddock comment * Tweak unused binding test * Refactor findRelatedSigSpan to avoid inner let * Use epaLocationRealSrcSpan * Revert unused annotated type * Fixup for GHC 9.10 * Just give up for GHC=<9.8 * Add comments --- .../src/Development/IDE/Plugin/CodeAction.hs | 80 +++++++++++++------ plugins/hls-refactor-plugin/test/Main.hs | 5 +- 2 files changed, 59 insertions(+), 26 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 091b99eb8b..822e9b0863 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -118,6 +118,7 @@ import GHC (AddEpAnn (Ad #if MIN_VERSION_ghc(9,9,0) && !MIN_VERSION_ghc(9,11,0) import GHC (AddEpAnn (AddEpAnn), AnnsModule (am_main), + EpAnnComments (..), EpaLocation, EpaLocation' (..), HasLoc (..)) @@ -125,10 +126,12 @@ import GHC (AddEpAnn (Ad #if MIN_VERSION_ghc(9,11,0) import GHC (AnnsModule (am_where), + EpAnnComments (..), EpToken (..), EpaLocation, EpaLocation' (..), HasLoc (..)) +import GHC.Parser.Annotation (epaLocationRealSrcSpan) #endif @@ -141,7 +144,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 @@ -601,29 +604,25 @@ 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 + hsmodSigs = [L l sig | L l (SigD _ sig) <- hsmodDecls] relatedRanges indexedContent name = concatMap (findRelatedSpans indexedContent name . reLoc) hsmodDecls toRange = realSrcSpanToRange extendForSpaces = extendToIncludePreviousNewlineIfPossible findRelatedSpans :: PositionIndexedString -> String -> Located (HsDecl GhcPs) -> [Range] - findRelatedSpans - indexedContent - name - (L (RealSrcSpan l _) (ValD _ (extractNameAndMatchesFromFunBind -> Just (lname, matches)))) = - case lname of + findRelatedSpans indexedContent name decl = case decl of + (L (RealSrcSpan l _) (ValD _ (extractNameAndMatchesFromFunBind -> Just (lname, matches)))) + -> 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) : - concatMap (findSig . reLoc) hsmodDecls + extendForSpaces indexedContent (toRange l) + : concatMap (findRelatedSigSpan' indexedContent name) hsmodSigs _ -> concatMap (findRelatedSpanForMatch indexedContent name) matches - findRelatedSpans _ _ _ = [] + _ -> [] extractNameAndMatchesFromFunBind :: HsBind GhcPs @@ -635,13 +634,23 @@ suggestDeleteUnusedBinding } = Just (reLoc lname, matches) extractNameAndMatchesFromFunBind _ = Nothing - 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 (RealSrcSpan span _, False) -> pure $ toRange span -- a, b :: Int, a is unused - _ -> [] + -- | For given name, find the span of related type signature. + findRelatedSigSpan' :: PositionIndexedString -> String -> LSig GhcPs -> [Range] + findRelatedSigSpan' indexedContent name = \case +#if MIN_VERSION_ghc(9,9,0) + (L (EpAnn sigSpan _ c) sig) -> + let l = epaLocationRealSrcSpan sigSpan + in case findRelatedSigSpan1 name sig of + -- On GHC 9.10+ this will include Haddock comments. + Just (_span, True) -> pure . extendForSpaces indexedContent . toRange $ l `withCommentSpan` c +#else + (reLoc -> L (RealSrcSpan l _) sig) -> + case findRelatedSigSpan1 name sig of + Just (_span, True) -> pure . extendForSpaces indexedContent . toRange $ l +#endif + Just (RealSrcSpan span _, False) -> pure $ toRange span + _ -> [] + _ -> [] -- Second of the tuple means there is only one match findRelatedSigSpan1 :: String -> Sig GhcPs -> Maybe (SrcSpan, Bool) @@ -712,10 +721,8 @@ suggestDeleteUnusedBinding lsigs (L (locA -> (RealSrcSpan l _)) (extractNameAndMatchesFromFunBind -> Just (lname, matches))) = if isTheBinding (getLoc lname) - then - let findSig (L (RealSrcSpan l _) sig) = findRelatedSigSpan indexedContent name l sig - findSig _ = [] - in extendForSpaces indexedContent (toRange l) : concatMap (findSig . reLoc) lsigs + then extendForSpaces indexedContent (toRange l) + : concatMap (findRelatedSigSpan' indexedContent name) lsigs else concatMap (findRelatedSpanForMatch indexedContent name) matches findRelatedSpanForHsBind _ _ _ _ = [] @@ -2126,3 +2133,28 @@ matchRegExMultipleImports message = do _ -> Nothing imps <- regExImports imports return (binding, imps) + +#if MIN_VERSION_ghc(9,9,0) +-- | Expand signature span to include Haddock. +withCommentSpan :: RealSrcSpan -> EpAnnComments -> RealSrcSpan +withCommentSpan idL = foldl' combineRealSrcSpans idL . map commsSrc . commsToList + where + commsSrc :: GenLocated (EpaLocation' a) e -> RealSrcSpan + commsSrc (L l _) = epaLocationRealSrcSpan l + commsToList :: EpAnnComments -> [LEpaComment] + commsToList = \case + EpaComments prior -> prior + EpaCommentsBalanced prior following -> prior <> following +#endif + +#if MIN_VERSION_ghc(9,9,0) && !MIN_VERSION_ghc(9,11,0) +-- | Used in the parser only, extract the 'RealSrcSpan' from an +-- 'EpaLocation'. The parser will never insert a 'DeltaPos', so the +-- partial function is safe. +-- +-- GHC compatibility note: +-- EpaLocation' exists since 9.10, but this function was updated in 9.12 +epaLocationRealSrcSpan :: EpaLocation' a -> RealSrcSpan +epaLocationRealSrcSpan (EpaSpan (RealSrcSpan r _)) = r +epaLocationRealSrcSpan _ = panic "epaLocationRealSrcSpan" +#endif diff --git a/plugins/hls-refactor-plugin/test/Main.hs b/plugins/hls-refactor-plugin/test/Main.hs index 1c5a4e6388..81aa685bce 100644 --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -2538,8 +2538,9 @@ deleteUnusedDefinitionTests = testGroup "delete unused definition action" [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "module A (some) where" , "" - , "-- | docs for f" + , "-- | line docs for f" , "f :: Int" + -- TODO: , "-- ^ trailing docs for f" , "f = 1" , "" , "some = ()" @@ -2557,7 +2558,7 @@ deleteUnusedDefinitionTests = testGroup "delete unused definition action" [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "module A (some) where" , "" - , "{-| docs for f" + , "{-| block docs for f" , "-}" , "f :: Int" , "f = 1" From 2f8af6cd92a31440c1c4d77444607126132b820a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ondr=CC=8Cej=20Weis?= Date: Thu, 18 Jun 2026 22:07:15 +0200 Subject: [PATCH 3/5] Disable unused haddock tests on GHC<9.10 --- plugins/hls-refactor-plugin/test/Main.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/plugins/hls-refactor-plugin/test/Main.hs b/plugins/hls-refactor-plugin/test/Main.hs index 81aa685bce..559fc69ad4 100644 --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -2533,7 +2533,8 @@ deleteUnusedDefinitionTests = testGroup "delete unused definition action" , "" , "some = ()" ] - , testSession "delete unused top level binding with Haddock comment" $ + , knownBrokenForGhcVersions [GHC96, GHC98] "Not implemented for GHC <9.10 (AST changed)" $ + testSession "delete unused top level binding with Haddock comment" $ testFor [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "module A (some) where" @@ -2553,7 +2554,8 @@ deleteUnusedDefinitionTests = testGroup "delete unused definition action" , "" , "some = ()" ] - , testSession "delete unused top level binding with block Haddock comment" $ + , knownBrokenForGhcVersions [GHC96, GHC98] "Not implemented for GHC <9.10 (AST changed)" $ + testSession "delete unused top level binding with block Haddock comment" $ testFor [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "module A (some) where" From 75647a6bb1eaf672469a2c2becf19d2532012395 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ondr=CC=8Cej=20Weis?= Date: Thu, 18 Jun 2026 23:01:03 +0200 Subject: [PATCH 4/5] Fix trailing docs with balanceComments --- .../src/Development/IDE/Plugin/CodeAction.hs | 5 +-- .../IDE/Plugin/CodeAction/ExactPrint.hs | 5 ++- plugins/hls-refactor-plugin/test/Main.hs | 31 +++++++++++++++---- 3 files changed, 32 insertions(+), 9 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 822e9b0863..664db906e9 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -608,9 +608,10 @@ suggestDeleteUnusedBinding in ([("Delete ‘" <> name <> "’", edits) | not (null edits)]) | otherwise = [] where - hsmodSigs = [L l sig | L l (SigD _ sig) <- hsmodDecls] + hsmodDeclsWithDocs = balanceCommentsList hsmodDecls + hsmodSigs = [L l sig | L l (SigD _ sig) <- hsmodDeclsWithDocs] relatedRanges indexedContent name = - concatMap (findRelatedSpans indexedContent name . reLoc) hsmodDecls + concatMap (findRelatedSpans indexedContent name . reLoc) hsmodDeclsWithDocs toRange = realSrcSpanToRange extendForSpaces = extendToIncludePreviousNewlineIfPossible diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index 6ef6a9d219..e6230bfccb 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -13,7 +13,10 @@ module Development.IDE.Plugin.CodeAction.ExactPrint ( hideSymbol, liftParseAST, - wildCardSymbol + wildCardSymbol, + + -- * Re-exports + balanceCommentsList, ) where import Control.Monad diff --git a/plugins/hls-refactor-plugin/test/Main.hs b/plugins/hls-refactor-plugin/test/Main.hs index 559fc69ad4..17900f48bd 100644 --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -2534,21 +2534,40 @@ deleteUnusedDefinitionTests = testGroup "delete unused definition action" , "some = ()" ] , knownBrokenForGhcVersions [GHC96, GHC98] "Not implemented for GHC <9.10 (AST changed)" $ - testSession "delete unused top level binding with Haddock comment" $ + testSession "delete unused leading top level binding with Haddock comment" $ testFor [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "module A (some) where" , "" - , "-- | line docs for f" - , "f :: Int" - -- TODO: , "-- ^ trailing docs for f" - , "f = 1" + , "-- | line docs for foo" + , "foo :: Int" + , "foo = 1" , "" , "some = ()" ] (5, 0) 1 - "Delete ‘f’" + "Delete ‘foo’" + [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" + , "module A (some) where" + , "" + , "some = ()" + ] + , knownBrokenForGhcVersions [GHC96, GHC98] "Not implemented for GHC <9.10 (AST changed)" $ + testSession "delete unused trailing top level binding with Haddock comment" $ + testFor + [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" + , "module A (some) where" + , "" + , "oof = 1" + , "oof :: Int" + , "-- ^ trailing docs for oof" + , "" + , "some = ()" + ] + (3, 0) + 1 + "Delete ‘oof’" [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "module A (some) where" , "" From 81a990d54693c4a4b9b31d90c8d1dab9f8c22535 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ondr=CC=8Cej=20Weis?= Date: Thu, 18 Jun 2026 23:24:50 +0200 Subject: [PATCH 5/5] Add sprinkle of CPP to avoid balance on older GHC --- .../src/Development/IDE/Plugin/CodeAction.hs | 4 ++++ 1 file changed, 4 insertions(+) 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 664db906e9..19bdc9c358 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -608,7 +608,11 @@ suggestDeleteUnusedBinding in ([("Delete ‘" <> name <> "’", edits) | not (null edits)]) | otherwise = [] where +#if MIN_VERSION_ghc(9,9,0) hsmodDeclsWithDocs = balanceCommentsList hsmodDecls +#else + hsmodDeclsWithDocs = hsmodDecls -- comments are not deleted on GHC<9.10 +#endif hsmodSigs = [L l sig | L l (SigD _ sig) <- hsmodDeclsWithDocs] relatedRanges indexedContent name = concatMap (findRelatedSpans indexedContent name . reLoc) hsmodDeclsWithDocs