From 1828fd6d4666cabfd3a3f252964550e5cebbc446 Mon Sep 17 00:00:00 2001
From: Anton Myasnikov <awkure@protonmail.ch>
Date: Thu, 20 Aug 2020 15:22:48 +0300
Subject: [PATCH] [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.
---
 tools/lsp/squirrel/app/Main.hs           | 18 ++++++++++++++++
 tools/lsp/squirrel/package.yaml          |  3 +++
 tools/lsp/squirrel/src/AST/Completion.hs | 26 ++++++++++++++++++++++++
 3 files changed, 47 insertions(+)

diff --git a/tools/lsp/squirrel/app/Main.hs b/tools/lsp/squirrel/app/Main.hs
index 5ed8320d2..8745cc148 100644
--- a/tools/lsp/squirrel/app/Main.hs
+++ b/tools/lsp/squirrel/app/Main.hs
@@ -33,6 +33,7 @@ import           Range
 import           Product
 import           AST                                           hiding (def)
 import qualified AST.Find                              as Find
+import Data.Maybe (fromMaybe)
 -- import           Error
 
 main :: IO ()
@@ -92,6 +93,8 @@ lspHandlers rin = def
   , Core.responseHandler                          = Just $ responseHandlerCb rin
   , Core.codeActionHandler                        = Just $ passHandler rin ReqCodeAction
   , 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
@@ -184,6 +187,21 @@ eventLoop funs chan = do
             Nothing -> do
               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"
 
 respondWith
diff --git a/tools/lsp/squirrel/package.yaml b/tools/lsp/squirrel/package.yaml
index 757094453..c6d3dd66c 100644
--- a/tools/lsp/squirrel/package.yaml
+++ b/tools/lsp/squirrel/package.yaml
@@ -65,6 +65,9 @@ library:
     - vendor/reasonligo/parser.c
     - vendor/camligo/parser.c
 
+  dependencies:
+    - haskell-lsp-types
+
 executables:
   squirrel:
     dependencies:
diff --git a/tools/lsp/squirrel/src/AST/Completion.hs b/tools/lsp/squirrel/src/AST/Completion.hs
index efcdcf12c..1a64915f9 100644
--- a/tools/lsp/squirrel/src/AST/Completion.hs
+++ b/tools/lsp/squirrel/src/AST/Completion.hs
@@ -1,6 +1,9 @@
+{-# LANGUAGE RecordWildCards #-}
 
 module AST.Completion where
 
+import Language.Haskell.LSP.Types (CompletionDoc (..), CompletionItem (..), CompletionItemKind (..))
+
 import Data.Function (on)
 import Data.List (isSubsequenceOf, nubBy)
 import Data.Maybe (listToMaybe)
@@ -45,6 +48,29 @@ complete r tree = do
     $ filter (fits nameCat . catFromType)
     $ 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 sd = Completion
   { cName = ppToText (_sdName sd)