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`. diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 6325c050c1..70f5474b81 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/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 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 diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index c71bef3c3c..fb6befc6d2 100644 --- a/ghcide/test/exe/Main.hs +++ b/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 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}}}} diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs index cea08a2981..527aca5447 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 @@ -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"