Limit completions to top 40 (#1218)

* Limit completions to top 20

We are overwhelming the LSP client by sending 100s of completions after the
first character. Instead, let's send 20 at a time and refresh for more when the
user types another word

* Simplify (thanks Neil!)

* Magic constant explained and increased to 40

* Add test

* Turn maxCompletions into config

* Fix some inaccuracies in tests

* document haskell.maxCompletions

* Fix another test

Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>

Author: pepeiborra

README.md

@@ -298,6 +298,7 @@ Here is a list of the additional settings currently supported by `haskell-langua
 - Completion snippets (`haskell.completionSnippetsOn`, default true): whether to support completion snippets
 - Liquid Haskell (`haskell.liquidOn`, default false): whether to enable Liquid Haskell support (currently unused until the Liquid Haskell support is functional again)
 - Hlint (`haskell.hlintOn`, default true): whether to enable Hlint support
+- Max completions (`haskell.maxCompletions`, default 40): maximum number of completions sent to the LSP client.
 
 Settings like this are typically provided by the language-specific LSP client support for your editor, for example in Emacs by `lsp-haskell`.
 

ghcide/src/Development/IDE/Plugin/Completions.hs

@@ -30,7 +30,7 @@ import Development.IDE.GHC.Util
 import Development.IDE.LSP.Server
 import TcRnDriver (tcRnImportDecls)
 import Data.Maybe
-import Ide.Plugin.Config (Config(completionSnippetsOn))
+import Ide.Plugin.Config (Config (completionSnippetsOn, maxCompletions))
 import Ide.PluginUtils (getClientConfig)
 
 #if defined(GHC_LIB)
@@ -115,7 +115,6 @@ data NonLocalCompletions = NonLocalCompletions
 instance Hashable NonLocalCompletions
 instance NFData   NonLocalCompletions
 instance Binary   NonLocalCompletions
-
 -- | Generate code actions.
 getCompletionsLSP
     :: LSP.LspFuncs Config
@@ -144,12 +143,14 @@ getCompletionsLSP lsp ide
                 -> return (Completions $ List [])
               (Just pfix', _) -> do
                 let clientCaps = clientCapabilities $ shakeExtras ide
-                snippets <- WithSnippets . completionSnippetsOn <$> getClientConfig lsp
-                Completions . List <$> getCompletions ideOpts cci' parsedMod bindMap pfix' clientCaps snippets
+                config <- getClientConfig lsp
+                let snippets = WithSnippets . completionSnippetsOn $ config
+                allCompletions <- getCompletions ideOpts cci' parsedMod bindMap pfix' clientCaps snippets
+                let (topCompletions, rest) = splitAt (maxCompletions config) allCompletions
+                pure $ CompletionList (CompletionListType (null rest) (List topCompletions))
               _ -> return (Completions $ List [])
           _ -> return (Completions $ List [])
       _ -> return (Completions $ List [])
-
 setHandlersCompletion :: PartialHandlers Config
 setHandlersCompletion = PartialHandlers $ \WithMessage{..} x -> return x{
     LSP.completionHandler = withResponse RspCompletion getCompletionsLSP

ghcide/src/Development/IDE/Plugin/Completions/Logic.hs

@@ -565,9 +565,11 @@ getCompletions ideOpts CC { allModNamesAsNS, unqualCompls, qualCompls, importabl
         = filtPragmaCompls (pragmaSuffix fullLine)
         | otherwise
         = let uniqueFiltCompls = nubOrdOn insertText filtCompls
-          in filtModNameCompls ++ map (toggleSnippets caps withSnippets
-                                         . mkCompl ideOpts . stripAutoGenerated) uniqueFiltCompls
-                               ++ filtKeywordCompls
+          in filtModNameCompls
+          ++ filtKeywordCompls
+          ++ map ( toggleSnippets caps withSnippets
+                 . mkCompl ideOpts . stripAutoGenerated
+                 ) uniqueFiltCompls
   return result
 
 

ghcide/test/exe/Main.hs

@@ -3262,7 +3262,17 @@ otherCompletionTests = [
       -- This should be sufficient to detect that we are in a
       -- type context and only show the completion to the type.
       (Position 3 11)
-      [("Integer", CiStruct, "Integer ", True, True, Nothing)]
+      [("Integer", CiStruct, "Integer ", True, True, Nothing)],
+
+    testSessionWait "maxCompletions" $ do
+        doc <- createDoc "A.hs" "haskell" $ T.unlines
+            [ "{-# OPTIONS_GHC -Wunused-binds #-}",
+                "module A () where",
+                "a = Prelude."
+            ]
+        _ <- waitForDiagnostics
+        compls <- getCompletions  doc (Position 3 13)
+        liftIO $ length compls @?= maxCompletions def
   ]
 
 highlightTests :: TestTree

hls-plugin-api/src/Ide/Plugin/Config.hs

@@ -69,6 +69,7 @@ data Config =
     , completionSnippetsOn        :: !Bool
     , formatOnImportOn            :: !Bool
     , formattingProvider          :: !T.Text
+    , maxCompletions              :: !Int
     , plugins                     :: !(Map.Map T.Text PluginConfig)
     } deriving (Show,Eq)
 
@@ -87,6 +88,7 @@ instance Default Config where
     , formattingProvider          = "ormolu"
     -- , formattingProvider          = "floskell"
     -- , formattingProvider          = "stylish-haskell"
+    , maxCompletions              = 40
     , plugins                     = Map.empty
     }
 
@@ -107,6 +109,7 @@ instance A.FromJSON Config where
       <*> o .:? "completionSnippetsOn"                    .!= completionSnippetsOn def
       <*> o .:? "formatOnImportOn"                        .!= formatOnImportOn def
       <*> o .:? "formattingProvider"                      .!= formattingProvider def
+      <*> o .:? "maxCompletions"                          .!= maxCompletions def
       <*> o .:? "plugin"                                  .!= plugins def
 
 -- 2017-10-09 23:22:00.710515298 [ThreadId 11] - ---> {"jsonrpc":"2.0","method":"workspace/didChangeConfiguration","params":{"settings":{"haskell":{"maxNumberOfProblems":100,"hlintOn":true}}}}

test/functional/Completion.hs

@@ -13,7 +13,6 @@ import Test.Tasty
 import Test.Tasty.ExpectedFailure (ignoreTestBecause)
 import Test.Tasty.HUnit
 import qualified Data.Text as T
-import System.Time.Extra (sleep)
 
 tests :: TestTree
 tests = testGroup "completions" [
@@ -54,12 +53,12 @@ tests = testGroup "completions" [
      , testCase "completes imports" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
          doc <- openDoc "Completion.hs" "haskell"
 
-         liftIO $ sleep 4
+         _ <- waitForDiagnostics
 
          let te = TextEdit (Range (Position 1 17) (Position 1 26)) "Data.M"
          _ <- applyEdit doc te
 
-         compls <- getCompletions doc (Position 1 22)
+         compls <- getCompletions doc (Position 1 23)
          let item = head $ filter ((== "Maybe") . (^. label)) compls
          liftIO $ do
              item ^. label @?= "Maybe"
@@ -69,22 +68,22 @@ tests = testGroup "completions" [
      , testCase "completes qualified imports" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
          doc <- openDoc "Completion.hs" "haskell"
 
-         liftIO $ sleep 4
+         _ <- waitForDiagnostics
 
-         let te = TextEdit (Range (Position 2 17) (Position 1 25)) "Dat"
+         let te = TextEdit (Range (Position 2 17) (Position 2 25)) "Data.L"
          _ <- applyEdit doc te
 
-         compls <- getCompletions doc (Position 1 19)
-         let item = head $ filter ((== "Data.List") . (^. label)) compls
+         compls <- getCompletions doc (Position 2 24)
+         let item = head $ filter ((== "List") . (^. label)) compls
          liftIO $ do
-             item ^. label @?= "Data.List"
+             item ^. label @?= "List"
              item ^. detail @?= Just "Data.List"
              item ^. kind @?= Just CiModule
 
      , testCase "completes language extensions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
          doc <- openDoc "Completion.hs" "haskell"
 
-         liftIO $ sleep 4
+         _ <- waitForDiagnostics
 
          let te = TextEdit (Range (Position 0 24) (Position 0 31)) ""
          _ <- applyEdit doc te
@@ -98,7 +97,7 @@ tests = testGroup "completions" [
      , testCase "completes pragmas" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
          doc <- openDoc "Completion.hs" "haskell"
 
-         liftIO $ sleep 4
+         _ <- waitForDiagnostics
 
          let te = TextEdit (Range (Position 0 4) (Position 0 34)) ""
          _ <- applyEdit doc te
@@ -128,7 +127,7 @@ tests = testGroup "completions" [
      , testCase "completes options pragma" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
          doc <- openDoc "Completion.hs" "haskell"
 
-         liftIO $ sleep 4
+         _ <- waitForDiagnostics
 
          let te = TextEdit (Range (Position 0 4) (Position 0 34)) "OPTIONS"
          _ <- applyEdit doc te
@@ -159,7 +158,7 @@ tests = testGroup "completions" [
          doc <- openDoc "Completion.hs" "haskell"
 
          compls <- getCompletions doc (Position 5 7)
-         liftIO $ any ((== "!!") . (^. label)) compls @? ""
+         liftIO $ assertBool "Expected completions" $ not $ null compls
 
      -- See https://github.com/haskell/haskell-ide-engine/issues/903
      , testCase "strips compiler generated stuff from completions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
@@ -349,7 +348,7 @@ contextTests = testGroup "contexts" [
     , testCase "only provides value suggestions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
       doc <- openDoc "Context.hs" "haskell"
 
-      compls <- getCompletions doc (Position 3 9)
+      compls <- getCompletions doc (Position 3 10)
       liftIO $ do
         compls `shouldContainCompl` "abs"
         compls `shouldNotContainCompl` "Applicative"