Auto complete definitions within imports

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

@@ -131,18 +131,19 @@ 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
+            let moduleExports = buildModuleExportMap 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, moduleExports)
         case compls of
           Just (cci', parsedMod, bindMap) -> do
             pfix <- VFS.getCompletionPrefix position cnts
@@ -152,14 +153,27 @@ 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 [])
 
 ----------------------------------------------------------------------------------------------------
 
+identInfoToKeyVal :: IdentInfo -> (T.Text, T.Text)
+identInfoToKeyVal IdentInfo {rendered, moduleNameText} =
+  (moduleNameText, rendered)
+
+buildModuleExportMap:: Maybe ExportsMap -> Map.HashMap T.Text [T.Text]
+buildModuleExportMap (Just exportsMap) = do
+  sortAndGroup $ map identInfoToKeyVal $ 
+    concatMap (Set.toList . snd) $ toList $ getExportsMap exportsMap
+buildModuleExportMap Nothing = Map.empty 
+
+sortAndGroup :: [(T.Text, T.Text)] -> Map.HashMap T.Text [T.Text]
+sortAndGroup assocs = Map.fromListWith (++) [(k, [v]) | (k, v) <- assocs]  
+
 extendImportCommand :: PluginCommand IdeState
 extendImportCommand =
   PluginCommand (CommandId extendImportCommandId) "additional edits for a completion" extendImportHandler

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

@@ -41,6 +41,7 @@ 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           Development.IDE.Core.Compile
 import           Development.IDE.Core.PositionMapping
@@ -285,6 +286,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 +532,10 @@ getCompletions
     -> VFS.PosPrefixInfo
     -> ClientCapabilities
     -> CompletionsConfig
+    -> HM.HashMap T.Text [T.Text]
     -> 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 exportsMap = do
   let VFS.PosPrefixInfo { fullLine, prefixModule, prefixText } = prefixInfo
       enteredQual = if T.null prefixModule then "" else prefixModule <> "."
       fullPrefix  = enteredQual <> prefixText
@@ -602,6 +610,13 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu
 
 
   if
+    | "import " `T.isPrefixOf` fullLine 
+      && (List.length (words (T.unpack fullLine)) >= 2)
+      && "(" `isInfixOf` T.unpack fullLine
+    -> do  
+      let moduleName = words (T.unpack fullLine) !! 1
+          funcs = HM.lookupDefault [] (T.pack moduleName) exportsMap
+      return (map (mkModuleFunctionImport (T.pack moduleName)) funcs)
     | "import " `T.isPrefixOf` fullLine
     -> return filtImportCompls
     -- we leave this condition here to avoid duplications and return empty list

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