Auto complete definitions within imports

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

@@ -16,6 +16,7 @@ import           Data.Aeson
 import qualified Data.HashMap.Strict                          as Map
 import qualified Data.HashSet                                 as Set
 import           Data.List                                    (find)
+import qualified Data.Map                                     as DM (Map, fromListWith, empty)
 import           Data.Maybe
 import qualified Data.Text                                    as T
 import           Development.IDE.Core.PositionMapping
@@ -131,35 +132,49 @@ 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 moduleExports = buildModouleExportMap exportsMap
             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
+            pure (opts, fmap (,pm,binds) compls, moduleExports)
+        case (compls, moduleExports) of
+          (Just (cci', parsedMod, bindMap), mExports) -> do
             pfix <- VFS.getCompletionPrefix position cnts
             case (pfix, completionContext) of
               (Just (VFS.PosPrefixInfo _ "" _ _), Just CompletionContext { _triggerCharacter = Just "."})
                 -> return (InL $ List [])
               (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 mExports
                 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)
+
+buildModouleExportMap:: Maybe (ExportsMap) -> DM.Map T.Text [T.Text]
+buildModouleExportMap (Just exportsMap) = do
+  sortAndGroup $ map identInfoToKeyVal $ 
+    concatMap (Set.toList . snd) $ toList $ getExportsMap exportsMap
+buildModouleExportMap (Nothing) = DM.empty 
+
+sortAndGroup :: [(T.Text, T.Text)] -> DM.Map T.Text [T.Text]
+sortAndGroup assocs = DM.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.Map                                 as DM (Map)
 import qualified Data.Set                                 as Set
 import           Development.IDE.Core.Compile
 import           Development.IDE.Core.PositionMapping
@@ -54,7 +55,7 @@ import           Development.IDE.Spans.LocalBindings
 import           Development.IDE.Types.Exports
 import           Development.IDE.Types.HscEnvEq
 import           Development.IDE.Types.Options
-import           GhcPlugins                               (flLabel, unpackFS)
+import           GhcPlugins                               (flLabel, unpackFS, lookupWithDefaultUFM)
 import           Ide.PluginUtils                          (mkLspCommand)
 import           Ide.Types                                (CommandId (..),
                                                            PluginId)
@@ -64,6 +65,7 @@ import qualified Language.LSP.VFS                         as VFS
 import           Outputable                               (Outputable)
 import           TyCoRep
 
+
 -- From haskell-ide-engine/hie-plugin-api/Haskell/Ide/Engine/Context.hs
 
 -- | A context of a declaration in the program
@@ -285,6 +287,13 @@ 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)
@@ -530,9 +539,10 @@ getCompletions
     -> VFS.PosPrefixInfo
     -> ClientCapabilities
     -> CompletionsConfig
+    -> DM.Map 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
@@ -619,9 +629,17 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu
         | s == c = ss
         | otherwise = s:ss
 
-  if
+  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 = Map.findWithDefault [] (T.pack moduleName) exportsMap
+      return (map (mkModuleFunctionImport (T.pack moduleName)) funcs)
     | "import " `T.isPrefixOf` fullLine
-    -> return filtImportCompls
+    -> do
+      return filtImportCompls
     -- we leave this condition here to avoid duplications and return empty list
     -- since HLS implements this completion (#haskell-language-server/pull/662)
     | "{-# language" `T.isPrefixOf` T.toLower fullLine
@@ -651,6 +669,7 @@ uniqueCompl x y =
         then EQ
         else compare (insertText x) (insertText y)
     other -> other
+
 -- ---------------------------------------------------------------------
 -- helper functions for pragmas
 -- ---------------------------------------------------------------------

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