Skip to content

Commit 47fd19d

Browse files
alexnaspoalexnaspo
committed
auto complete functions from imports
1 parent a800b9d commit 47fd19d

File tree

4 files changed

+76
-9
lines changed

4 files changed

+76
-9
lines changed

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

Lines changed: 20 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,7 @@ import Data.Aeson
1616
import qualified Data.HashMap.Strict as Map
1717
import qualified Data.HashSet as Set
1818
import Data.List (find)
19+
import qualified Data.Map as DM (Map, fromListWith, empty)
1920
import Data.Maybe
2021
import qualified Data.Text as T
2122
import Development.IDE.Core.PositionMapping
@@ -131,35 +132,49 @@ getCompletionsLSP ide plId
131132
fmap Right $ case (contents, uriToFilePath' uri) of
132133
(Just cnts, Just path) -> do
133134
let npath = toNormalizedFilePath' path
134-
(ideOpts, compls) <- liftIO $ runIdeAction "Completion" (shakeExtras ide) $ do
135+
(ideOpts, compls, moduleExports) <- liftIO $ runIdeAction "Completion" (shakeExtras ide) $ do
135136
opts <- liftIO $ getIdeOptionsIO $ shakeExtras ide
136137
localCompls <- useWithStaleFast LocalCompletions npath
137138
nonLocalCompls <- useWithStaleFast NonLocalCompletions npath
138139
pm <- useWithStaleFast GetParsedModule npath
139140
binds <- fromMaybe (mempty, zeroMapping) <$> useWithStaleFast GetBindings npath
140141
exportsMapIO <- fmap(envPackageExports . fst) <$> useWithStaleFast GhcSession npath
141142
exportsMap <- mapM liftIO exportsMapIO
143+
let moduleExports = buildModouleExportMap exportsMap
142144
let exportsCompItems = foldMap (map (fromIdentInfo uri) . Set.toList) . Map.elems . getExportsMap <$> exportsMap
143145
exportsCompls = mempty{anyQualCompls = fromMaybe [] exportsCompItems}
144146
let compls = (fst <$> localCompls) <> (fst <$> nonLocalCompls) <> Just exportsCompls
145-
pure (opts, fmap (,pm,binds) compls)
146-
case compls of
147-
Just (cci', parsedMod, bindMap) -> do
147+
pure (opts, fmap (,pm,binds) compls, moduleExports)
148+
case (compls, moduleExports) of
149+
(Just (cci', parsedMod, bindMap), mExports) -> do
148150
pfix <- VFS.getCompletionPrefix position cnts
149151
case (pfix, completionContext) of
150152
(Just (VFS.PosPrefixInfo _ "" _ _), Just CompletionContext { _triggerCharacter = Just "."})
151153
-> return (InL $ List [])
152154
(Just pfix', _) -> do
153155
let clientCaps = clientCapabilities $ shakeExtras ide
154156
config <- getCompletionsConfig plId
155-
allCompletions <- liftIO $ getCompletions plId ideOpts cci' parsedMod bindMap pfix' clientCaps config
157+
allCompletions <- liftIO $ getCompletions plId ideOpts cci' parsedMod bindMap pfix' clientCaps config mExports
156158
pure $ InL (List allCompletions)
157159
_ -> return (InL $ List [])
158160
_ -> return (InL $ List [])
159161
_ -> return (InL $ List [])
160162

161163
----------------------------------------------------------------------------------------------------
162164

165+
identInfoToKeyVal :: IdentInfo -> (T.Text, T.Text)
166+
identInfoToKeyVal IdentInfo {rendered, moduleNameText} =
167+
(moduleNameText, rendered)
168+
169+
buildModouleExportMap:: Maybe (ExportsMap) -> DM.Map T.Text [T.Text]
170+
buildModouleExportMap (Just exportsMap) = do
171+
sortAndGroup $ map identInfoToKeyVal $
172+
concatMap (Set.toList . snd) $ toList $ getExportsMap exportsMap
173+
buildModouleExportMap (Nothing) = DM.empty
174+
175+
sortAndGroup :: [(T.Text, T.Text)] -> DM.Map T.Text [T.Text]
176+
sortAndGroup assocs = DM.fromListWith (++) [(k, [v]) | (k, v) <- assocs]
177+
163178
extendImportCommand :: PluginCommand IdeState
164179
extendImportCommand =
165180
PluginCommand (CommandId extendImportCommandId) "additional edits for a completion" extendImportHandler

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

Lines changed: 23 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,7 @@ import Control.Monad
4141
import Data.Aeson (ToJSON (toJSON))
4242
import Data.Either (fromRight)
4343
import Data.Functor
44+
import qualified Data.Map as DM (Map)
4445
import qualified Data.Set as Set
4546
import Development.IDE.Core.Compile
4647
import Development.IDE.Core.PositionMapping
@@ -54,7 +55,7 @@ import Development.IDE.Spans.LocalBindings
5455
import Development.IDE.Types.Exports
5556
import Development.IDE.Types.HscEnvEq
5657
import Development.IDE.Types.Options
57-
import GhcPlugins (flLabel, unpackFS)
58+
import GhcPlugins (flLabel, unpackFS, lookupWithDefaultUFM)
5859
import Ide.PluginUtils (mkLspCommand)
5960
import Ide.Types (CommandId (..),
6061
PluginId)
@@ -64,6 +65,7 @@ import qualified Language.LSP.VFS as VFS
6465
import Outputable (Outputable)
6566
import TyCoRep
6667

68+
6769
-- From haskell-ide-engine/hie-plugin-api/Haskell/Ide/Engine/Context.hs
6870

6971
-- | A context of a declaration in the program
@@ -285,6 +287,13 @@ mkModCompl label =
285287
Nothing Nothing Nothing Nothing Nothing Nothing Nothing
286288
Nothing Nothing Nothing Nothing Nothing Nothing
287289

290+
291+
mkModuleFunctionImport :: T.Text -> T.Text -> CompletionItem
292+
mkModuleFunctionImport moduleName label =
293+
CompletionItem label (Just CiFunction) Nothing (Just moduleName)
294+
Nothing Nothing Nothing Nothing Nothing Nothing Nothing
295+
Nothing Nothing Nothing Nothing Nothing Nothing
296+
288297
mkImportCompl :: T.Text -> T.Text -> CompletionItem
289298
mkImportCompl enteredQual label =
290299
CompletionItem m (Just CiModule) Nothing (Just label)
@@ -530,9 +539,10 @@ getCompletions
530539
-> VFS.PosPrefixInfo
531540
-> ClientCapabilities
532541
-> CompletionsConfig
542+
-> DM.Map T.Text [T.Text]
533543
-> IO [CompletionItem]
534544
getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qualCompls, importableModules}
535-
maybe_parsed (localBindings, bmapping) prefixInfo caps config = do
545+
maybe_parsed (localBindings, bmapping) prefixInfo caps config exportsMap = do
536546
let VFS.PosPrefixInfo { fullLine, prefixModule, prefixText } = prefixInfo
537547
enteredQual = if T.null prefixModule then "" else prefixModule <> "."
538548
fullPrefix = enteredQual <> prefixText
@@ -619,9 +629,17 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu
619629
| s == c = ss
620630
| otherwise = s:ss
621631

622-
if
632+
if
633+
| "import " `T.isPrefixOf` fullLine
634+
&& (List.length (words (T.unpack fullLine)) >= 2)
635+
&& "(" `isInfixOf` T.unpack fullLine
636+
-> do
637+
let moduleName = (words (T.unpack fullLine)) !! 1
638+
funcs = Map.findWithDefault [] (T.pack moduleName) exportsMap
639+
return (map (mkModuleFunctionImport (T.pack moduleName)) funcs)
623640
| "import " `T.isPrefixOf` fullLine
624-
-> return filtImportCompls
641+
-> do
642+
return filtImportCompls
625643
-- we leave this condition here to avoid duplications and return empty list
626644
-- since HLS implements this completion (#haskell-language-server/pull/662)
627645
| "{-# language" `T.isPrefixOf` T.toLower fullLine
@@ -651,6 +669,7 @@ uniqueCompl x y =
651669
then EQ
652670
else compare (insertText x) (insertText y)
653671
other -> other
672+
654673
-- ---------------------------------------------------------------------
655674
-- helper functions for pragmas
656675
-- ---------------------------------------------------------------------

‎test/functional/Completion.hs

Lines changed: 25 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -121,6 +121,31 @@ tests = testGroup "completions" [
121121
compls <- getCompletions doc (Position 5 7)
122122
liftIO $ length compls @?= maxCompletions def
123123

124+
, testCase "import function completions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
125+
doc <- openDoc "FunctionCompletions.hs" "haskell"
126+
127+
let te = TextEdit (Range (Position 0 30) (Position 0 41)) "A"
128+
_ <- applyEdit doc te
129+
130+
compls <- getCompletions doc (Position 0 31)
131+
let item = head $ filter ((== "Alternative") . (^. label)) compls
132+
liftIO $ do
133+
item ^. label @?= "Alternative"
134+
item ^. kind @?= Just CiFunction
135+
item ^. detail @?= Just "Control.Applicative"
136+
137+
, testCase "import second function completion" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
138+
doc <- openDoc "FunctionCompletions.hs" "haskell"
139+
140+
let te = TextEdit (Range (Position 0 41) (Position 0 42)) ", l"
141+
_ <- applyEdit doc te
142+
143+
compls <- getCompletions doc (Position 0 41)
144+
let item = head $ filter ((== "liftA") . (^. label)) compls
145+
liftIO $ do
146+
item ^. label @?= "liftA"
147+
item ^. kind @?= Just CiFunction
148+
item ^. detail @?= Just "Control.Applicative"
124149
, contextTests
125150
, snippetTests
126151
]

‎test/testdata/completion/FunctionCompletions.hs

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
import Control.Applicative (Alternative)
2+
import qualified Data.List
3+
4+
main :: IO ()
5+
main = putStrLn "hello"
6+
7+
foo :: Either a b -> Either a b
8+
foo = id

0 commit comments

Comments
 (0)