From bf6cc6ca169e8cf79ebc045f1b5c992fc560963f Mon Sep 17 00:00:00 2001
From: Kirill Kuvshinov <kkirka@gmail.com>
Date: Mon, 6 Jul 2020 00:10:25 +0300
Subject: [PATCH] [LIGO-18] Expose find ref and go to def via LSP

Problem: The current implementation of "Find references" and
"Go to definition" is not exposed via the LSP. We need to expose
them so that they are accessible from the client.

Solution: Add the necessary handlers, send response messages.
---
 tools/lsp/squirrel/app/Main.hs | 37 +++++++++++++++++++++++++---------
 1 file changed, 28 insertions(+), 9 deletions(-)

diff --git a/tools/lsp/squirrel/app/Main.hs b/tools/lsp/squirrel/app/Main.hs
index c673ba64d..81dd78c72 100644
--- a/tools/lsp/squirrel/app/Main.hs
+++ b/tools/lsp/squirrel/app/Main.hs
@@ -29,7 +29,6 @@ import           Product
 import           AST hiding (def)
 import qualified AST.Find as Find
 import           Error
-import           Tree
 
 main :: IO ()
 main = do
@@ -77,8 +76,8 @@ lspOptions = def
 lspHandlers :: TChan FromClientMessage -> Core.Handlers
 lspHandlers rin = def
   { Core.initializedHandler                       = Just $ passHandler rin NotInitialized
-  , Core.renameHandler                            = Just $ passHandler rin ReqRename
-  , Core.hoverHandler                             = Just $ passHandler rin ReqHover
+  , Core.definitionHandler                        = Just $ passHandler rin ReqDefinition
+  , Core.referencesHandler                        = Just $ passHandler rin ReqFindReferences
   , Core.didOpenTextDocumentNotificationHandler   = Just $ passHandler rin NotDidOpenTextDocument
   , Core.didSaveTextDocumentNotificationHandler   = Just $ passHandler rin NotDidSaveTextDocument
   , Core.didChangeTextDocumentNotificationHandler = Just $ passHandler rin NotDidChangeTextDocument
@@ -162,18 +161,38 @@ eventLoop funs chan = do
         tree <- loadByURI uri
         case Find.definitionOf pos tree of
           Just defPos -> do
-            error "do later"
+            respondWith req RspDefinition $ J.MultiLoc [J.Location uri $ rangeToLoc defPos]
+          Nothing -> do
+            respondWith req RspDefinition $ J.MultiLoc []
+
+      ReqFindReferences req -> do
+        let uri = req^.J.params.J.textDocument.J.uri
+        let pos = posToRange $ req^.J.params.J.position
+        tree <- loadByURI uri
+        case Find.referencesOf pos tree of
+          Just refs -> do
+            let locations = J.Location uri . rangeToLoc <$> refs
+            respondWith req RspFindReferences $ J.List locations
+          Nothing -> do
+            respondWith req RspFindReferences $ J.List []
 
       _ -> U.logs "unknown msg"
+  where
+    respondWith
+      :: J.RequestMessage J.ClientMethod req rsp
+      -> (J.ResponseMessage rsp -> FromServerMessage)
+      -> rsp
+      -> IO ()
+    respondWith req wrap rsp = Core.sendFunc funs $ wrap $ Core.makeResponseMessage req rsp
 
 posToRange :: J.Position -> Range
-posToRange (J.Position l c) = Range (l, c, 0) (l, c, 0) ""
-
-rangeToJRange :: Range -> J.Range
-rangeToJRange (Range (a, b, _) (c, d, _) _) = J.Range (J.Position a b) (J.Position c d)
+posToRange (J.Position l c) = Range (l + 1, c + 1, 0) (l + 1, c + 1, 0) ""
 
 rangeToLoc :: Range -> J.Range
-rangeToLoc (Range (a, b, _) (c, d, _) _) = J.Range (J.Position a b) (J.Position c d)
+rangeToLoc (Range (a, b, _) (c, d, _) _) =
+  J.Range
+    (J.Position (a - 1) (b - 1))
+    (J.Position (c - 1) (d - 1))
 
 loadByURI :: J.Uri -> IO (Pascal (Product [[ScopedDecl], Range, [Text]]))
 loadByURI uri = do