From 693281626ed5d9cf10dff3f5f1866ae2eae7b1a7 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Sun, 9 Jun 2024 15:40:33 +0200 Subject: [PATCH 1/4] let's start with a failing test for removing redundant record field imports --- plugins/hls-refactor-plugin/test/Main.hs | 40 ++++++++++++++++++++++++ 1 file changed, 40 insertions(+) diff --git a/plugins/hls-refactor-plugin/test/Main.hs b/plugins/hls-refactor-plugin/test/Main.hs index a4e5b235d8..ca2acbac9a 100644 --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -1004,6 +1004,46 @@ removeImportTests = testGroup "remove import actions" , "x = a -- Must use something from module A, but not (@.)" ] liftIO $ expectedContentAfterAction @=? contentAfterAction + , testSession "remove redundant record field import" $ do + let contentA = T.unlines + [ "module ModuleA where" + , "data A = A {" + , " a1 :: String," + , " a2 :: Int" + , "}" + , "newA :: A" + , "newA = A {" + , " a1 = \"foo\"," + , " a2 = 1" + , "}" + ] + _docA <- createDoc "ModuleA.hs" "haskell" contentA + let contentB = T.unlines + [ "{-# OPTIONS_GHC -Wunused-imports #-}" + , "module ModuleB where" + , "import ModuleA" + , " ( A (a1, a2)," + , " newA" + , " )" + , "x :: String" + , "x = a1 newA" + ] + docB <- createDoc "ModuleB.hs" "haskell" contentB + _ <- waitForDiagnostics + action <- pickActionWithTitle "Remove a2 from import" =<< getCodeActions docB (R 2 0 5 3) + executeCodeAction action + contentAfterAction <- documentContents docB + let expectedContentAfterAction = T.unlines + [ "{-# OPTIONS_GHC -Wunused-imports #-}" + , "module ModuleB where" + , "import ModuleA" + , " ( A (a1)," + , " newA" + , " )" + , "x :: String" + , "x = a1 newA" + ] + liftIO $ expectedContentAfterAction @=? contentAfterAction ] extendImportTests :: TestTree From 567debd278de2b770194e3e094b758bfbe1894f5 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Mon, 10 Jun 2024 10:48:36 +0200 Subject: [PATCH 2/4] additional case for unused record fields --- .../src/Development/IDE/Plugin/CodeAction.hs | 12 ++++++++++++ 1 file changed, 12 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 5c25c5f960..ecb7aec73e 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -428,6 +428,18 @@ suggestRemoveRedundantImport ParsedModule{pm_parsed_source = L _ HsModule{hsmod , not (null ranges') = [( "Remove " <> bindings <> " from import" , [ TextEdit r "" | r <- ranges' ] )] + -- In case of an unused record field import, the binding from the message will not match any import + -- and the pattern above will not match. + -- In this case, we try if we can extract only a record field name + -- Example: The import of ‘B(b2)’ from module ‘ModuleB’ is redundant + | Just [_, bindings] <- matchRegexUnifySpaces _message "The( qualified)? import of ‘[^’]*\\(([^’]*)\\)’ from module [^ ]* is redundant" + , Just (L _ impDecl) <- find (\(L (locA -> l) _) -> _start _range `isInsideSrcSpan` l && _end _range `isInsideSrcSpan` l ) hsmodImports + , Just c <- contents + , ranges <- map (rangesForBindingImport impDecl . T.unpack) (T.splitOn ", " bindings) + , ranges' <- extendAllToIncludeCommaIfPossible False (indexedByPosition $ T.unpack c) (concat ranges) + , not (null ranges') + = [( "Remove " <> bindings <> " from import" , [ TextEdit r "" | r <- ranges' ] )] + -- File.hs:16:1: warning: -- The import of `Data.List' is redundant -- except perhaps to import instances from `Data.List' From 18679f68b11f339efe48e328b6f6db7db74d60e6 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Mon, 10 Jun 2024 14:06:08 +0200 Subject: [PATCH 3/4] support removing multiple record fields added test case reduced duplication --- .../src/Development/IDE/Plugin/CodeAction.hs | 23 ++++------ plugins/hls-refactor-plugin/test/Main.hs | 46 +++++++++++++++---- 2 files changed, 48 insertions(+), 21 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 ecb7aec73e..c5c655b76e 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -423,19 +423,7 @@ suggestRemoveRedundantImport ParsedModule{pm_parsed_source = L _ HsModule{hsmod | Just [_, bindings] <- matchRegexUnifySpaces _message "The( qualified)? import of ‘([^’]*)’ from module [^ ]* is redundant" , Just (L _ impDecl) <- find (\(L (locA -> l) _) -> _start _range `isInsideSrcSpan` l && _end _range `isInsideSrcSpan` l ) hsmodImports , Just c <- contents - , ranges <- map (rangesForBindingImport impDecl . T.unpack) (T.splitOn ", " bindings) - , ranges' <- extendAllToIncludeCommaIfPossible False (indexedByPosition $ T.unpack c) (concat ranges) - , not (null ranges') - = [( "Remove " <> bindings <> " from import" , [ TextEdit r "" | r <- ranges' ] )] - - -- In case of an unused record field import, the binding from the message will not match any import - -- and the pattern above will not match. - -- In this case, we try if we can extract only a record field name - -- Example: The import of ‘B(b2)’ from module ‘ModuleB’ is redundant - | Just [_, bindings] <- matchRegexUnifySpaces _message "The( qualified)? import of ‘[^’]*\\(([^’]*)\\)’ from module [^ ]* is redundant" - , Just (L _ impDecl) <- find (\(L (locA -> l) _) -> _start _range `isInsideSrcSpan` l && _end _range `isInsideSrcSpan` l ) hsmodImports - , Just c <- contents - , ranges <- map (rangesForBindingImport impDecl . T.unpack) (T.splitOn ", " bindings) + , ranges <- map (rangesForBindingImport impDecl . T.unpack) (T.splitOn ", " bindings >>= trySplitIntoOriginalAndRecordField) , ranges' <- extendAllToIncludeCommaIfPossible False (indexedByPosition $ T.unpack c) (concat ranges) , not (null ranges') = [( "Remove " <> bindings <> " from import" , [ TextEdit r "" | r <- ranges' ] )] @@ -447,6 +435,15 @@ suggestRemoveRedundantImport ParsedModule{pm_parsed_source = L _ HsModule{hsmod | _message =~ ("The( qualified)? import of [^ ]* is redundant" :: String) = [("Remove import", [TextEdit (extendToWholeLineIfPossible contents _range) ""])] | otherwise = [] + where + -- In case of an unused record field import, the binding from the message will not match any import directly + -- In this case, we try if we can additionally extract a record field name + -- Example: The import of ‘B(b2)’ from module ‘ModuleB’ is redundant + trySplitIntoOriginalAndRecordField :: T.Text -> [T.Text] + trySplitIntoOriginalAndRecordField binding = + case matchRegexUnifySpaces binding "([^ ]+)\\(([^)]+)\\)" of + Just [_, fields] -> [binding, fields] + _ -> [binding] diagInRange :: Diagnostic -> Range -> Bool diagInRange Diagnostic {_range = dr} r = dr `subRange` extendedRange diff --git a/plugins/hls-refactor-plugin/test/Main.hs b/plugins/hls-refactor-plugin/test/Main.hs index 87e85a3229..029561af55 100644 --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -1011,11 +1011,7 @@ removeImportTests = testGroup "remove import actions" , " a1 :: String," , " a2 :: Int" , "}" - , "newA :: A" - , "newA = A {" - , " a1 = \"foo\"," - , " a2 = 1" - , "}" + , "newA = A \"foo\" 42" ] _docA <- createDoc "ModuleA.hs" "haskell" contentA let contentB = T.unlines @@ -1025,12 +1021,11 @@ removeImportTests = testGroup "remove import actions" , " ( A (a1, a2)," , " newA" , " )" - , "x :: String" , "x = a1 newA" ] docB <- createDoc "ModuleB.hs" "haskell" contentB _ <- waitForDiagnostics - action <- pickActionWithTitle "Remove a2 from import" =<< getCodeActions docB (R 2 0 5 3) + action <- pickActionWithTitle "Remove A(a2) from import" =<< getCodeActions docB (R 2 0 5 3) executeCodeAction action contentAfterAction <- documentContents docB let expectedContentAfterAction = T.unlines @@ -1040,10 +1035,45 @@ removeImportTests = testGroup "remove import actions" , " ( A (a1)," , " newA" , " )" - , "x :: String" , "x = a1 newA" ] liftIO $ expectedContentAfterAction @=? contentAfterAction + , testSession "remove multiple redundant record field imports" $ do + let contentA = T.unlines + [ "module ModuleA where" + , "data A = A {" + , " a1 :: String," + , " a2 :: Int," + , " a3 :: Int," + , " a4 :: Int" + , "}" + , "newA = A \"foo\" 2 3 4" + ] + _docA <- createDoc "ModuleA.hs" "haskell" contentA + let contentB = T.unlines + [ "{-# OPTIONS_GHC -Wunused-imports #-}" + , "module ModuleB where" + , "import ModuleA" + , " ( A (a1, a2, a3, a4)," + , " newA" + , " )" + , "x = a2 newA" + ] + docB <- createDoc "ModuleB.hs" "haskell" contentB + _ <- waitForDiagnostics + action <- pickActionWithTitle "Remove A(a1), A(a3), A(a4) from import" =<< getCodeActions docB (R 2 0 5 3) + executeCodeAction action + contentAfterAction <- documentContents docB + let expectedContentAfterAction = T.unlines + [ "{-# OPTIONS_GHC -Wunused-imports #-}" + , "module ModuleB where" + , "import ModuleA" + , " ( A (a2)," + , " newA" + , " )" + , "x = a2 newA" + ] + liftIO $ expectedContentAfterAction @=? contentAfterAction ] extendImportTests :: TestTree From aab727f23314bdbc3d34dfeaff653f231c77bbdd Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Mon, 10 Jun 2024 14:29:35 +0200 Subject: [PATCH 4/4] formatting --- .../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 628453f9bf..0fcea4a3ff 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -442,7 +442,7 @@ suggestRemoveRedundantImport ParsedModule{pm_parsed_source = L _ HsModule{hsmod trySplitIntoOriginalAndRecordField binding = case matchRegexUnifySpaces binding "([^ ]+)\\(([^)]+)\\)" of Just [_, fields] -> [binding, fields] - _ -> [binding] + _ -> [binding] diagInRange :: Diagnostic -> Range -> Bool diagInRange Diagnostic {_range = dr} r = dr `subRange` extendedRange