Limit number of valid hole fits to 10 (#4288)

* ghcide: Pass -fmax-valid-hole-fits=10 to GHC

In cases where GHC doesn't know anything about the type of a hole, it suggests
every available symbol as a hole fit, which can cause editors to crash or at
least be very slow. 10 seems to be a fair number to limit hole fits to.

* hls-refactor-plugin: Ignore "Some hole fits suppressed" message when valid hole fits are limited

* hls-refactor-plugin: More predictable hole fit for test

Now that we limit number of hole fits recommended by GHC, the test that
hopes to find `+` being recommended for `Int -> Int -> Int` becomes
unpredictable because there are too many symbols which match that type
and the sorting has little control over which symbols get recommended.

There are way fewer matches for `(Int -> Maybe Int) -> Maybe Int ->
Maybe Int`, so it makes the test consistently succeed.

---------

Co-authored-by: Michael Peyton Jones <[email protected]>

Author: akshaymankar

ghcide/src/Development/IDE/GHC/Compat.hs

@@ -133,6 +133,7 @@ import           Compat.HieTypes                         hiding
                                                          (nodeAnnotations)
 import qualified Compat.HieTypes                         as GHC (nodeAnnotations)
 import           Compat.HieUtils
+import           Control.Applicative                     ((<|>))
 import qualified Data.ByteString                         as BS
 import           Data.Coerce                             (coerce)
 import           Data.List                               (foldl')
@@ -434,7 +435,7 @@ setHieDir _f d = d { hieDir = Just _f}
 dontWriteHieFiles :: DynFlags -> DynFlags
 dontWriteHieFiles d = gopt_unset d Opt_WriteHie
 
-setUpTypedHoles ::DynFlags -> DynFlags
+setUpTypedHoles :: DynFlags -> DynFlags
 setUpTypedHoles df
   = flip gopt_unset Opt_AbstractRefHoleFits    -- too spammy
   $ flip gopt_unset Opt_ShowDocsOfHoleFits     -- not used
@@ -447,9 +448,13 @@ setUpTypedHoles df
   $ flip gopt_unset Opt_SortValidHoleFits
   $ flip gopt_unset Opt_UnclutterValidHoleFits
   $ df
-  { refLevelHoleFits = Just 1   -- becomes slow at higher levels
-  , maxRefHoleFits   = Just 10  -- quantity does not impact speed
-  , maxValidHoleFits = Nothing  -- quantity does not impact speed
+  { refLevelHoleFits = refLevelHoleFits df <|> Just 1   -- becomes slow at higher levels
+
+   -- Sometimes GHC can emit a lot of hole fits, this causes editors to be slow
+   -- or just crash, we limit the hole fits to 10. The number was chosen
+   -- arbirtarily by the author.
+  , maxRefHoleFits   = maxRefHoleFits df <|> Just 10
+  , maxValidHoleFits = maxValidHoleFits df <|> Just 10
   }
 
 

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

@@ -69,7 +69,8 @@ processHoleSuggestions mm = (holeSuggestions, refSuggestions)
             (mrAfter . (=~ t " *Valid (hole fits|substitutions) include"))
             validHolesSection
       let holeFit = T.strip $ T.takeWhile (/= ':') holeFitLine
-      guard (not $ T.null holeFit)
+      guard $ not $ holeFit =~ t "Some hole fits suppressed"
+      guard $ not $ T.null holeFit
       return holeFit
     refSuggestions = do -- @[]
       -- get the text indented under Valid refinement hole fits

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

@@ -2640,29 +2640,29 @@ fillTypedHoleTests = let
   , 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"
+              , "test :: Int -> Maybe Int -> Maybe Int"
+              , "test a ma = " <> x <> " (a +) ma"
               ]
       doc <- createDoc "Test.hs" "haskell" $ mkDoc "_"
       _ <- waitForDiagnostics
       actions <- getCodeActions doc (Range (Position 2 13) (Position 2 14))
-      chosen <- pickActionWithTitle "replace _ with (+)" actions
+      chosen <- pickActionWithTitle "replace _ with (<$>)" actions
       executeCodeAction chosen
       modifiedCode <- documentContents doc
-      liftIO $ mkDoc "(+)" @=? modifiedCode
+      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"
+              , "test :: Int -> Maybe Int -> Maybe Int"
+              , "test a ma = (a +) " <> x <> " ma"
               ]
       doc <- createDoc "Test.hs" "haskell" $ mkDoc "`_`"
       _ <- waitForDiagnostics
       actions <- getCodeActions doc (Range (Position 2 16) (Position 2 19))
-      chosen <- pickActionWithTitle "replace _ with (+)" actions
+      chosen <- pickActionWithTitle "replace _ with (<$>)" actions
       executeCodeAction chosen
       modifiedCode <- documentContents doc
-      liftIO $ mkDoc "+" @=? modifiedCode
+      liftIO $ mkDoc "<$>" @=? modifiedCode
   ]
 
 addInstanceConstraintTests :: TestTree