Completions from non-imported modules

ghcide/src/Development/IDE/GHC/Orphans.hs

@@ -21,6 +21,7 @@ import           GHC                        ()
 import           GhcPlugins
 import           Retrie.ExactPrint          (Annotated)
 import qualified StringBuffer               as SB
+import           Unique                     (getKey)
 
 
 -- Orphan instances for types from the GHC API.
@@ -162,3 +163,6 @@ instance (NFData HsModule) where
 instance (NFData (HsModule a)) where
 #endif
   rnf = rwhnf
+
+instance Show OccName where show = prettyPrint
+instance Hashable OccName where hashWithSalt s n = hashWithSalt s (getKey $ getUnique n)

ghcide/src/Development/IDE/Plugin/CodeAction.hs

@@ -11,7 +11,9 @@ module Development.IDE.Plugin.CodeAction
     iePluginDescriptor,
     typeSigsPluginDescriptor,
     bindingsPluginDescriptor,
-    fillHolePluginDescriptor
+    fillHolePluginDescriptor,
+    newImport,
+    newImportToEdit
     -- * For testing
     , matchRegExMultipleImports
     ) where
@@ -835,7 +837,7 @@ suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_
             -- fallback to using GHC suggestion even though it is not always correct
           | otherwise
           = Just IdentInfo
-                { name = binding
+                { name = mkVarOcc $ T.unpack binding
                 , rendered = binding
                 , parent = Nothing
                 , isDatacon = False

ghcide/src/Development/IDE/Plugin/Completions.hs

@@ -23,16 +23,20 @@ import           Development.IDE.Core.Shake
 import           Development.IDE.GHC.Compat
 import           Development.IDE.GHC.Error                    (rangeToSrcSpan)
 import           Development.IDE.GHC.ExactPrint               (Annotated (annsA),
-                                                               GetAnnotatedParsedSource (GetAnnotatedParsedSource))
+                                                               GetAnnotatedParsedSource (GetAnnotatedParsedSource),
+                                                               astA)
 import           Development.IDE.GHC.Util                     (prettyPrint)
 import           Development.IDE.Graph
 import           Development.IDE.Graph.Classes
+import           Development.IDE.Plugin.CodeAction            (newImport,
+                                                               newImportToEdit)
 import           Development.IDE.Plugin.CodeAction.ExactPrint
 import           Development.IDE.Plugin.Completions.Logic
 import           Development.IDE.Plugin.Completions.Types
-import           Development.IDE.Types.HscEnvEq               (hscEnv)
+import           Development.IDE.Types.HscEnvEq               (HscEnvEq (envPackageExports),
+                                                               hscEnv)
 import           Development.IDE.Types.Location
-import           GHC.Exts                                     (toList)
+import           GHC.Exts                                     (fromList, toList)
 import           GHC.Generics
 import           Ide.Plugin.Config                            (Config)
 import           Ide.Types
@@ -42,6 +46,9 @@ import qualified Language.LSP.VFS                             as VFS
 #if MIN_VERSION_ghc(9,0,0)
 import           GHC.Tc.Module                                (tcRnImportDecls)
 #else
+import qualified Data.HashMap.Strict                          as Map
+import qualified Data.HashSet                                 as Set
+import           Development.IDE.Types.Exports
 import           TcRnDriver                                   (tcRnImportDecls)
 #endif
 
@@ -130,7 +137,12 @@ getCompletionsLSP ide plId
             nonLocalCompls <- useWithStaleFast NonLocalCompletions npath
             pm <- useWithStaleFast GetParsedModule npath
             binds <- fromMaybe (mempty, zeroMapping) <$> useWithStaleFast GetBindings npath
-            pure (opts, fmap (,pm,binds) ((fst <$> localCompls) <> (fst <$> nonLocalCompls)))
+            exportsMapIO <- fmap(envPackageExports . fst) <$> useWithStaleFast GhcSession npath
+            exportsMap <- mapM liftIO exportsMapIO
+            let exportsCompItems = foldMap (map (fromIdentInfo uri) . Set.toList) . Map.elems . getExportsMap <$> exportsMap
+                exportsCompls = mempty{unqualCompls = fromMaybe [] exportsCompItems}
+            let compls = (fst <$> localCompls) <> (fst <$> nonLocalCompls) <> Just exportsCompls
+            pure (opts, fmap (,pm,binds) compls)
         case compls of
           Just (cci', parsedMod, bindMap) -> do
             pfix <- VFS.getCompletionPrefix position cnts
@@ -185,10 +197,19 @@ extendImportHandler' ideState ExtendImport {..}
       let df = ms_hspp_opts msrModSummary
           wantedModule = mkModuleName (T.unpack importName)
           wantedQual = mkModuleName . T.unpack <$> importQual
-      imp <- liftMaybe $ find (isWantedModule wantedModule wantedQual) msrImports
-      fmap (nfp,) $ liftEither $
-        rewriteToWEdit df doc (annsA ps) $
-          extendImport (T.unpack <$> thingParent) (T.unpack newThing) imp
+          existingImport = find (isWantedModule wantedModule wantedQual) msrImports
+      case existingImport of
+        Just imp -> do
+            fmap (nfp,) $ liftEither $
+              rewriteToWEdit df doc (annsA ps) $
+                extendImport (T.unpack <$> thingParent) (T.unpack newThing) imp
+        Nothing -> do
+            let n = newImport importName (Just it) importQual False
+                it = case thingParent of
+                  Nothing -> newThing
+                  Just p  -> p <> "(" <> newThing <> ")"
+            t <- liftMaybe $ snd <$> newImportToEdit n (astA ps)
+            return (nfp, WorkspaceEdit {_changes=Just (fromList [(doc,List [t])]), _documentChanges=Nothing, _changeAnnotations=Nothing})
   | otherwise =
     mzero
 

ghcide/src/Development/IDE/Plugin/Completions/Logic.hs

@@ -9,6 +9,7 @@ module Development.IDE.Plugin.Completions.Logic (
 , cacheDataProducer
 , localCompletionsForParsedModule
 , getCompletions
+, fromIdentInfo
 ) where
 
 import           Control.Applicative
@@ -19,6 +20,7 @@ import           Data.List.Extra                          as List hiding
 import qualified Data.Map                                 as Map
 
 import           Data.Maybe                               (fromMaybe, isJust,
+                                                           isNothing,
                                                            listToMaybe,
                                                            mapMaybe)
 import qualified Data.Text                                as T
@@ -49,6 +51,7 @@ import           Development.IDE.Plugin.Completions.Types
 import           Development.IDE.Spans.Common
 import           Development.IDE.Spans.Documentation
 import           Development.IDE.Spans.LocalBindings
+import           Development.IDE.Types.Exports
 import           Development.IDE.Types.HscEnvEq
 import           Development.IDE.Types.Options
 import           GhcPlugins                               (flLabel, unpackFS)
@@ -302,6 +305,25 @@ mkPragmaCompl label insertText =
     Nothing Nothing Nothing Nothing Nothing (Just insertText) (Just Snippet)
     Nothing Nothing Nothing Nothing Nothing Nothing
 
+fromIdentInfo :: Uri -> IdentInfo -> CompItem
+fromIdentInfo doc IdentInfo{..} = CI
+  { compKind= occNameToComKind Nothing name
+  , insertText=rendered
+  , importedFrom=Right moduleNameText
+  , typeText=Nothing
+  , label=rendered
+  , isInfix=Nothing
+  , docs=emptySpanDoc
+  , isTypeCompl= not isDatacon && isUpper (T.head rendered)
+  , additionalTextEdits= Just $
+        ExtendImport
+          { doc,
+            thingParent = parent,
+            importName = moduleNameText,
+            importQual = Nothing,
+            newThing = rendered
+          }
+  }
 
 cacheDataProducer :: Uri -> HscEnvEq -> Module -> GlobalRdrEnv-> GlobalRdrEnv -> [LImportDecl GhcPs] -> IO CachedCompletions
 cacheDataProducer uri env curMod globalEnv inScopeEnv limports = do
@@ -606,13 +628,26 @@ getCompletions plId ideOpts CC {allModNamesAsNS, unqualCompls, qualCompls, impor
     | "{-# " `T.isPrefixOf` fullLine
     -> return $ filtPragmaCompls (pragmaSuffix fullLine)
     | otherwise -> do
-        let uniqueFiltCompls = nubOrdOn insertText filtCompls
+        -- assumes that nubOrdBy is stable
+        let uniqueFiltCompls = nubOrdBy uniqueCompl filtCompls
         compls <- mapM (mkCompl plId ideOpts) uniqueFiltCompls
         return $ filtModNameCompls
               ++ filtKeywordCompls
               ++ map (toggleSnippets caps config) compls
 
-
+uniqueCompl :: CompItem -> CompItem -> Ordering
+uniqueCompl x y =
+  case compare (label x, importedFrom x, compKind x)
+               (label y, importedFrom y, compKind y) of
+    EQ ->
+      -- preserve completions for duplicate record fields where the only difference is in the type
+      -- remove redundant completions with less type info
+      if typeText x == typeText y
+        || isNothing (typeText x)
+        || isNothing (typeText y)
+        then EQ
+        else compare (insertText x) (insertText y)
+    other -> other
 -- ---------------------------------------------------------------------
 -- helper functions for pragmas
 -- ---------------------------------------------------------------------

ghcide/src/Development/IDE/Plugin/Completions/Types.hs

@@ -20,7 +20,7 @@ import           Ide.Plugin.Properties
 import           Ide.PluginUtils              (usePropertyLsp)
 import           Ide.Types                    (PluginId)
 import           Language.LSP.Server          (MonadLsp)
-import           Language.LSP.Types           (CompletionItemKind, Uri)
+import           Language.LSP.Types           (CompletionItemKind (..), Uri)
 
 -- From haskell-ide-engine/src/Haskell/Ide/Engine/LSP/Completions.hs
 

ghcide/src/Development/IDE/Types/Exports.hs

@@ -9,24 +9,26 @@ module Development.IDE.Types.Exports
     createExportsMapTc
 ,createExportsMapHieDb,size) where
 
-import           Avail                      (AvailInfo (..))
-import           Control.DeepSeq            (NFData (..))
+import           Avail                       (AvailInfo (..))
+import           Control.DeepSeq             (NFData (..))
 import           Control.Monad
-import           Data.Bifunctor             (Bifunctor (second))
-import           Data.HashMap.Strict        (HashMap, elems)
-import qualified Data.HashMap.Strict        as Map
-import           Data.HashSet               (HashSet)
-import qualified Data.HashSet               as Set
-import           Data.Hashable              (Hashable)
-import           Data.Text                  (Text, pack)
+import           Data.Bifunctor              (Bifunctor (second))
+import           Data.HashMap.Strict         (HashMap, elems)
+import qualified Data.HashMap.Strict         as Map
+import           Data.HashSet                (HashSet)
+import qualified Data.HashSet                as Set
+import           Data.Hashable               (Hashable)
+import           Data.List                   (isSuffixOf)
+import           Data.Text                   (Text, pack)
 import           Development.IDE.GHC.Compat
+import           Development.IDE.GHC.Orphans ()
 import           Development.IDE.GHC.Util
-import           FieldLabel                 (flSelector)
-import           GHC.Generics               (Generic)
-import           GhcPlugins                 (IfaceExport, ModGuts (..))
+import           FieldLabel                  (flSelector)
+import           GHC.Generics                (Generic)
+import           GhcPlugins                  (IfaceExport, ModGuts (..))
 import           HieDb
 import           Name
-import           TcRnTypes                  (TcGblEnv (..))
+import           TcRnTypes                   (TcGblEnv (..))
 
 newtype ExportsMap = ExportsMap
     {getExportsMap :: HashMap IdentifierText (HashSet IdentInfo)}
@@ -41,7 +43,7 @@ instance Semigroup ExportsMap where
 type IdentifierText = Text
 
 data IdentInfo = IdentInfo
-    { name           :: !Text
+    { name           :: !OccName
     , rendered       :: Text
     , parent         :: !(Maybe Text)
     , isDatacon      :: !Bool
@@ -72,19 +74,19 @@ renderIEWrapped n
 
 mkIdentInfos :: Text -> AvailInfo -> [IdentInfo]
 mkIdentInfos mod (Avail n) =
-    [IdentInfo (pack (prettyPrint n)) (renderIEWrapped n) Nothing (isDataConName n) mod]
+    [IdentInfo (nameOccName n) (renderIEWrapped n) Nothing (isDataConName n) mod]
 mkIdentInfos mod (AvailTC parent (n:nn) flds)
     -- Following the GHC convention that parent == n if parent is exported
     | n == parent
-    = [ IdentInfo (pack (prettyPrint n)) (renderIEWrapped n) (Just $! parentP) (isDataConName n) mod
+    = [ IdentInfo (nameOccName n) (renderIEWrapped n) (Just $! parentP) (isDataConName n) mod
         | n <- nn ++ map flSelector flds
       ] ++
-      [ IdentInfo (pack (prettyPrint n)) (renderIEWrapped n) Nothing (isDataConName n) mod]
+      [ IdentInfo (nameOccName n) (renderIEWrapped n) Nothing (isDataConName n) mod]
     where
         parentP = pack $ printName parent
 
 mkIdentInfos mod (AvailTC _ nn flds)
-    = [ IdentInfo (pack (prettyPrint n)) (renderIEWrapped n) Nothing (isDataConName n) mod
+    = [ IdentInfo (nameOccName n) (renderIEWrapped n) Nothing (isDataConName n) mod
         | n <- nn ++ map flSelector flds
       ]
 
@@ -109,23 +111,29 @@ createExportsMapTc = ExportsMap . Map.fromListWith (<>) . concatMap doOne
       where
         mn = moduleName $ tcg_mod mi
 
+nonInternalModules :: ModuleName -> Bool
+nonInternalModules = not . (".Internal" `isSuffixOf`) . moduleNameString
+
 createExportsMapHieDb :: HieDb -> IO ExportsMap
 createExportsMapHieDb hiedb = do
     mods <- getAllIndexedMods hiedb
-    idents <- forM mods $ \m -> do
+    idents <- forM (filter (nonInternalModules . modInfoName . hieModInfo) mods) $ \m -> do
         let mn = modInfoName $ hieModInfo m
             mText = pack $ moduleNameString mn
         fmap (wrap . unwrap mText) <$> getExportsForModule hiedb mn
     return $ ExportsMap $ Map.fromListWith (<>) (concat idents)
   where
-    wrap identInfo = (name identInfo, Set.fromList [identInfo])
+    wrap identInfo = (rendered identInfo, Set.fromList [identInfo])
     -- unwrap :: ExportRow -> IdentInfo
-    unwrap m ExportRow{..} = IdentInfo n n p exportIsDatacon m
+    unwrap m ExportRow{..} = IdentInfo exportName n p exportIsDatacon m
       where
           n = pack (occNameString exportName)
           p = pack . occNameString <$> exportParent
 
 unpackAvail :: ModuleName -> IfaceExport -> [(Text, [IdentInfo])]
-unpackAvail !(pack . moduleNameString -> mod) = map f . mkIdentInfos mod
+unpackAvail mn
+  | nonInternalModules mn = map f . mkIdentInfos mod
+  | otherwise = const []
   where
-    f id@IdentInfo {..} = (name, [id])
+    !mod = pack $ moduleNameString mn
+    f id@IdentInfo {..} = (rendered, [id])