45f9742 · ghcide · git.iko.soy

git.iko.soy/ghcide

on master help sign in

Improve completion contexts (#495)

45f9742Moritz Kiefer7 years ago

src/Development/IDE/Plugin/Completions.hs+13−9

compare with master

unifiedsplit

@@ -2,6 +2,8 @@

3module Development.IDE.Plugin.Completions(plugin) where

5+import Control.Applicative

6+import Data.Maybe

5import Language.Haskell.LSP.Messages

7import Language.Haskell.LSP.Messages

6import Language.Haskell.LSP.Types

8import Language.Haskell.LSP.Types

7import qualified Language.Haskell.LSP.Core as LSP

9import qualified Language.Haskell.LSP.Core as LSP

@@ -10,8 +12,6 @@ import Language.Haskell.LSP.Types.Capabilities

10import Development.Shake.Classes

12import Development.Shake.Classes

11import Development.Shake

13import Development.Shake

12import GHC.Generics

14import GHC.Generics

13−import Data.Maybe

14−import HscTypes

16import Development.IDE.Plugin

17import Development.IDE.Core.Service

@@ -37,14 +37,14 @@ produceCompletions =

37 packageState <- fmap (hscEnv . fst) <$> useWithStale GhcSession file

38 case (tm, packageState) of

39 (Just tm', Just packageState') -> do

40− cdata <- liftIO $ cacheDataProducer packageState' (hsc_dflags packageState')

40+ cdata <- liftIO $ cacheDataProducer packageState'

41 (tmrModule tm') parsedDeps

42− return ([], Just (cdata, tm'))

42+ return ([], Just cdata)

43 _ -> return ([], Nothing)

46-- | Produce completions info for a file

47−type instance RuleResult ProduceCompletions = (CachedCompletions, TcModuleResult)

47+type instance RuleResult ProduceCompletions = CachedCompletions

49data ProduceCompletions = ProduceCompletions

50 deriving (Eq, Show, Typeable, Generic)

@@ -67,17 +67,21 @@ getCompletionsLSP lsp ide

67 fmap Right $ case (contents, uriToFilePath' uri) of

68 (Just cnts, Just path) -> do

69 let npath = toNormalizedFilePath path

70+ (ideOpts, compls) <- runAction ide $ do

71+ opts <- getIdeOptions

70− (ideOpts, compls) <- runAction ide ((,) <$> getIdeOptions <*> useWithStale ProduceCompletions npath)

72+ compls <- useWithStale ProduceCompletions npath

73+ pm <- useWithStale GetParsedModule npath

74+ pure (opts, liftA2 (,) compls pm)

71 case compls of

75 case compls of

72− Just ((cci', tm'), mapping) -> do

76+ Just ((cci', _), (pm, mapping)) -> do

73− let position' = fromCurrentPosition mapping position

77+ let !position' = fromCurrentPosition mapping position

74 pfix <- maybe (return Nothing) (flip VFS.getCompletionPrefix cnts) position'

78 pfix <- maybe (return Nothing) (flip VFS.getCompletionPrefix cnts) position'

75 case (pfix, completionContext) of

79 case (pfix, completionContext) of

76 (Just (VFS.PosPrefixInfo _ "" _ _), Just CompletionContext { _triggerCharacter = Just "."})

80 (Just (VFS.PosPrefixInfo _ "" _ _), Just CompletionContext { _triggerCharacter = Just "."})

77 -> return (Completions $ List [])

81 -> return (Completions $ List [])

78 (Just pfix', _) -> do

82 (Just pfix', _) -> do

79 let fakeClientCapabilities = ClientCapabilities Nothing Nothing Nothing Nothing

83 let fakeClientCapabilities = ClientCapabilities Nothing Nothing Nothing Nothing

80− Completions . List <$> getCompletions ideOpts cci' (tmrModule tm') pfix' fakeClientCapabilities (WithSnippets True)

84+ Completions . List <$> getCompletions ideOpts cci' pm pfix' fakeClientCapabilities (WithSnippets True)

81 _ -> return (Completions $ List [])

85 _ -> return (Completions $ List [])

82 _ -> return (Completions $ List [])

86 _ -> return (Completions $ List [])

83 _ -> return (Completions $ List [])

87 _ -> return (Completions $ List [])

src/Development/IDE/Plugin/Completions/Logic.hs+10−11

@@ -210,9 +210,10 @@ mkPragmaCompl label insertText =

210 Nothing Nothing Nothing Nothing Nothing (Just insertText) (Just Snippet)

211 Nothing Nothing Nothing Nothing Nothing

212

213−cacheDataProducer :: HscEnv -> DynFlags -> TypecheckedModule -> [ParsedModule] -> IO CachedCompletions

213+cacheDataProducer :: HscEnv -> TypecheckedModule -> [ParsedModule] -> IO CachedCompletions

214−cacheDataProducer packageState dflags tm deps = do

214+cacheDataProducer packageState tm deps = do

215 let parsedMod = tm_parsed_module tm

216+ dflags = hsc_dflags packageState

216 curMod = moduleName $ ms_mod $ pm_mod_summary parsedMod

217 curMod = moduleName $ ms_mod $ pm_mod_summary parsedMod

217 Just (_,limports,_,_) = tm_renamed_source tm

218 Just (_,limports,_,_) = tm_renamed_source tm

218

219

@@ -306,16 +307,13 @@ toggleSnippets ClientCapabilities { _textDocument } (WithSnippets with) x

306 where supported = Just True == (_textDocument >>= _completion >>= _completionItem >>= _snippetSupport)

307 where supported = Just True == (_textDocument >>= _completion >>= _completionItem >>= _snippetSupport)

307

308

308-- | Returns the cached completions for the given module and position.

309-- | Returns the cached completions for the given module and position.

309−getCompletions :: IdeOptions -> CachedCompletions -> TypecheckedModule -> VFS.PosPrefixInfo -> ClientCapabilities -> WithSnippets -> IO [CompletionItem]

310+getCompletions :: IdeOptions -> CachedCompletions -> ParsedModule -> VFS.PosPrefixInfo -> ClientCapabilities -> WithSnippets -> IO [CompletionItem]

310getCompletions ideOpts CC { allModNamesAsNS, unqualCompls, qualCompls, importableModules }

311getCompletions ideOpts CC { allModNamesAsNS, unqualCompls, qualCompls, importableModules }

311− tm prefixInfo caps withSnippets = do

312+ pm prefixInfo caps withSnippets = do

312 let VFS.PosPrefixInfo { VFS.fullLine, VFS.prefixModule, VFS.prefixText } = prefixInfo

313 let VFS.PosPrefixInfo { VFS.fullLine, VFS.prefixModule, VFS.prefixText } = prefixInfo

313 enteredQual = if T.null prefixModule then "" else prefixModule <> "."

314 enteredQual = if T.null prefixModule then "" else prefixModule <> "."

314 fullPrefix = enteredQual <> prefixText

315 fullPrefix = enteredQual <> prefixText

315

316

316− -- default to value context if no explicit context

317− context = fromMaybe ValueContext $ getCContext pos (tm_parsed_module tm)

318−

319 {- correct the position by moving 'foo :: Int -> String -> '

317 {- correct the position by moving 'foo :: Int -> String -> '

320 ^

318 ^

321 to 'foo :: Int -> String -> '

319 to 'foo :: Int -> String -> '

@@ -344,10 +342,11 @@ getCompletions ideOpts CC { allModNamesAsNS, unqualCompls, qualCompls, importabl

344 where

342 where

345 isTypeCompl = isTcOcc . occName . origName

343 isTypeCompl = isTcOcc . occName . origName

346 -- completions specific to the current context

344 -- completions specific to the current context

347− ctxCompls' = case context of

345+ ctxCompls' = case getCContext pos pm of

346+ Nothing -> compls

348− TypeContext -> filter isTypeCompl compls

347+ Just TypeContext -> filter isTypeCompl compls

349− ValueContext -> filter (not . isTypeCompl) compls

348+ Just ValueContext -> filter (not . isTypeCompl) compls

350− _ -> filter (not . isTypeCompl) compls

349+ Just _ -> filter (not . isTypeCompl) compls

351 -- Add whether the text to insert has backticks

350 -- Add whether the text to insert has backticks

352 ctxCompls = map (\comp -> comp { isInfix = infixCompls }) ctxCompls'

351 ctxCompls = map (\comp -> comp { isInfix = infixCompls }) ctxCompls'

353

352

test/exe/Main.hs+21

@@ -1630,6 +1630,27 @@ completionTests

1630 docId <- openDoc' "A.hs" "haskell" source

1631 compls <- getCompletions docId (Position 1 9)

1632 liftIO $ compls @?= [keywordItem "newtype"]

1633+ , testSessionWait "type context" $ do

1634+ let source = T.unlines

1635+ [ "{-# OPTIONS_GHC -Wunused-binds #-}"

1636+ , "module A () where"

1637+ , "f = f"

1638+ ]

1639+ docId <- openDoc' "A.hs" "haskell" source

1640+ expectDiagnostics [("A.hs", [(DsWarning, (2, 0), "not used")])]

1641+ changeDoc docId

1642+ [ TextDocumentContentChangeEvent Nothing Nothing $ T.unlines

1643+ [ "{-# OPTIONS_GHC -Wunused-binds #-}"

1644+ , "module A () where"

1645+ , "f = f"

1646+ , "g :: Intege"

1647+ ]

1648+ ]

1649+ -- At this point the module parses but does not typecheck.

1650+ -- This should be sufficient to detect that we are in a

1651+ -- type context and only show the completion to the type.

1652+ compls <- getCompletions docId (Position 3 11)

1653+ liftIO $ map dropDocs compls @?= [complItem "Integer"(Just CiStruct) (Just "*")]

1633 ]

1654 ]

1634 where

1655 where

1635 dropDocs :: CompletionItem -> CompletionItem

1656 dropDocs :: CompletionItem -> CompletionItem