Skip to content

Commit 4f473a9

Browse files
jhrcekjhrcek
authored
refactor plugin: add reproducer and fix for #3795 (#4016)
* refactor plugin: add reproducer for #3795, fix few warnings in test * Simplify reproducer, first attempt at fix
1 parent a29d8e8 commit 4f473a9

File tree

4 files changed

+59
-40
lines changed

4 files changed

+59
-40
lines changed

‎plugins/hls-refactor-plugin/hls-refactor-plugin.cabal‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -102,7 +102,7 @@ test-suite tests
102102
hs-source-dirs: test
103103
main-is: Main.hs
104104
other-modules: Test.AddArgument
105-
ghc-options: -O0 -threaded -rtsopts -with-rtsopts=-N -Wunused-imports
105+
ghc-options: -O0 -threaded -rtsopts -with-rtsopts=-N -Wno-name-shadowing
106106
build-depends:
107107
, base
108108
, filepath

‎plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/Diagnostic.hs‎

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -44,7 +44,10 @@ matchVariableNotInScope message
4444
| otherwise = Nothing
4545
where
4646
matchVariableNotInScopeTyped message
47-
| Just [name, typ] <- matchRegexUnifySpaces message "Variable not in scope: ([^ ]+) :: ([^*•]+)" =
47+
| Just [name, typ0] <- matchRegexUnifySpaces message "Variable not in scope: ([^ ]+) :: ([^*•]+)"
48+
, -- When some name in scope is similar to not-in-scope variable, the type is followed by
49+
-- "Suggested fix: Perhaps use ..."
50+
typ:_ <- T.splitOn " Suggested fix:" typ0 =
4851
Just (name, typ)
4952
| otherwise = Nothing
5053
matchVariableNotInScopeUntyped message

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

Lines changed: 53 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,7 @@
99
{-# LANGUAGE PolyKinds #-}
1010
{-# LANGUAGE RecordWildCards #-}
1111
{-# LANGUAGE TypeOperators #-}
12-
{-# OPTIONS_GHC -Wno-deprecations -Wno-unticked-promoted-constructors #-}
12+
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
1313

1414
module Main
1515
( main
@@ -33,9 +33,7 @@ import Ide.Types
3333
import qualified Language.LSP.Protocol.Lens as L
3434
import Language.LSP.Protocol.Message
3535
import Language.LSP.Protocol.Types hiding
36-
(SemanticTokenAbsolute (length, line),
37-
SemanticTokenRelative (length),
38-
SemanticTokensEdit (_start),
36+
(SemanticTokensEdit (_start),
3937
mkRange)
4038
import Language.LSP.Test
4139
import System.Directory
@@ -81,6 +79,7 @@ tests =
8179
, completionTests
8280
]
8381

82+
initializeTests :: TestTree
8483
initializeTests = withResource acquire release tests
8584
where
8685
tests :: IO (TResponseMessage Method_Initialize) -> TestTree
@@ -640,7 +639,10 @@ renameActionTests = testGroup "rename actions"
640639
doc <- createDoc "Testing.hs" "haskell" content
641640
_ <- waitForDiagnostics
642641
actionsOrCommands <- getCodeActions doc (Range (Position 3 12) (Position 3 20))
643-
[fixTypo] <- pure [action | InR action@CodeAction{ _title = actionTitle } <- actionsOrCommands, "monus" `T.isInfixOf` actionTitle , "Replace" `T.isInfixOf` actionTitle]
642+
[fixTypo] <- pure [action | InR action@CodeAction{ _title = actionTitle } <- actionsOrCommands
643+
, "monus" `T.isInfixOf` actionTitle
644+
, "Replace" `T.isInfixOf` actionTitle
645+
]
644646
executeCodeAction fixTypo
645647
contentAfterAction <- documentContents doc
646648
let expectedContentAfterAction = T.unlines
@@ -659,9 +661,11 @@ renameActionTests = testGroup "rename actions"
659661
, "foo = 'bread"
660662
]
661663
doc <- createDoc "Testing.hs" "haskell" content
662-
diags <- waitForDiagnostics
664+
_ <- waitForDiagnostics
663665
actionsOrCommands <- getCodeActions doc (Range (Position 4 6) (Position 4 12))
664-
[fixTypo] <- pure [action | InR action@CodeAction{ _title = actionTitle } <- actionsOrCommands, "break" `T.isInfixOf` actionTitle ]
666+
[fixTypo] <- pure [action | InR action@CodeAction{ _title = actionTitle } <- actionsOrCommands
667+
, "break" `T.isInfixOf` actionTitle
668+
]
665669
executeCodeAction fixTypo
666670
contentAfterAction <- documentContents doc
667671
let expectedContentAfterAction = T.unlines
@@ -776,9 +780,9 @@ typeWildCardActionTests = testGroup "type wildcard actions"
776780
doc <- createDoc "Testing.hs" "haskell" content
777781
_ <- waitForDiagnostics
778782
actionsOrCommands <- getAllCodeActions doc
779-
let [addSignature] = [action | InR action@CodeAction { _title = actionTitle } <- actionsOrCommands
780-
, "Use type signature" `T.isInfixOf` actionTitle
781-
]
783+
[addSignature] <- pure [action | InR action@CodeAction { _title = actionTitle } <- actionsOrCommands
784+
, "Use type signature" `T.isInfixOf` actionTitle
785+
]
782786
executeCodeAction addSignature
783787
contentAfterAction <- documentContents doc
784788
liftIO $ expectedContentAfterAction @=? contentAfterAction
@@ -1782,7 +1786,7 @@ suggestAddRecordFieldImportTests = testGroup "suggest imports of record fields w
17821786
doc <- createDoc "Test.hs" "haskell" before
17831787
waitForProgressDone
17841788
_ <- waitForDiagnostics
1785-
let defLine = fromIntegral $ 1 + 2
1789+
let defLine = 3
17861790
range = Range (Position defLine 0) (Position defLine maxBound)
17871791
actions <- getCodeActions doc range
17881792
action <- liftIO $ pickActionWithTitle "Add foo to the import list of B" actions
@@ -1913,7 +1917,6 @@ suggestImportDisambiguationTests = testGroup "suggest import disambiguation acti
19131917
contentAfterAction <- documentContents doc
19141918
liftIO $ T.replace "\r\n" "\n" expected @=? contentAfterAction
19151919
compareHideFunctionTo = compareTwo "HideFunction.hs"
1916-
auxFiles = ["AVec.hs", "BVec.hs", "CVec.hs", "DVec.hs", "EVec.hs", "FVec.hs"]
19171920
withTarget file locs k = runWithExtraFiles "hiding" $ \dir -> do
19181921
doc <- openDoc file "haskell"
19191922
void $ expectDiagnostics [(file, [(DiagnosticSeverity_Error, loc, "Ambiguous occurrence") | loc <- locs])]
@@ -2122,9 +2125,8 @@ insertNewDefinitionTests = testGroup "insert new definition actions"
21222125
]
21232126
docB <- createDoc "ModuleB.hs" "haskell" (T.unlines $ txtB ++ txtB')
21242127
_ <- waitForDiagnostics
2125-
InR action@CodeAction { _title = actionTitle } : _
2126-
<- filter (\(InR CodeAction{_title=x}) -> "Define" `T.isPrefixOf` x) <$>
2127-
getCodeActions docB (R 0 0 0 50)
2128+
action@CodeAction { _title = actionTitle } : _
2129+
<- findCodeActionsByPrefix docB (R 0 0 0 50) ["Define"]
21282130
liftIO $ actionTitle @?= "Define select :: [Bool] -> Bool"
21292131
executeCodeAction action
21302132
contentAfterAction <- documentContents docB
@@ -2134,6 +2136,27 @@ insertNewDefinitionTests = testGroup "insert new definition actions"
21342136
, "select = _"
21352137
]
21362138
++ txtB')
2139+
, testSession "insert new function definition - with similar suggestion in scope" $ do
2140+
doc <- createDoc "Module.hs" "haskell" $ T.unlines
2141+
[ "import Control.Monad" -- brings `mplus` into scope, leading to additional suggestion
2142+
-- "Perhaps use \8216mplus\8217 (imported from Control.Monad)"
2143+
, "f :: Int -> Int"
2144+
, "f x = plus x x"
2145+
]
2146+
_ <- waitForDiagnostics
2147+
action@CodeAction { _title = actionTitle } : _
2148+
<- findCodeActionsByPrefix doc (R 2 0 2 13) ["Define"]
2149+
liftIO $ actionTitle @?= "Define plus :: Int -> Int -> Int"
2150+
executeCodeAction action
2151+
contentAfterAction <- documentContents doc
2152+
liftIO $ contentAfterAction @?= T.unlines
2153+
[ "import Control.Monad"
2154+
, "f :: Int -> Int"
2155+
, "f x = plus x x"
2156+
, ""
2157+
, "plus :: Int -> Int -> Int"
2158+
, "plus = _"
2159+
]
21372160
, testSession "define a hole" $ do
21382161
let txtB =
21392162
["foo True = _select [True]"
@@ -2146,9 +2169,8 @@ insertNewDefinitionTests = testGroup "insert new definition actions"
21462169
]
21472170
docB <- createDoc "ModuleB.hs" "haskell" (T.unlines $ txtB ++ txtB')
21482171
_ <- waitForDiagnostics
2149-
InR action@CodeAction { _title = actionTitle } : _
2150-
<- filter (\(InR CodeAction{_title=x}) -> "Define" `T.isPrefixOf` x) <$>
2151-
getCodeActions docB (R 0 0 0 50)
2172+
action@CodeAction { _title = actionTitle } : _
2173+
<- findCodeActionsByPrefix docB (R 0 0 0 50) ["Define"]
21522174
liftIO $ actionTitle @?= "Define select :: [Bool] -> Bool"
21532175
executeCodeAction action
21542176
contentAfterAction <- documentContents docB
@@ -2180,9 +2202,8 @@ insertNewDefinitionTests = testGroup "insert new definition actions"
21802202
, "haddock = undefined"]
21812203
docB <- createDoc "ModuleB.hs" "haskell" (T.unlines start)
21822204
_ <- waitForDiagnostics
2183-
InR action@CodeAction { _title = actionTitle } : _
2184-
<- filter (\(InR CodeAction{_title=x}) -> "Define" `T.isPrefixOf` x) <$>
2185-
getCodeActions docB (R 1 0 0 50)
2205+
action@CodeAction { _title = actionTitle } : _
2206+
<- findCodeActionsByPrefix docB (R 1 0 0 50) ["Define"]
21862207
liftIO $ actionTitle @?= "Define select :: Int -> Bool"
21872208
executeCodeAction action
21882209
contentAfterAction <- documentContents docB
@@ -2206,9 +2227,8 @@ insertNewDefinitionTests = testGroup "insert new definition actions"
22062227
, "normal = undefined"]
22072228
docB <- createDoc "ModuleB.hs" "haskell" (T.unlines start)
22082229
_ <- waitForDiagnostics
2209-
InR action@CodeAction { _title = actionTitle } : _
2210-
<- filter (\(InR CodeAction{_title=x}) -> "Define" `T.isPrefixOf` x) <$>
2211-
getCodeActions docB (R 1 0 0 50)
2230+
action@CodeAction { _title = actionTitle } : _
2231+
<- findCodeActionsByPrefix docB (R 1 0 0 50) ["Define"]
22122232
liftIO $ actionTitle @?= "Define select :: Int -> Bool"
22132233
executeCodeAction action
22142234
contentAfterAction <- documentContents docB
@@ -2223,9 +2243,8 @@ insertNewDefinitionTests = testGroup "insert new definition actions"
22232243
]
22242244
docB <- createDoc "ModuleB.hs" "haskell" (T.unlines $ txtB ++ txtB')
22252245
_ <- waitForDiagnostics
2226-
InR action@CodeAction { _title = actionTitle } : _
2227-
<- filter (\(InR CodeAction{_title=x}) -> "Define" `T.isPrefixOf` x) <$>
2228-
getCodeActions docB (R 0 0 0 50)
2246+
action@CodeAction { _title = actionTitle } : _ <-
2247+
findCodeActionsByPrefix docB (R 0 0 0 50) ["Define"]
22292248
liftIO $ actionTitle @?= "Define select :: _"
22302249
executeCodeAction action
22312250
contentAfterAction <- documentContents docB
@@ -2237,6 +2256,7 @@ insertNewDefinitionTests = testGroup "insert new definition actions"
22372256
++ txtB')
22382257
]
22392258

2259+
22402260
deleteUnusedDefinitionTests :: TestTree
22412261
deleteUnusedDefinitionTests = testGroup "delete unused definition action"
22422262
[ testSession "delete unused top level binding" $
@@ -2573,8 +2593,10 @@ importRenameActionTests = testGroup "import rename actions"
25732593
]
25742594
doc <- createDoc "Testing.hs" "haskell" content
25752595
_ <- waitForDiagnostics
2576-
actionsOrCommands <- getCodeActions doc (Range (Position 1 8) (Position 1 16))
2577-
let [changeToMap] = [action | InR action@CodeAction{ _title = actionTitle } <- actionsOrCommands, ("Data." <> modname) `T.isInfixOf` actionTitle ]
2596+
actionsOrCommands <- getCodeActions doc (R 1 8 1 16)
2597+
[changeToMap] <- pure [action | InR action@CodeAction{ _title = actionTitle } <- actionsOrCommands
2598+
, ("Data." <> modname) `T.isInfixOf` actionTitle
2599+
]
25782600
executeCodeAction changeToMap
25792601
contentAfterAction <- documentContents doc
25802602
let expectedContentAfterAction = T.unlines
@@ -3845,12 +3867,8 @@ pattern R x y x' y' = Range (Position x y) (Position x' y')
38453867
-- Which we need to do on macOS since the $TMPDIR can be in @/private/var@ or
38463868
-- @/var@
38473869
withTempDir :: (FilePath -> IO a) -> IO a
3848-
withTempDir f = System.IO.Extra.withTempDir $ \dir -> do
3849-
dir' <- canonicalizePath dir
3850-
f dir'
3851-
3852-
ignoreForGHC92 :: String -> TestTree -> TestTree
3853-
ignoreForGHC92 = ignoreForGhcVersions [GHC92]
3870+
withTempDir f = System.IO.Extra.withTempDir $ \dir ->
3871+
canonicalizePath dir >>= f
38543872

38553873
brokenForGHC94 :: String -> TestTree -> TestTree
38563874
brokenForGHC94 = knownBrokenForGhcVersions [GHC94]

‎plugins/hls-refactor-plugin/test/Test/AddArgument.hs‎

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -12,9 +12,7 @@ import Data.List.Extra
1212
import qualified Data.Text as T
1313
import Development.IDE.Types.Location
1414
import Language.LSP.Protocol.Types hiding
15-
(SemanticTokenAbsolute (length, line),
16-
SemanticTokenRelative (length),
17-
SemanticTokensEdit (_start),
15+
(SemanticTokensEdit (_start),
1816
mkRange)
1917
import Language.LSP.Test
2018
import Test.Tasty

0 commit comments

Comments
 (0)