Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

More completions fixes #2354

Merged
merged 7 commits into from
Nov 16, 2021
Merged
Show file tree
Hide file tree
Changes from 4 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 1 addition & 2 deletions ghcide/src/Development/IDE/Core/OfInterest.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
25 changes: 11 additions & 14 deletions ghcide/src/Development/IDE/Plugin/Completions/Logic.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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,
Expand Down Expand Up @@ -448,12 +441,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
Expand All @@ -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)

Expand Down
26 changes: 24 additions & 2 deletions ghcide/src/Development/IDE/Types/Exports.hs
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,7 @@ module Development.IDE.Types.Exports
buildModuleExportMapFrom,
createExportsMapHieDb,
size,
updateExportsMapMg
) where

import Control.DeepSeq (NFData (..))
Expand All @@ -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

Expand Down Expand Up @@ -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
Expand Down
20 changes: 19 additions & 1 deletion ghcide/test/exe/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 $ filter ("AAA" `T.isPrefixOf`) (mapMaybe _insertText compls) @?= ["AAAAA"]
pure ()
]

nonLocalCompletionTests :: [TestTree]
Expand Down