[LIGO-29] Integrate existing completion framework with haskell-lsp

Problem: Currently we have not integrated our completions with
haskell-lsp server so that we could use this completion from text
editor itself.

Solution: Add the corresponding requests for handling code completion.
This commit is contained in:
Anton Myasnikov 2020-08-20 15:22:48 +03:00
parent 1c684a791c
commit 1828fd6d46
No known key found for this signature in database
GPG Key ID: FEB685E6DAA0A95F
3 changed files with 47 additions and 0 deletions

View File

@ -33,6 +33,7 @@ import Range
import Product import Product
import AST hiding (def) import AST hiding (def)
import qualified AST.Find as Find import qualified AST.Find as Find
import Data.Maybe (fromMaybe)
-- import Error -- import Error
main :: IO () main :: IO ()
@ -92,6 +93,8 @@ lspHandlers rin = def
, Core.responseHandler = Just $ responseHandlerCb rin , Core.responseHandler = Just $ responseHandlerCb rin
, Core.codeActionHandler = Just $ passHandler rin ReqCodeAction , Core.codeActionHandler = Just $ passHandler rin ReqCodeAction
, Core.executeCommandHandler = Just $ passHandler rin ReqExecuteCommand , Core.executeCommandHandler = Just $ passHandler rin ReqExecuteCommand
, Core.completionHandler = Just $ passHandler rin ReqCompletion
, Core.completionResolveHandler = Just $ passHandler rin ReqCompletionItemResolve
} }
passHandler :: TChan FromClientMessage -> (a -> FromClientMessage) -> Core.Handler a passHandler :: TChan FromClientMessage -> (a -> FromClientMessage) -> Core.Handler a
@ -184,6 +187,21 @@ eventLoop funs chan = do
Nothing -> do Nothing -> do
respondWith funs req RspFindReferences $ J.List [] respondWith funs req RspFindReferences $ J.List []
ReqCompletion req -> do
stopDyingAlready funs req $ do
U.logs $ "got completion request: " <> show req
let uri = req ^. J.params . J.textDocument . J.uri
let pos = posToRange $ req ^. J.params . J.position
tree <- loadFromVFS funs uri
let completions = fmap toCompletionItem . fromMaybe [] $ complete pos tree
respondWith funs req RspCompletion . J.Completions . J.List $ completions
-- Additional callback executed after completion was made, currently no-op
ReqCompletionItemResolve req -> do
stopDyingAlready funs req $ do
U.logs $ "got completion resolve request: " <> show req
respondWith funs req RspCompletionItemResolve (req ^. J.params)
_ -> U.logs "unknown msg" _ -> U.logs "unknown msg"
respondWith respondWith

View File

@ -65,6 +65,9 @@ library:
- vendor/reasonligo/parser.c - vendor/reasonligo/parser.c
- vendor/camligo/parser.c - vendor/camligo/parser.c
dependencies:
- haskell-lsp-types
executables: executables:
squirrel: squirrel:
dependencies: dependencies:

View File

@ -1,6 +1,9 @@
{-# LANGUAGE RecordWildCards #-}
module AST.Completion where module AST.Completion where
import Language.Haskell.LSP.Types (CompletionDoc (..), CompletionItem (..), CompletionItemKind (..))
import Data.Function (on) import Data.Function (on)
import Data.List (isSubsequenceOf, nubBy) import Data.List (isSubsequenceOf, nubBy)
import Data.Maybe (listToMaybe) import Data.Maybe (listToMaybe)
@ -45,6 +48,29 @@ complete r tree = do
$ filter (fits nameCat . catFromType) $ filter (fits nameCat . catFromType)
$ scope $ scope
toCompletionItem :: Completion -> CompletionItem
toCompletionItem c@Completion{..} = CompletionItem
{ _label = cName
, _kind = Just $ CiFunction -- TODO
, _detail = Just $ ":: " <> cType -- TODO: more elaborate info
, _documentation = Just $ mkDoc c
, _deprecated = Nothing
, _preselect = Nothing
, _sortText = Nothing
, _filterText = Nothing
, _insertTextFormat = Nothing
, _textEdit = Nothing
, _insertText = Nothing
, _additionalTextEdits = Nothing
, _commitCharacters = Nothing
, _command = Nothing
, _xdata = Nothing
}
mkDoc :: Completion -> CompletionDoc
mkDoc Completion {..} = CompletionDocString $
cName <> " is of type " <> cType <> ". " <> cDoc
asCompletion :: ScopedDecl -> Completion asCompletion :: ScopedDecl -> Completion
asCompletion sd = Completion asCompletion sd = Completion
{ cName = ppToText (_sdName sd) { cName = ppToText (_sdName sd)