Skip to content

Commit a108641

Browse files
alanzalanz
committed
Add initial support for completion plugins
The CompletionProvider handler type should probably be extended to include a WithSnippets parameter, and the prefix.
1 parent 25aa3db commit a108641

File tree

4 files changed

+146
-8
lines changed

4 files changed

+146
-8
lines changed

‎src/Ide/Plugin.hs

Lines changed: 89 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,7 @@ module Ide.Plugin
2121
import Control.Lens ( (^.) )
2222
import Control.Monad
2323
import qualified Data.Aeson as J
24+
import qualified Data.Default
2425
import Data.Either
2526
import qualified Data.List as List
2627
import qualified Data.Map as Map
@@ -44,6 +45,7 @@ import Language.Haskell.LSP.Types
4445
import qualified Language.Haskell.LSP.Types as J
4546
import qualified Language.Haskell.LSP.Types.Capabilities as C
4647
import Language.Haskell.LSP.Types.Lens as L hiding (formatting, rangeFormatting)
48+
import qualified Language.Haskell.LSP.VFS as VFS
4749
import Text.Regex.TDFA.Text()
4850

4951
-- ---------------------------------------------------------------------
@@ -59,10 +61,9 @@ asGhcIdePlugin mp =
5961
mkPlugin codeLensPlugins pluginCodeLensProvider <>
6062
-- Note: diagnostics are provided via Rules from pluginDiagnosticProvider
6163
mkPlugin hoverPlugins pluginHoverProvider <>
62-
-- TODO: symbols via pluginSymbolProvider
63-
mkPlugin symbolsPlugin pluginSymbolsProvider <>
64-
mkPlugin formatterPlugins pluginFormattingProvider
65-
-- TODO: completions
64+
mkPlugin symbolsPlugins pluginSymbolsProvider <>
65+
mkPlugin formatterPlugins pluginFormattingProvider <>
66+
mkPlugin completionsPlugins pluginCompletionProvider
6667
where
6768
justs (p, Just x) = [(p, x)]
6869
justs (_, Nothing) = []
@@ -403,8 +404,8 @@ makeHover hps _lf ideState params
403404
-- ---------------------------------------------------------------------
404405
-- ---------------------------------------------------------------------
405406

406-
symbolsPlugin :: [(PluginId, SymbolsProvider)] -> Plugin Config
407-
symbolsPlugin hs = Plugin symbolsRules (symbolsHandlers hs)
407+
symbolsPlugins :: [(PluginId, SymbolsProvider)] -> Plugin Config
408+
symbolsPlugins hs = Plugin symbolsRules (symbolsHandlers hs)
408409

409410
symbolsRules :: Rules ()
410411
symbolsRules = mempty
@@ -463,3 +464,85 @@ formatterHandlers providers = PartialHandlers $ \WithMessage{..} x -> return x
463464
}
464465

465466
-- ---------------------------------------------------------------------
467+
-- ---------------------------------------------------------------------
468+
469+
completionsPlugins :: [(PluginId, CompletionProvider)] -> Plugin Config
470+
completionsPlugins cs = Plugin completionsRules (completionsHandlers cs)
471+
472+
completionsRules :: Rules ()
473+
completionsRules = mempty
474+
475+
completionsHandlers :: [(PluginId, CompletionProvider)] -> PartialHandlers Config
476+
completionsHandlers cps = PartialHandlers $ \WithMessage{..} x ->
477+
return x {LSP.completionHandler = withResponse RspCompletion (makeCompletions cps)}
478+
479+
makeCompletions :: [(PluginId, CompletionProvider)]
480+
-> LSP.LspFuncs Config
481+
-> IdeState
482+
-> CompletionParams
483+
-> IO (Either ResponseError CompletionResponseResult)
484+
makeCompletions sps lf ideState params@(CompletionParams (TextDocumentIdentifier doc) pos _context _mt)
485+
= do
486+
mprefix <- getPrefixAtPos lf doc pos
487+
_snippets <- WithSnippets <$> completionSnippetsOn <$> (getClientConfig lf)
488+
489+
let
490+
combine :: [CompletionResponseResult] -> CompletionResponseResult
491+
combine cs = go (Completions $ List []) cs
492+
where
493+
go acc [] = acc
494+
go (Completions (List ls)) (Completions (List ls2):rest)
495+
= go (Completions (List (ls <> ls2))) rest
496+
go (Completions (List ls)) (CompletionList (CompletionListType complete (List ls2)):rest)
497+
= go (CompletionList $ CompletionListType complete (List (ls <> ls2))) rest
498+
go (CompletionList (CompletionListType complete (List ls))) (CompletionList (CompletionListType complete2 (List ls2)):rest)
499+
= go (CompletionList $ CompletionListType (complete || complete2) (List (ls <> ls2))) rest
500+
go (CompletionList (CompletionListType complete (List ls))) (Completions (List ls2):rest)
501+
= go (CompletionList $ CompletionListType complete (List (ls <> ls2))) rest
502+
503+
case mprefix of
504+
Nothing -> return $ Right $ Completions $ List []
505+
Just _prefix -> do
506+
mhs <- mapM (\(_,p) -> p ideState params) sps
507+
case rights mhs of
508+
[] -> return $ Left $ responseError $ T.pack $ show $ lefts mhs
509+
hs -> return $ Right $ combine hs
510+
511+
{-
512+
ReqCompletion req -> do
513+
liftIO $ U.logs $ "reactor:got CompletionRequest:" ++ show req
514+
let (_, doc, pos) = reqParams req
515+
516+
mprefix <- getPrefixAtPos doc pos
517+
518+
let callback compls = do
519+
let rspMsg = Core.makeResponseMessage req
520+
$ J.Completions $ J.List compls
521+
reactorSend $ RspCompletion rspMsg
522+
case mprefix of
523+
Nothing -> callback []
524+
Just prefix -> do
525+
snippets <- Completions.WithSnippets <$> configVal completionSnippetsOn
526+
let hreq = IReq tn "completion" (req ^. J.id) callback
527+
$ lift $ Completions.getCompletions doc prefix snippets
528+
makeRequest hreq
529+
-}
530+
531+
getPrefixAtPos :: LSP.LspFuncs Config -> Uri -> Position -> IO (Maybe VFS.PosPrefixInfo)
532+
getPrefixAtPos lf uri pos = do
533+
mvf <- (LSP.getVirtualFileFunc lf) (J.toNormalizedUri uri)
534+
case mvf of
535+
Just vf -> VFS.getCompletionPrefix pos vf
536+
Nothing -> return Nothing
537+
538+
-- ---------------------------------------------------------------------
539+
-- | Returns the current client configuration. It is not wise to permanently
540+
-- cache the returned value of this function, as clients can at runitime change
541+
-- their configuration.
542+
--
543+
-- If no custom configuration has been set by the client, this function returns
544+
-- our own defaults.
545+
getClientConfig :: LSP.LspFuncs Config -> IO Config
546+
getClientConfig lf = fromMaybe Data.Default.def <$> LSP.config lf
547+
548+
-- ---------------------------------------------------------------------

‎src/Ide/Plugin/Example.hs

Lines changed: 27 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -51,7 +51,7 @@ descriptor plId = PluginDescriptor
5151
, pluginHoverProvider = Just hover
5252
, pluginSymbolsProvider = Just symbols
5353
, pluginFormattingProvider = Nothing
54-
, pluginCompletionProvider = Nothing
54+
, pluginCompletionProvider = Just completion
5555
}
5656

5757
-- ---------------------------------------------------------------------
@@ -218,3 +218,29 @@ symbols _ide (DocumentSymbolParams _doc _mt)
218218
chList = Nothing
219219

220220
-- ---------------------------------------------------------------------
221+
222+
completion :: CompletionProvider
223+
completion _ide (CompletionParams _doc _pos _mctxt _mt)
224+
= pure $ Right $ Completions $ List [r]
225+
where
226+
r = CompletionItem label kind detail documentation deprecated preselect
227+
sortText filterText insertText insertTextFormat
228+
textEdit additionalTextEdits commitCharacters
229+
command xd
230+
label = "Example completion"
231+
kind = Nothing
232+
detail = Nothing
233+
documentation = Nothing
234+
deprecated = Nothing
235+
preselect = Nothing
236+
sortText = Nothing
237+
filterText = Nothing
238+
insertText = Nothing
239+
insertTextFormat = Nothing
240+
textEdit = Nothing
241+
additionalTextEdits = Nothing
242+
commitCharacters = Nothing
243+
command = Nothing
244+
xd = Nothing
245+
246+
-- ---------------------------------------------------------------------

‎src/Ide/Plugin/Example2.hs

Lines changed: 27 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -51,7 +51,7 @@ descriptor plId = PluginDescriptor
5151
, pluginHoverProvider = Just hover
5252
, pluginSymbolsProvider = Just symbols
5353
, pluginFormattingProvider = Nothing
54-
, pluginCompletionProvider = Nothing
54+
, pluginCompletionProvider = Just completion
5555
}
5656

5757
-- ---------------------------------------------------------------------
@@ -215,3 +215,29 @@ symbols _ide (DocumentSymbolParams _doc _mt)
215215
chList = Nothing
216216

217217
-- ---------------------------------------------------------------------
218+
219+
completion :: CompletionProvider
220+
completion _ide (CompletionParams _doc _pos _mctxt _mt)
221+
= pure $ Right $ Completions $ List [r]
222+
where
223+
r = CompletionItem label kind detail documentation deprecated preselect
224+
sortText filterText insertText insertTextFormat
225+
textEdit additionalTextEdits commitCharacters
226+
command xd
227+
label = "Example2 completion"
228+
kind = Nothing
229+
detail = Nothing
230+
documentation = Nothing
231+
deprecated = Nothing
232+
preselect = Nothing
233+
sortText = Nothing
234+
filterText = Nothing
235+
insertText = Nothing
236+
insertTextFormat = Nothing
237+
textEdit = Nothing
238+
additionalTextEdits = Nothing
239+
commitCharacters = Nothing
240+
command = Nothing
241+
xd = Nothing
242+
243+
-- ---------------------------------------------------------------------

‎src/Ide/Types.hs

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,7 @@ module Ide.Types
1818
, CodeLensProvider
1919
, ExecuteCommandProvider
2020
, CompletionProvider
21+
, WithSnippets(..)
2122
) where
2223

2324
import Data.Aeson hiding (defaultOptions)
@@ -131,6 +132,8 @@ type ExecuteCommandProvider = IdeState
131132
-> ExecuteCommandParams
132133
-> IO (Either ResponseError Value, Maybe (ServerMethod, ApplyWorkspaceEditParams))
133134

135+
newtype WithSnippets = WithSnippets Bool
136+
134137
type CompletionProvider = IdeState
135138
-> CompletionParams
136139
-> IO (Either ResponseError CompletionResponseResult)

0 commit comments

Comments
 (0)