From 86446c792f5d58905de5e7480769d4e9c62091b7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ondr=CC=8Cej=20S=CC=8Cebek?= Date: Sun, 15 Oct 2023 13:12:54 +0200 Subject: [PATCH 1/2] Test qualified completion - add test for post-qualified completion - add failing test for pre-qualified completion - add failing test for multiline import --- plugins/hls-refactor-plugin/test/Main.hs | 26 +++++++++++++++++++----- 1 file changed, 21 insertions(+), 5 deletions(-) diff --git a/plugins/hls-refactor-plugin/test/Main.hs b/plugins/hls-refactor-plugin/test/Main.hs index e7975e21fa..82ea1c3eb2 100644 --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -177,6 +177,25 @@ completionTests = "join" ["{-# LANGUAGE NoImplicitPrelude #-}", "module A where", "import Control.Monad as M ()", "import Control.Monad as N (join)", "f = N.joi"] + -- Regression test for https://github.com/haskell/haskell-language-server/issues/2824 + , completionNoCommandTest + "explicit qualified" + ["{-# LANGUAGE NoImplicitPrelude #-}", + "module A where", "import qualified Control.Monad as M (j)"] + (Position 2 38) + "join" + , completionNoCommandTest + "explicit qualified post" + ["{-# LANGUAGE NoImplicitPrelude, ImportQualifiedPost #-}", + "module A where", "import Control.Monad qualified as M (j)"] + (Position 2 38) + "join" + , completionNoCommandTest + "multiline import" + [ "{-# LANGUAGE NoImplicitPrelude #-}" + , "module A where", "import Control.Monad", " (fore)"] + (Position 3 9) + "forever" ] , testGroup "Data constructor" [ completionCommandTest @@ -289,11 +308,8 @@ completionNoCommandTest name src pos wanted = testSession name $ do docId <- createDoc "A.hs" "haskell" (T.unlines src) _ <- waitForDiagnostics compls <- getCompletions docId pos - let wantedC = find ( \case - CompletionItem {_insertText = Just x} -> wanted `T.isPrefixOf` x - _ -> False - ) compls - case wantedC of + let isPrefixOfInsertOrLabel ci = any (wanted `T.isPrefixOf`) [fromMaybe "" (ci ^. L.insertText), ci ^. L.label] + case find isPrefixOfInsertOrLabel compls of Nothing -> liftIO $ assertFailure $ "Cannot find expected completion in: " <> show [_label | CompletionItem {_label} <- compls] Just CompletionItem{..} -> liftIO . assertBool ("Expected no command but got: " <> show _command) $ null _command From cf6db6c84d213ab37acbc5376fb6c5763f127b1c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ondr=CC=8Cej=20S=CC=8Cebek?= Date: Sun, 15 Oct 2023 13:36:40 +0200 Subject: [PATCH 2/2] Fix completion for qualified import - fix how we get the module name considering it can be preceded by `qualified` - use parsed context for import completions - add regression test for fixed multiline import - refactor `getCompletions` function --- .../src/Development/IDE/Plugin/Completions.hs | 2 +- .../IDE/Plugin/Completions/Logic.hs | 132 +++++++++++------- 2 files changed, 80 insertions(+), 54 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index e15655a3cc..5f729c8114 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -221,7 +221,7 @@ getCompletionsLSP ide plId plugins = idePlugins $ shakeExtras ide config <- liftIO $ runAction "" ide $ getCompletionsConfig plId - allCompletions <- liftIO $ getCompletions plugins ideOpts cci' parsedMod astres bindMap pfix clientCaps config moduleExports uri + let allCompletions = getCompletions plugins ideOpts cci' parsedMod astres bindMap pfix clientCaps config moduleExports uri pure $ InL (orderedCompletions allCompletions) _ -> return (InL []) _ -> return (InL []) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index e8886c0c89..955c5f1793 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -576,10 +576,54 @@ getCompletions -> CompletionsConfig -> ModuleNameEnv (HashSet.HashSet IdentInfo) -> Uri - -> IO [Scored CompletionItem] -getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qualCompls, importableModules} - maybe_parsed maybe_ast_res (localBindings, bmapping) prefixInfo caps config moduleExportsMap uri = do - let PosPrefixInfo { fullLine, prefixScope, prefixText } = prefixInfo + -> [Scored CompletionItem] +getCompletions + plugins + ideOpts + CC {allModNamesAsNS, anyQualCompls, unqualCompls, qualCompls, importableModules} + maybe_parsed + maybe_ast_res + (localBindings, bmapping) + prefixInfo@(PosPrefixInfo { fullLine, prefixScope, prefixText }) + caps + config + moduleExportsMap + uri + -- ------------------------------------------------------------------------ + -- IMPORT MODULENAME (NAM|) + | Just (ImportListContext moduleName) <- maybeContext + = moduleImportListCompletions moduleName + + | Just (ImportHidingContext moduleName) <- maybeContext + = moduleImportListCompletions moduleName + + -- ------------------------------------------------------------------------ + -- IMPORT MODULENAM| + | Just (ImportContext _moduleName) <- maybeContext + = filtImportCompls + + -- ------------------------------------------------------------------------ + -- {-# LA| #-} + -- we leave this condition here to avoid duplications and return empty list + -- since HLS implements these completions (#haskell-language-server/pull/662) + | "{-# " `T.isPrefixOf` fullLine + = [] + + -- ------------------------------------------------------------------------ + | otherwise = + -- assumes that nubOrdBy is stable + let uniqueFiltCompls = nubOrdBy (uniqueCompl `on` snd . Fuzzy.original) filtCompls + compls = (fmap.fmap.fmap) (mkCompl pId ideOpts uri) uniqueFiltCompls + pId = lookupCommandProvider plugins (CommandId extendImportCommandId) + in + (fmap.fmap) snd $ + sortBy (compare `on` lexicographicOrdering) $ + mergeListsBy (flip compare `on` score) + [ (fmap.fmap) (notQual,) filtModNameCompls + , (fmap.fmap) (notQual,) filtKeywordCompls + , (fmap.fmap.fmap) (toggleSnippets caps config) compls + ] + where enteredQual = if T.null prefixScope then "" else prefixScope <> "." fullPrefix = enteredQual <> prefixText @@ -602,11 +646,9 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, $ Fuzzy.simpleFilter chunkSize maxC fullPrefix $ (if T.null enteredQual then id else mapMaybe (T.stripPrefix enteredQual)) allModNamesAsNS - - filtCompls = Fuzzy.filter chunkSize maxC prefixText ctxCompls (label . snd) - where - - mcc = case maybe_parsed of + -- If we have a parsed module, use it to determine which completion to show. + maybeContext :: Maybe Context + maybeContext = case maybe_parsed of Nothing -> Nothing Just (pm, pmapping) -> let PositionMapping pDelta = pmapping @@ -615,7 +657,9 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, hpos = upperRange position' in getCContext lpos pm <|> getCContext hpos pm - + filtCompls :: [Scored (Bool, CompItem)] + filtCompls = Fuzzy.filter chunkSize maxC prefixText ctxCompls (label . snd) + where -- We need the hieast to be "fresh". We can't get types from "stale" hie files, so hasfield won't work, -- since it gets the record fields from the types. -- Perhaps this could be fixed with a refactor to GHC's IfaceTyCon, to have it also contain record fields. @@ -653,7 +697,7 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, }) -- completions specific to the current context - ctxCompls' = case mcc of + ctxCompls' = case maybeContext of Nothing -> compls Just TypeContext -> filter ( isTypeCompl . snd) compls Just ValueContext -> filter (not . isTypeCompl . snd) compls @@ -694,54 +738,36 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, , enteredQual `T.isPrefixOf` original label ] + moduleImportListCompletions :: String -> [Scored CompletionItem] + moduleImportListCompletions moduleNameS = + let moduleName = T.pack moduleNameS + funcs = lookupWithDefaultUFM moduleExportsMap HashSet.empty $ mkModuleName moduleNameS + funs = map (show . name) $ HashSet.toList funcs + in filterModuleExports moduleName $ map T.pack funs + + filtImportCompls :: [Scored CompletionItem] filtImportCompls = filtListWith (mkImportCompl enteredQual) importableModules + + filterModuleExports :: T.Text -> [T.Text] -> [Scored CompletionItem] filterModuleExports moduleName = filtListWith $ mkModuleFunctionImport moduleName + + filtKeywordCompls :: [Scored CompletionItem] filtKeywordCompls | T.null prefixScope = filtListWith mkExtCompl (optKeywords ideOpts) | otherwise = [] - if - -- TODO: handle multiline imports - | "import " `T.isPrefixOf` fullLine - && (List.length (words (T.unpack fullLine)) >= 2) - && "(" `isInfixOf` T.unpack fullLine - -> do - let moduleName = words (T.unpack fullLine) !! 1 - funcs = lookupWithDefaultUFM moduleExportsMap HashSet.empty $ mkModuleName moduleName - funs = map (renderOcc . name) $ HashSet.toList funcs - return $ filterModuleExports (T.pack moduleName) funs - | "import " `T.isPrefixOf` fullLine - -> return filtImportCompls - -- we leave this condition here to avoid duplications and return empty list - -- since HLS implements these completions (#haskell-language-server/pull/662) - | "{-# " `T.isPrefixOf` fullLine - -> return [] - | otherwise -> do - -- assumes that nubOrdBy is stable - let uniqueFiltCompls = nubOrdBy (uniqueCompl `on` snd . Fuzzy.original) filtCompls - let compls = (fmap.fmap.fmap) (mkCompl pId ideOpts uri) uniqueFiltCompls - pId = lookupCommandProvider plugins (CommandId extendImportCommandId) - return $ - (fmap.fmap) snd $ - sortBy (compare `on` lexicographicOrdering) $ - mergeListsBy (flip compare `on` score) - [ (fmap.fmap) (notQual,) filtModNameCompls - , (fmap.fmap) (notQual,) filtKeywordCompls - , (fmap.fmap.fmap) (toggleSnippets caps config) compls - ] - where - -- We use this ordering to alphabetically sort suggestions while respecting - -- all the previously applied ordering sources. These are: - -- 1. Qualified suggestions go first - -- 2. Fuzzy score ranks next - -- 3. In-scope completions rank next - -- 4. label alphabetical ordering next - -- 4. detail alphabetical ordering (proxy for module) - lexicographicOrdering Fuzzy.Scored{score, original} = - case original of - (isQual, CompletionItem{_label,_detail}) -> do - let isLocal = maybe False (":" `T.isPrefixOf`) _detail - (Down isQual, Down score, Down isLocal, _label, _detail) + -- We use this ordering to alphabetically sort suggestions while respecting + -- all the previously applied ordering sources. These are: + -- 1. Qualified suggestions go first + -- 2. Fuzzy score ranks next + -- 3. In-scope completions rank next + -- 4. label alphabetical ordering next + -- 4. detail alphabetical ordering (proxy for module) + lexicographicOrdering Fuzzy.Scored{score, original} = + case original of + (isQual, CompletionItem{_label,_detail}) -> do + let isLocal = maybe False (":" `T.isPrefixOf`) _detail + (Down isQual, Down score, Down isLocal, _label, _detail)