From ddf5b026ca9f87ef6b39fb719e37d95b2cd1beec Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 14 Nov 2021 18:40:07 +0000 Subject: [PATCH 1/4] Clean up previous entries in the exports map when updating it --- ghcide/src/Development/IDE/Core/OfInterest.hs | 3 +-- ghcide/src/Development/IDE/Types/Exports.hs | 26 +++++++++++++++++-- ghcide/test/exe/Main.hs | 20 +++++++++++++- 3 files changed, 44 insertions(+), 5 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/OfInterest.hs b/ghcide/src/Development/IDE/Core/OfInterest.hs index bc53fba870..1cdef77375 100644 --- a/ghcide/src/Development/IDE/Core/OfInterest.hs +++ b/ghcide/src/Development/IDE/Core/OfInterest.hs @@ -113,8 +113,7 @@ kick = do -- Update the exports map results <- uses GenerateCore files <* uses GetHieAst files let mguts = catMaybes results - !exportsMap' = createExportsMapMg mguts - void $ liftIO $ modifyVar' exportsMap (exportsMap' <>) + void $ liftIO $ modifyVar' exportsMap (updateExportsMapMg mguts) liftIO $ progressUpdate progress KickCompleted diff --git a/ghcide/src/Development/IDE/Types/Exports.hs b/ghcide/src/Development/IDE/Types/Exports.hs index cee3024105..bb08bb416e 100644 --- a/ghcide/src/Development/IDE/Types/Exports.hs +++ b/ghcide/src/Development/IDE/Types/Exports.hs @@ -10,6 +10,7 @@ module Development.IDE.Types.Exports buildModuleExportMapFrom, createExportsMapHieDb, size, + updateExportsMapMg ) where import Control.DeepSeq (NFData (..)) @@ -30,11 +31,23 @@ import HieDb data ExportsMap = ExportsMap - {getExportsMap :: HashMap IdentifierText (HashSet IdentInfo) - , getModuleExportsMap :: Map.HashMap ModuleNameText (HashSet IdentInfo) + { getExportsMap :: HashMap IdentifierText (HashSet IdentInfo) + , getModuleExportsMap :: HashMap ModuleNameText (HashSet IdentInfo) } deriving (Show) +deleteEntriesForModule :: ModuleNameText -> ExportsMap -> ExportsMap +deleteEntriesForModule m em = ExportsMap + { getExportsMap = + let moduleIds = Map.lookupDefault mempty m (getModuleExportsMap em) + in deleteAll + (rendered <$> Set.toList moduleIds) + (getExportsMap em) + , getModuleExportsMap = Map.delete m (getModuleExportsMap em) + } + where + deleteAll keys map = foldr Map.delete map keys + size :: ExportsMap -> Int size = sum . map length . elems . getExportsMap @@ -119,6 +132,15 @@ createExportsMapMg modGuts = do let getModuleName = moduleName $ mg_module mi concatMap (fmap (second Set.fromList) . unpackAvail getModuleName) (mg_exports mi) +updateExportsMapMg :: [ModGuts] -> ExportsMap -> ExportsMap +updateExportsMapMg modGuts old = + old' <> new + where + new = createExportsMapMg modGuts + old' = deleteAll old (Map.keys $ getModuleExportsMap new) + deleteAll = foldr deleteEntriesForModule + + createExportsMapTc :: [TcGblEnv] -> ExportsMap createExportsMapTc modIface = do let exportList = concatMap doOne modIface diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index d021feea49..7103565abb 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -4319,7 +4319,25 @@ localCompletionTests = [ (Position 4 14) [("abcd", CiFunction, "abcd", True, False, Nothing) ,("abcde", CiFunction, "abcde", True, False, Nothing) - ] + ], + testSessionWait "incomplete entries" $ do + let src a = "data Data = " <> a + doc <- createDoc "A.hs" "haskell" $ src "AAA" + void $ waitForTypecheck doc + let editA rhs = + changeDoc doc [TextDocumentContentChangeEvent + { _range=Nothing + , _rangeLength=Nothing + , _text=src rhs}] + + editA "AAAA" + void $ waitForTypecheck doc + editA "AAAAA" + void $ waitForTypecheck doc + + compls <- getCompletions doc (Position 0 15) + liftIO $ take 2 (map _insertText compls) @?= [Just "AAAAA", Just "ArchAArch64"] + pure () ] nonLocalCompletionTests :: [TestTree] From d70a1db77797a65d80f3a0460582be997e91e02c Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 14 Nov 2021 18:43:45 +0000 Subject: [PATCH 2/4] Add typeText for local completions of type/class declarations helps with #2270 --- .../src/Development/IDE/Plugin/Completions/Logic.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index e1a61cd754..51e7abbf8d 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -179,10 +179,10 @@ mkCompl _tags = Nothing, _detail = case (typeText, provenance) of - (Just t,_) -> Just $ colon <> t + (Just t,_) -> Just $ colon <> t (_, ImportedFrom mod) -> Just $ "from " <> mod - (_, DefinedIn mod) -> Just $ "from " <> mod - _ -> Nothing, + (_, DefinedIn mod) -> Just $ "from " <> mod + _ -> Nothing, _documentation = documentation, _deprecated = Nothing, _preselect = Nothing, @@ -448,12 +448,12 @@ localCompletionsForParsedModule uri pm@ParsedModule{pm_parsed_source = L _ HsMod [mkComp id CiVariable Nothing | VarPat _ id <- listify (\(_ :: Pat GhcPs) -> True) pat_lhs] TyClD _ ClassDecl{tcdLName, tcdSigs} -> - mkComp tcdLName CiInterface Nothing : + mkComp tcdLName CiInterface (Just $ ppr tcdLName) : [ mkComp id CiFunction (Just $ ppr typ) | L _ (ClassOpSig _ _ ids typ) <- tcdSigs , id <- ids] TyClD _ x -> - let generalCompls = [mkComp id cl Nothing + let generalCompls = [mkComp id cl (Just $ ppr $ tcdLName x) | id <- listify (\(_ :: Located(IdP GhcPs)) -> True) x , let cl = occNameToComKind Nothing (rdrNameOcc $ unLoc id)] -- here we only have to look at the outermost type @@ -678,6 +678,7 @@ uniqueCompl candidate unique = else compare (importedFrom candidate, insertText candidate) (importedFrom unique, insertText unique) other -> other where + -- This is an inaccurate predicate - some local completions do not have typeText isLocalCompletion ci = isJust(typeText ci) importedFrom :: CompItem -> T.Text From 3639b597af26dcf80c632d37704b584ec2fdf73c Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 14 Nov 2021 21:08:46 +0000 Subject: [PATCH 3/4] add typeText for all local completions --- .../IDE/Plugin/Completions/Logic.hs | 22 ++++++++----------- 1 file changed, 9 insertions(+), 13 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 51e7abbf8d..1825688d62 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -151,13 +151,6 @@ occNameToComKind ty oc showModName :: ModuleName -> T.Text showModName = T.pack . moduleNameString --- mkCompl :: IdeOptions -> CompItem -> CompletionItem --- mkCompl IdeOptions{..} CI{compKind,insertText, importedFrom,typeText,label,docs} = --- CompletionItem label kind (List []) ((colon <>) <$> typeText) --- (Just $ CompletionDocMarkup $ MarkupContent MkMarkdown $ T.intercalate sectionSeparator docs') --- Nothing Nothing Nothing Nothing (Just insertText) (Just Snippet) --- Nothing Nothing Nothing Nothing Nothing - mkCompl :: PluginId -> IdeOptions -> CompItem -> CompletionItem mkCompl pId @@ -179,10 +172,10 @@ mkCompl _tags = Nothing, _detail = case (typeText, provenance) of - (Just t,_) -> Just $ colon <> t - (_, ImportedFrom mod) -> Just $ "from " <> mod - (_, DefinedIn mod) -> Just $ "from " <> mod - _ -> Nothing, + (Just t,_) | not(T.null t) -> Just $ colon <> t + (_, ImportedFrom mod) -> Just $ "from " <> mod + (_, DefinedIn mod) -> Just $ "from " <> mod + _ -> Nothing, _documentation = documentation, _deprecated = Nothing, _preselect = Nothing, @@ -471,8 +464,12 @@ localCompletionsForParsedModule uri pm@ParsedModule{pm_parsed_source = L _ HsMod ] mkLocalComp pos n ctyp ty = - CI ctyp pn (Local pos) ty pn Nothing doc (ctyp `elem` [CiStruct, CiInterface]) Nothing + CI ctyp pn (Local pos) ensureTypeText pn Nothing doc (ctyp `elem` [CiStruct, CiInterface]) Nothing where + -- when sorting completions, we use the presence of typeText + -- to tell local completions and global completions apart + -- instead of using the empty string here, we should probably introduce a new field... + ensureTypeText = Just $ fromMaybe "" ty pn = ppr n doc = SpanDocText (getDocumentation [pm] n) (SpanDocUris Nothing Nothing) @@ -678,7 +675,6 @@ uniqueCompl candidate unique = else compare (importedFrom candidate, insertText candidate) (importedFrom unique, insertText unique) other -> other where - -- This is an inaccurate predicate - some local completions do not have typeText isLocalCompletion ci = isJust(typeText ci) importedFrom :: CompItem -> T.Text From 6ccad88cbe9d32141fe94e160e2dd5e2ae41f60c Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 14 Nov 2021 21:08:51 +0000 Subject: [PATCH 4/4] fix test --- ghcide/test/exe/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 7103565abb..de0c3e9761 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -4336,7 +4336,7 @@ localCompletionTests = [ void $ waitForTypecheck doc compls <- getCompletions doc (Position 0 15) - liftIO $ take 2 (map _insertText compls) @?= [Just "AAAAA", Just "ArchAArch64"] + liftIO $ filter ("AAA" `T.isPrefixOf`) (mapMaybe _insertText compls) @?= ["AAAAA"] pure () ]