From c9e22b7d61f2328decc5551190f89c858385f5f7 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 17 Jan 2021 11:37:02 +0000 Subject: [PATCH 1/8] 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 --- ghcide/src/Development/IDE/Plugin/Completions.hs | 10 +++++++++- ghcide/src/Development/IDE/Plugin/Completions/Logic.hs | 8 +++++--- 2 files changed, 14 insertions(+), 4 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 6325c050c1..5aa480f54a 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -145,11 +145,19 @@ getCompletionsLSP lsp ide (Just pfix', _) -> do let clientCaps = clientCapabilities $ shakeExtras ide snippets <- WithSnippets . completionSnippetsOn <$> getClientConfig lsp - Completions . List <$> getCompletions ideOpts cci' parsedMod bindMap pfix' clientCaps snippets + allCompletions <- getCompletions ideOpts cci' parsedMod bindMap pfix' clientCaps snippets + let topCompletions = List $ take 20 allCompletions + isComplete = allCompletions `longerThan` 20 + pure $ CompletionList (CompletionListType isComplete topCompletions) _ -> return (Completions $ List []) _ -> return (Completions $ List []) _ -> return (Completions $ List []) +longerThan :: [a] -> Int -> Bool +longerThan [] _ = False +longerThan _ 0 = True +longerThan (_ : aa) n = longerThan aa (n -1) + setHandlersCompletion :: PartialHandlers Config setHandlersCompletion = PartialHandlers $ \WithMessage{..} x -> return x{ LSP.completionHandler = withResponse RspCompletion getCompletionsLSP diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index fc20aa666c..eaf5ea4ca0 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/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 From e9c22840a963c58c19b4b83d0b6debfda33d4bf8 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 17 Jan 2021 13:58:36 +0000 Subject: [PATCH 2/8] Simplify (thanks Neil!) --- ghcide/src/Development/IDE/Plugin/Completions.hs | 11 ++--------- 1 file changed, 2 insertions(+), 9 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 5aa480f54a..00c31918cf 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -146,18 +146,11 @@ getCompletionsLSP lsp ide let clientCaps = clientCapabilities $ shakeExtras ide snippets <- WithSnippets . completionSnippetsOn <$> getClientConfig lsp allCompletions <- getCompletions ideOpts cci' parsedMod bindMap pfix' clientCaps snippets - let topCompletions = List $ take 20 allCompletions - isComplete = allCompletions `longerThan` 20 - pure $ CompletionList (CompletionListType isComplete topCompletions) + let (topCompletions, rest) = splitAt maxCompletions allCompletions + pure $ CompletionList (CompletionListType (null rest) (List topCompletions)) _ -> return (Completions $ List []) _ -> return (Completions $ List []) _ -> return (Completions $ List []) - -longerThan :: [a] -> Int -> Bool -longerThan [] _ = False -longerThan _ 0 = True -longerThan (_ : aa) n = longerThan aa (n -1) - setHandlersCompletion :: PartialHandlers Config setHandlersCompletion = PartialHandlers $ \WithMessage{..} x -> return x{ LSP.completionHandler = withResponse RspCompletion getCompletionsLSP From 630195eee2c62414540cdba06f15c2fd63ac37da Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 17 Jan 2021 13:58:50 +0000 Subject: [PATCH 3/8] Magic constant explained and increased to 40 --- ghcide/src/Development/IDE/Plugin/Completions.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 00c31918cf..9a236ffdf4 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -6,6 +6,7 @@ module Development.IDE.Plugin.Completions ( plugin , getCompletionsLSP + , maxCompletions ) where import Language.Haskell.LSP.Messages @@ -116,6 +117,12 @@ instance Hashable NonLocalCompletions instance NFData NonLocalCompletions instance Binary NonLocalCompletions +-- | 40 may seem conservative but note that most editors limit how many completions +-- are displayed in the screen, and most users rarely scroll. +-- For instance, VSCode only shows 12 completions in its popup, and Emacs has a similar limit. +maxCompletions :: Int +maxCompletions = 40 + -- | Generate code actions. getCompletionsLSP :: LSP.LspFuncs Config From 646a6916db2c6e3116a7b686989a23c41f59c4ab Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 17 Jan 2021 13:59:03 +0000 Subject: [PATCH 4/8] Add test --- ghcide/test/exe/Main.hs | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index cedbda82fd..e46109b30f 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -64,6 +64,7 @@ import Development.IDE.Plugin.Test (WaitForIdeRuleResult(..), TestRequest(BlockS import Control.Monad.Extra (whenJust) import qualified Language.Haskell.LSP.Types.Lens as L import Control.Lens ((^.)) +import Development.IDE.Plugin.Completions (maxCompletions) main :: IO () main = do @@ -3213,7 +3214,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 ] highlightTests :: TestTree From 6200a4ce3d84fb114289addec653b6dc7c609e64 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 17 Jan 2021 14:08:06 +0000 Subject: [PATCH 5/8] Turn maxCompletions into config --- ghcide/src/Development/IDE/Plugin/Completions.hs | 15 ++++----------- ghcide/test/exe/Main.hs | 3 +-- hls-plugin-api/src/Ide/Plugin/Config.hs | 3 +++ 3 files changed, 8 insertions(+), 13 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 9a236ffdf4..70f5474b81 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -6,7 +6,6 @@ module Development.IDE.Plugin.Completions ( plugin , getCompletionsLSP - , maxCompletions ) where import Language.Haskell.LSP.Messages @@ -31,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) @@ -116,13 +115,6 @@ data NonLocalCompletions = NonLocalCompletions instance Hashable NonLocalCompletions instance NFData NonLocalCompletions instance Binary NonLocalCompletions - --- | 40 may seem conservative but note that most editors limit how many completions --- are displayed in the screen, and most users rarely scroll. --- For instance, VSCode only shows 12 completions in its popup, and Emacs has a similar limit. -maxCompletions :: Int -maxCompletions = 40 - -- | Generate code actions. getCompletionsLSP :: LSP.LspFuncs Config @@ -151,9 +143,10 @@ getCompletionsLSP lsp ide -> return (Completions $ List []) (Just pfix', _) -> do let clientCaps = clientCapabilities $ shakeExtras ide - snippets <- WithSnippets . completionSnippetsOn <$> getClientConfig lsp + config <- getClientConfig lsp + let snippets = WithSnippets . completionSnippetsOn $ config allCompletions <- getCompletions ideOpts cci' parsedMod bindMap pfix' clientCaps snippets - let (topCompletions, rest) = splitAt maxCompletions allCompletions + let (topCompletions, rest) = splitAt (maxCompletions config) allCompletions pure $ CompletionList (CompletionListType (null rest) (List topCompletions)) _ -> return (Completions $ List []) _ -> return (Completions $ List []) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index e46109b30f..78780087cf 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -64,7 +64,6 @@ import Development.IDE.Plugin.Test (WaitForIdeRuleResult(..), TestRequest(BlockS import Control.Monad.Extra (whenJust) import qualified Language.Haskell.LSP.Types.Lens as L import Control.Lens ((^.)) -import Development.IDE.Plugin.Completions (maxCompletions) main :: IO () main = do @@ -3224,7 +3223,7 @@ otherCompletionTests = [ ] _ <- waitForDiagnostics compls <- getCompletions doc (Position 3 13) - liftIO $ length compls @?= maxCompletions + liftIO $ length compls @?= maxCompletions def ] highlightTests :: TestTree diff --git a/hls-plugin-api/src/Ide/Plugin/Config.hs b/hls-plugin-api/src/Ide/Plugin/Config.hs index 8a2a06a895..1efe6ccda9 100644 --- a/hls-plugin-api/src/Ide/Plugin/Config.hs +++ b/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}}}} From 6bd22a1e749a07a61855b63f56860eb523564861 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 17 Jan 2021 15:37:35 +0000 Subject: [PATCH 6/8] Fix some inaccuracies in tests --- test/functional/Completion.hs | 23 +++++++++++------------ 1 file changed, 11 insertions(+), 12 deletions(-) diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs index cea08a2981..9c33d6b749 100644 --- a/test/functional/Completion.hs +++ b/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 From 728350aa296847c8df5174b6026d7e43d8b14959 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 17 Jan 2021 17:59:37 +0000 Subject: [PATCH 7/8] document haskell.maxCompletions --- README.md | 1 + 1 file changed, 1 insertion(+) diff --git a/README.md b/README.md index 8a600de65c..72cd8d781d 100644 --- a/README.md +++ b/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`. From dfc41bccc6e3b962b89c26240dbed61e2ae997ad Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 17 Jan 2021 23:28:30 +0000 Subject: [PATCH 8/8] Fix another test --- test/functional/Completion.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs index 9c33d6b749..527aca5447 100644 --- a/test/functional/Completion.hs +++ b/test/functional/Completion.hs @@ -348,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"