From b71df3155a9d04afac78d9ab06318149f2ff4612 Mon Sep 17 00:00:00 2001 From: Oliver Madine Date: Thu, 8 Apr 2021 21:26:58 +0100 Subject: [PATCH 1/3] fix: #1694 infix holes are now filled with the infix notation --- .../src/Development/IDE/Plugin/CodeAction.hs | 22 ++++++++----- ghcide/test/exe/Main.hs | 31 +++++++++++++++++++ 2 files changed, 46 insertions(+), 7 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index 59c49bc740..ed9972e274 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 e02f13c709..2251359443 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -2386,6 +2386,37 @@ fillTypedHoleTests = let executeCodeAction chosen modifiedCode <- documentContents doc liftIO $ mkDoc "E.toException" @=? modifiedCode + , expectFailBecause "filling infix type holes with infix functions is unsupported" $ + 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 + , expectFailBecause "filling infix type holes with infix functions is unsupported" $ + 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 From 1b1c79d8c0a60ab784a7f43528bc69163427185e Mon Sep 17 00:00:00 2001 From: Oliver Madine Date: Thu, 8 Apr 2021 21:34:23 +0100 Subject: [PATCH 2/3] style: removed whitespace --- ghcide/src/Development/IDE/Plugin/CodeAction.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index ed9972e274..75a9aa1024 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -678,7 +678,7 @@ suggestFillHole :: Diagnostic -> [(T.Text, TextEdit)] suggestFillHole Diagnostic{_range=_range,..} | Just holeName <- extractHoleName _message , (holeFits, refFits) <- processHoleSuggestions (T.lines _message) = - let isInfixHole = _message =~ addBackticks holeName :: Bool in + let isInfixHole = _message =~ addBackticks holeName :: Bool in map (proposeHoleFit holeName False isInfixHole) holeFits ++ map (proposeHoleFit holeName True isInfixHole) refFits | otherwise = [] From 17a3a06db6f25fbbbd7041a6e2a0e7f262e50007 Mon Sep 17 00:00:00 2001 From: Oliver Madine Date: Thu, 8 Apr 2021 21:37:46 +0100 Subject: [PATCH 3/3] removed expected failure as infix hole replacements are now supported --- ghcide/test/exe/Main.hs | 60 ++++++++++++++++++++--------------------- 1 file changed, 29 insertions(+), 31 deletions(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 2251359443..37d3d2f4e8 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -2386,37 +2386,35 @@ fillTypedHoleTests = let executeCodeAction chosen modifiedCode <- documentContents doc liftIO $ mkDoc "E.toException" @=? modifiedCode - , expectFailBecause "filling infix type holes with infix functions is unsupported" $ - 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 - , expectFailBecause "filling infix type holes with infix functions is unsupported" $ - 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 + , 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 "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