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.
@@ -50,6 +51,8 @@ instance Hashable GhcPlugins.InstalledUnitId where
   hashWithSalt salt = hashWithSalt salt . installedUnitIdString
 #else
 instance Show InstalledUnitId where show = prettyPrint
+deriving instance Ord SrcSpan
+deriving instance Ord UnhelpfulSpanReason
 #endif
 
 instance NFData SB.StringBuffer where rnf = rwhnf
@@ -162,3 +165,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

@@ -13,6 +13,8 @@ import           Control.Monad.Extra
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Maybe
 import           Data.Aeson
+import qualified Data.HashMap.Strict                          as Map
+import qualified Data.HashSet                                 as Set
 import           Data.List                                    (find)
 import           Data.Maybe
 import qualified Data.Text                                    as T
@@ -23,16 +25,21 @@ 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.Exports
+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
@@ -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{anyQualCompls = 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,20 @@ 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 sym importQual False
+                sym = if isNothing importQual then Just it else Nothing
+                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 -> Maybe T.Text -> CompItem
+fromIdentInfo doc IdentInfo{..} q = 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 = q,
+            newThing = rendered
+          }
+  }
 
 cacheDataProducer :: Uri -> HscEnvEq -> Module -> GlobalRdrEnv-> GlobalRdrEnv -> [LImportDecl GhcPs] -> IO CachedCompletions
 cacheDataProducer uri env curMod globalEnv inScopeEnv limports = do
@@ -385,6 +407,7 @@ cacheDataProducer uri env curMod globalEnv inScopeEnv limports = do
     { allModNamesAsNS = allModNamesAsNS
     , unqualCompls = unquals
     , qualCompls = quals
+    , anyQualCompls = []
     , importableModules = moduleNames
     }
 
@@ -394,6 +417,7 @@ localCompletionsForParsedModule uri pm@ParsedModule{pm_parsed_source = L _ HsMod
     CC { allModNamesAsNS = mempty
        , unqualCompls = compls
        , qualCompls = mempty
+       , anyQualCompls = []
        , importableModules = mempty
         }
   where
@@ -507,7 +531,7 @@ getCompletions
     -> ClientCapabilities
     -> CompletionsConfig
     -> IO [CompletionItem]
-getCompletions plId ideOpts CC {allModNamesAsNS, unqualCompls, qualCompls, importableModules}
+getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qualCompls, importableModules}
                maybe_parsed (localBindings, bmapping) prefixInfo caps config = do
   let VFS.PosPrefixInfo { fullLine, prefixModule, prefixText } = prefixInfo
       enteredQual = if T.null prefixModule then "" else prefixModule <> "."
@@ -566,8 +590,9 @@ getCompletions plId ideOpts CC {allModNamesAsNS, unqualCompls, qualCompls, impor
                 Just m  -> Right $ ppr m
 
           compls = if T.null prefixModule
-            then localCompls ++ unqualCompls
-            else Map.findWithDefault [] prefixModule $ getQualCompls qualCompls
+            then localCompls ++ unqualCompls ++ (($Nothing) <$> anyQualCompls)
+            else Map.findWithDefault [] prefixModule (getQualCompls qualCompls)
+                 ++ (($ Just prefixModule) <$> anyQualCompls)
 
       filtListWith f list =
         [ f label
@@ -606,13 +631,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
 
@@ -91,18 +91,21 @@ instance Monoid QualCompls where
 data CachedCompletions = CC
   { allModNamesAsNS   :: [T.Text] -- ^ All module names in scope.
                                 -- Prelude is a single module
-  , unqualCompls      :: [CompItem]  -- ^ All Possible completion items
+  , unqualCompls      :: [CompItem]  -- ^ Unqualified completion items
   , qualCompls        :: QualCompls    -- ^ Completion items associated to
                                 -- to a specific module name.
+  , anyQualCompls     :: [Maybe T.Text -> CompItem] -- ^ Items associated to any qualifier
   , importableModules :: [T.Text] -- ^ All modules that may be imported.
-  } deriving Show
+  }
+
+instance Show CachedCompletions where show _ = "<cached completions>"
 
 instance NFData CachedCompletions where
     rnf = rwhnf
 
 instance Monoid CachedCompletions where
-    mempty = CC mempty mempty mempty mempty
+    mempty = CC mempty mempty mempty mempty mempty
 
 instance Semigroup CachedCompletions where
-    CC a b c d <> CC a' b' c' d' =
-        CC (a<>a') (b<>b') (c<>c') (d<>d')
+    CC a b c d e <> CC a' b' c' d' e' =
+        CC (a<>a') (b<>b') (c<>c') (d<>d') (e<>e')

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 {..} = (pack (prettyPrint name), [id])