Fix: #1690 - Infix typed holes are now filled using infix notation (#…

…1708) * Fix: #1690 - Infix typed holes are now filled using infix notation * fix: postfix hole uses postfix notation of infix operator Co-authored-by: Oliver Madine <[email protected]> Co-authored-by: Javier Neira <[email protected]>
haskell · Apr 13, 2021 · 02d5c66 · 02d5c66
1 parent f1c0969
commit 02d5c66
Show file tree

Hide file tree

Showing 2 changed files with 57 additions and 7 deletions.
diff --git 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
@@ -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