More completions fixes (#2354)

* Clean up previous entries in the exports map when updating it

* Add typeText for local completions of type/class declarations

helps with #2270

* add typeText for all local completions

* fix test

Co-authored-by: Javier Neira <[email protected]>

Author: pepeiborra

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
 

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,
@@ -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
@@ -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)
 

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

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 $ filter ("AAA" `T.isPrefixOf`) (mapMaybe _insertText compls) @?= ["AAAAA"]
+        pure ()
     ]
 
 nonLocalCompletionTests :: [TestTree]