diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index 59c49bc740..75a9aa1024 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -677,16 +677,24 @@ suggestModuleTypo Diagnostic{_range=_range,..} suggestFillHole :: Diagnostic -> [(T.Text, TextEdit)] suggestFillHole Diagnostic{_range=_range,..} | Just holeName <- extractHoleName _message - , (holeFits, refFits) <- processHoleSuggestions (T.lines _message) - = map (proposeHoleFit holeName False) holeFits - ++ map (proposeHoleFit holeName True) refFits + , (holeFits, refFits) <- processHoleSuggestions (T.lines _message) = + let isInfixHole = _message =~ addBackticks holeName :: Bool in + map (proposeHoleFit holeName False isInfixHole) holeFits + ++ map (proposeHoleFit holeName True isInfixHole) refFits | otherwise = [] where extractHoleName = fmap head . flip matchRegexUnifySpaces "Found hole: ([^ ]*)" - proposeHoleFit holeName parenthise name = + addBackticks text = "`" <> text <> "`" + addParens text = "(" <> text <> ")" + proposeHoleFit holeName parenthise isInfixHole name = + let isInfixOperator = T.head name == '(' + name' = getOperatorNotation isInfixHole isInfixOperator name in ( "replace " <> holeName <> " with " <> name - , TextEdit _range $ if parenthise then parens name else name) - parens x = "(" <> x <> ")" + , TextEdit _range (if parenthise then addParens name' else name') + ) + getOperatorNotation True False name = addBackticks name + getOperatorNotation True True name = T.drop 1 (T.dropEnd 1 name) + getOperatorNotation _isInfixHole _isInfixOperator name = name processHoleSuggestions :: [T.Text] -> ([T.Text], [T.Text]) processHoleSuggestions mm = (holeSuggestions, refSuggestions) @@ -858,7 +866,7 @@ suggestImportDisambiguation df (Just txt) ps@(L _ HsModule {hsmodImports}) diag@ | otherwise = case mapM toModuleTarget mods of Just targets -> suggestionsImpl symbol (oneAndOthers targets) Nothing -> [] - suggestionsImpl symbol targetsWithRestImports = + suggestionsImpl symbol targetsWithRestImports = sortOn fst [ ( renderUniquify mode modNameText symbol , disambiguateSymbol ps diag symbol mode diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 8c8e47919d..a45608829d 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -2386,6 +2386,48 @@ fillTypedHoleTests = let executeCodeAction chosen modifiedCode <- documentContents doc liftIO $ mkDoc "E.toException" @=? modifiedCode + , testSession "filling infix type hole uses prefix notation" $ do + let mkDoc x = T.unlines + [ "module Testing where" + , "data A = A" + , "foo :: A -> A -> A" + , "foo A A = A" + , "test :: A -> A -> A" + , "test a1 a2 = a1 " <> x <> " a2" + ] + doc <- createDoc "Test.hs" "haskell" $ mkDoc "`_`" + _ <- waitForDiagnostics + actions <- getCodeActions doc (Range (Position 5 16) (Position 5 19)) + chosen <- liftIO $ pickActionWithTitle "replace _ with foo" actions + executeCodeAction chosen + modifiedCode <- documentContents doc + liftIO $ mkDoc "`foo`" @=? modifiedCode + , testSession "postfix hole uses postfix notation of infix operator" $ do + let mkDoc x = T.unlines + [ "module Testing where" + , "test :: Int -> Int -> Int" + , "test a1 a2 = " <> x <> " a1 a2" + ] + doc <- createDoc "Test.hs" "haskell" $ mkDoc "_" + _ <- waitForDiagnostics + actions <- getCodeActions doc (Range (Position 2 13) (Position 2 14)) + chosen <- liftIO $ pickActionWithTitle "replace _ with (+)" actions + executeCodeAction chosen + modifiedCode <- documentContents doc + liftIO $ mkDoc "(+)" @=? modifiedCode + , testSession "filling infix type hole uses infix operator" $ do + let mkDoc x = T.unlines + [ "module Testing where" + , "test :: Int -> Int -> Int" + , "test a1 a2 = a1 " <> x <> " a2" + ] + doc <- createDoc "Test.hs" "haskell" $ mkDoc "`_`" + _ <- waitForDiagnostics + actions <- getCodeActions doc (Range (Position 2 16) (Position 2 19)) + chosen <- liftIO $ pickActionWithTitle "replace _ with (+)" actions + executeCodeAction chosen + modifiedCode <- documentContents doc + liftIO $ mkDoc "+" @=? modifiedCode ] addInstanceConstraintTests :: TestTree