[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:
parent
1c684a791c
commit
1828fd6d46
@ -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
|
||||||
|
@ -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:
|
||||||
|
@ -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)
|
||||||
|
Loading…
Reference in New Issue
Block a user