Auto complete definitions within imports

ghcide/src/Development/IDE/Core/Shake.hs

@@ -109,8 +109,7 @@ import           Development.IDE.Core.PositionMapping
 import           Development.IDE.Core.ProgressReporting
 import           Development.IDE.Core.RuleTypes
 import           Development.IDE.Core.Tracing
-import           Development.IDE.GHC.Compat             (NameCacheUpdater (..),
-                                                         upNameCache)
+import           Development.IDE.GHC.Compat             (NameCacheUpdater (..), upNameCache)
 import           Development.IDE.GHC.Orphans            ()
 import           Development.IDE.Graph                  hiding (ShakeValue)
 import qualified Development.IDE.Graph                  as Shake

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

@@ -30,6 +30,7 @@ import           Development.IDE.GHC.ExactPrint               (Annotated (annsA)
 import           Development.IDE.GHC.Util                     (prettyPrint)
 import           Development.IDE.Graph
 import           Development.IDE.Graph.Classes
+import           Development.IDE.Import.FindImports           
 import           Development.IDE.Plugin.CodeAction            (newImport,
                                                                newImportToEdit)
 import           Development.IDE.Plugin.CodeAction.ExactPrint
@@ -131,18 +132,21 @@ getCompletionsLSP ide plId
     fmap Right $ case (contents, uriToFilePath' uri) of
       (Just cnts, Just path) -> do
         let npath = toNormalizedFilePath' path
-        (ideOpts, compls) <- liftIO $ runIdeAction "Completion" (shakeExtras ide) $ do
+        (ideOpts, compls, moduleExports) <- liftIO $ runIdeAction "Completion" (shakeExtras ide) $ do
             opts <- liftIO $ getIdeOptionsIO $ shakeExtras ide
             localCompls <- useWithStaleFast LocalCompletions npath
             nonLocalCompls <- useWithStaleFast NonLocalCompletions npath
             pm <- useWithStaleFast GetParsedModule npath
             binds <- fromMaybe (mempty, zeroMapping) <$> useWithStaleFast GetBindings npath
             exportsMapIO <- fmap(envPackageExports . fst) <$> useWithStaleFast GhcSession npath
             exportsMap <- mapM liftIO exportsMapIO
-            let exportsCompItems = foldMap (map (fromIdentInfo uri) . Set.toList) . Map.elems . getExportsMap <$> exportsMap
+            locatedImports <- fromMaybe (mempty, zeroMapping) <$> useWithStaleFast GetLocatedImports npath
+            localModuleExports <- liftIO $ buildLocalModuleExports ide locatedImports
+            let moduleExports = maybe Map.empty getModuleExportsMap exportsMap
+                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)
+            pure (opts, fmap (,pm,binds) compls, Map.unionWith (<>) localModuleExports moduleExports)
         case compls of
           Just (cci', parsedMod, bindMap) -> do
             pfix <- VFS.getCompletionPrefix position cnts
@@ -152,13 +156,21 @@ getCompletionsLSP ide plId
               (Just pfix', _) -> do
                 let clientCaps = clientCapabilities $ shakeExtras ide
                 config <- getCompletionsConfig plId
-                allCompletions <- liftIO $ getCompletions plId ideOpts cci' parsedMod bindMap pfix' clientCaps config
+                allCompletions <- liftIO $ getCompletions plId ideOpts cci' parsedMod bindMap pfix' clientCaps config moduleExports
                 pure $ InL (List allCompletions)
               _ -> return (InL $ List [])
           _ -> return (InL $ List [])
       _ -> return (InL $ List [])
 
 ----------------------------------------------------------------------------------------------------
+
+buildLocalModuleExports:: IdeState -> ([(Located ModuleName, Maybe ArtifactsLocation)], PositionMapping) -> IO (Map.HashMap T.Text (Set.HashSet IdentInfo))
+buildLocalModuleExports ide inMap = do
+  let artifactLoctions = mapMaybe snd (fst inMap)
+  let afp = map artifactFilePath artifactLoctions
+  let queries = map (useWithStaleFast GetModIface) afp
+  files <- liftIO $ mapM (runIdeAction "Completion" (shakeExtras ide)) queries
+  pure (buildModuleExportMapFrom $ map (hirModIface . fst) $ catMaybes files)
 
 extendImportCommand :: PluginCommand IdeState
 extendImportCommand =

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

@@ -41,7 +41,9 @@ import           Control.Monad
 import           Data.Aeson                               (ToJSON (toJSON))
 import           Data.Either                              (fromRight)
 import           Data.Functor
+import qualified Data.HashMap.Strict                      as HM
 import qualified Data.Set                                 as Set
+import qualified Data.HashSet                             as HashSet
 import           Development.IDE.Core.Compile
 import           Development.IDE.Core.PositionMapping
 import           Development.IDE.GHC.Compat               as GHC
@@ -285,6 +287,12 @@ mkModCompl label =
     Nothing Nothing Nothing Nothing Nothing Nothing Nothing
     Nothing Nothing Nothing Nothing Nothing Nothing
 
+mkModuleFunctionImport :: T.Text -> T.Text -> CompletionItem
+mkModuleFunctionImport moduleName label =
+  CompletionItem label (Just CiFunction) Nothing (Just moduleName)
+    Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+    Nothing Nothing Nothing Nothing Nothing Nothing
+
 mkImportCompl :: T.Text -> T.Text -> CompletionItem
 mkImportCompl enteredQual label =
   CompletionItem m (Just CiModule) Nothing (Just label)
@@ -525,9 +533,10 @@ getCompletions
     -> VFS.PosPrefixInfo
     -> ClientCapabilities
     -> CompletionsConfig
+    -> HM.HashMap T.Text (HashSet.HashSet IdentInfo)
     -> IO [CompletionItem]
 getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qualCompls, importableModules}
-               maybe_parsed (localBindings, bmapping) prefixInfo caps config = do
+               maybe_parsed (localBindings, bmapping) prefixInfo caps config moduleExportsMap = do
   let VFS.PosPrefixInfo { fullLine, prefixModule, prefixText } = prefixInfo
       enteredQual = if T.null prefixModule then "" else prefixModule <> "."
       fullPrefix  = enteredQual <> prefixText
@@ -596,12 +605,21 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu
         ]
 
       filtImportCompls = filtListWith (mkImportCompl enteredQual) importableModules
+      filterModuleExports moduleName = filtListWith $ mkModuleFunctionImport moduleName
       filtKeywordCompls
           | T.null prefixModule = filtListWith mkExtCompl (optKeywords ideOpts)
           | otherwise = []
 
-
   if
+    -- TODO: handle multiline imports 
+    | "import " `T.isPrefixOf` fullLine 
+      && (List.length (words (T.unpack fullLine)) >= 2)
+      && "(" `isInfixOf` T.unpack fullLine
+    -> do
+      let moduleName = T.pack $ words (T.unpack fullLine) !! 1
+          funcs = HM.lookupDefault HashSet.empty moduleName moduleExportsMap
+          funs = map (show . name) $ HashSet.toList funcs
+      return $ filterModuleExports moduleName $ map T.pack funs
     | "import " `T.isPrefixOf` fullLine
     -> return filtImportCompls
     -- we leave this condition here to avoid duplications and return empty list

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

@@ -6,7 +6,8 @@ module Development.IDE.Types.Exports
     ExportsMap(..),
     createExportsMap,
     createExportsMapMg,
-    createExportsMapTc
+    createExportsMapTc,
+    buildModuleExportMapFrom
 ,createExportsMapHieDb,size) where
 
 import           Avail                       (AvailInfo (..))
@@ -30,17 +31,24 @@ import           HieDb
 import           Name
 import           TcRnTypes                   (TcGblEnv (..))
 
-newtype ExportsMap = ExportsMap
-    {getExportsMap :: HashMap IdentifierText (HashSet IdentInfo)}
-    deriving newtype (Monoid, NFData, Show)
+
+data ExportsMap = ExportsMap
+    {getExportsMap :: HashMap IdentifierText (HashSet IdentInfo)
+    , getModuleExportsMap :: Map.HashMap ModuleNameText (HashSet IdentInfo)
+    }
+    deriving (Show)
 
 size :: ExportsMap -> Int
 size = sum . map length . elems . getExportsMap
 
 instance Semigroup ExportsMap where
-    ExportsMap a <> ExportsMap b = ExportsMap $ Map.unionWith (<>) a b
+  ExportsMap a b <> ExportsMap c d = ExportsMap (Map.unionWith (<>) a c) (Map.unionWith (<>) b d)
+
+instance Monoid ExportsMap where
+  mempty = ExportsMap Map.empty Map.empty
 
 type IdentifierText = Text
+type ModuleNameText = Text
 
 data IdentInfo = IdentInfo
     { name           :: !OccName
@@ -91,25 +99,34 @@ mkIdentInfos mod (AvailTC _ nn flds)
       ]
 
 createExportsMap :: [ModIface] -> ExportsMap
-createExportsMap = ExportsMap . Map.fromListWith (<>) . concatMap doOne
+createExportsMap modIface = do
+  let exportList = concatMap doOne modIface
+  let exportsMap = Map.fromListWith (<>) $ map (\(a,_,c) -> (a, c)) exportList
+  ExportsMap exportsMap $ buildModuleExportMap $ map (\(_,b,c) -> (b, c)) exportList
   where
-    doOne mi = concatMap (fmap (second Set.fromList) . unpackAvail mn) (mi_exports mi)
-      where
-        mn = moduleName $ mi_module mi
+    doOne modIFace = do
+      let getModDetails = unpackAvail $ moduleName $ mi_module modIFace
+      concatMap (fmap (second Set.fromList) . getModDetails) (mi_exports modIFace)
 
 createExportsMapMg :: [ModGuts] -> ExportsMap
-createExportsMapMg = ExportsMap . Map.fromListWith (<>) . concatMap doOne
+createExportsMapMg modGuts = do
+  let exportList = concatMap doOne modGuts
+  let exportsMap = Map.fromListWith (<>) $ map (\(a,_,c) -> (a, c)) exportList
+  ExportsMap exportsMap $ buildModuleExportMap $ map (\(_,b,c) -> (b, c)) exportList
   where
-    doOne mi = concatMap (fmap (second Set.fromList) . unpackAvail mn) (mg_exports mi)
-      where
-        mn = moduleName $ mg_module mi
+    doOne mi = do
+      let getModuleName = moduleName $ mg_module mi
+      concatMap (fmap (second Set.fromList) . unpackAvail getModuleName) (mg_exports mi)
 
 createExportsMapTc :: [TcGblEnv] -> ExportsMap
-createExportsMapTc = ExportsMap . Map.fromListWith (<>) . concatMap doOne
+createExportsMapTc modIface = do
+  let exportList = concatMap doOne modIface
+  let exportsMap = Map.fromListWith (<>) $ map (\(a,_,c) -> (a, c)) exportList
+  ExportsMap exportsMap $ buildModuleExportMap $ map (\(_,b,c) -> (b, c)) exportList
   where
-    doOne mi = concatMap (fmap (second Set.fromList) . unpackAvail mn) (tcg_exports mi)
-      where
-        mn = moduleName $ tcg_mod mi
+    doOne mi = do
+      let getModuleName = moduleName $ tcg_mod mi
+      concatMap (fmap (second Set.fromList) . unpackAvail getModuleName) (tcg_exports mi)
 
 nonInternalModules :: ModuleName -> Bool
 nonInternalModules = not . (".Internal" `isSuffixOf`) . moduleNameString
@@ -121,7 +138,8 @@ createExportsMapHieDb hiedb = do
         let mn = modInfoName $ hieModInfo m
             mText = pack $ moduleNameString mn
         fmap (wrap . unwrap mText) <$> getExportsForModule hiedb mn
-    return $ ExportsMap $ Map.fromListWith (<>) (concat idents)
+    let exportsMap = Map.fromListWith (<>) (concat idents)
+    return $ ExportsMap exportsMap $ buildModuleExportMap (concat idents)
   where
     wrap identInfo = (rendered identInfo, Set.fromList [identInfo])
     -- unwrap :: ExportRow -> IdentInfo
@@ -130,10 +148,35 @@ createExportsMapHieDb hiedb = do
           n = pack (occNameString exportName)
           p = pack . occNameString <$> exportParent
 
-unpackAvail :: ModuleName -> IfaceExport -> [(Text, [IdentInfo])]
+unpackAvail :: ModuleName -> IfaceExport -> [(Text, Text, [IdentInfo])]
 unpackAvail mn
   | nonInternalModules mn = map f . mkIdentInfos mod
   | otherwise = const []
   where
     !mod = pack $ moduleNameString mn
-    f id@IdentInfo {..} = (pack (prettyPrint name), [id])
+    f id@IdentInfo {..} = (pack (prettyPrint name), moduleNameText,[id])
+
+
+identInfoToKeyVal :: IdentInfo -> (ModuleNameText, IdentInfo)
+identInfoToKeyVal identInfo =
+  (moduleNameText identInfo, identInfo)
+
+buildModuleExportMap:: [(Text, HashSet IdentInfo)] -> Map.HashMap ModuleNameText (HashSet IdentInfo)
+buildModuleExportMap exportsMap = do
+  let lst = concatMap (Set.toList. snd) exportsMap
+  let lstThree = map identInfoToKeyVal lst
+  sortAndGroup lstThree
+
+buildModuleExportMapFrom:: [ModIface] -> Map.HashMap Text (HashSet IdentInfo)
+buildModuleExportMapFrom modIfaces = do
+  let exports = map extractModuleExports modIfaces
+  Map.fromListWith (<>) exports
+
+extractModuleExports :: ModIface -> (Text, HashSet IdentInfo)
+extractModuleExports modIFace = do
+  let modName = pack $ moduleNameString $ moduleName $ mi_module modIFace
+  let functionSet = Set.fromList $ concatMap (mkIdentInfos modName) $ mi_exports modIFace
+  (modName, functionSet)
+
+sortAndGroup :: [(ModuleNameText, IdentInfo)] -> Map.HashMap ModuleNameText (HashSet IdentInfo)
+sortAndGroup assocs = Map.fromListWith (<>) [(k, Set.fromList [v]) | (k, v) <- assocs]

test/functional/Completion.hs

@@ -121,6 +121,31 @@ tests = testGroup "completions" [
          compls <- getCompletions doc (Position 5 7)
          liftIO $ length compls @?= maxCompletions def
 
+     , testCase "import function completions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
+         doc <- openDoc "FunctionCompletions.hs" "haskell"
+
+         let te = TextEdit (Range (Position 0 30) (Position 0 41)) "A"
+         _ <- applyEdit doc te
+
+         compls <- getCompletions doc (Position 0 31)
+         let item = head $ filter ((== "Alternative") . (^. label)) compls
+         liftIO $ do
+             item ^. label @?= "Alternative"
+             item ^. kind @?= Just CiFunction
+             item ^. detail @?= Just "Control.Applicative"
+
+    , testCase "import second function completion" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
+         doc <- openDoc "FunctionCompletions.hs" "haskell"
+
+         let te = TextEdit (Range (Position 0 41) (Position 0 42)) ", l"
+         _ <- applyEdit doc te
+
+         compls <- getCompletions doc (Position 0 41)
+         let item = head $ filter ((== "liftA") . (^. label)) compls
+         liftIO $ do
+             item ^. label @?= "liftA"
+             item ^. kind @?= Just CiFunction
+             item ^. detail @?= Just "Control.Applicative"
      , contextTests
      , snippetTests
     ]

test/testdata/completion/FunctionCompletions.hs

@@ -0,0 +1,8 @@
+import Control.Applicative (Alternative)
+import qualified Data.List
+
+main :: IO ()
+main = putStrLn "hello"
+
+foo :: Either a b -> Either a b
+foo = id