From 9856476ebf9af950f39244bcc24787b4f2c48ebd Mon Sep 17 00:00:00 2001
From: Kirill Kuvshinov <kkirka@gmail.com>
Date: Tue, 2 Jun 2020 14:47:56 +0300
Subject: [PATCH] WIP: Add CTRL.run

---
 tools/lsp/squirrel/app/Main.hs | 43 +++++++++++++++++++++++++++++++++-
 1 file changed, 42 insertions(+), 1 deletion(-)

diff --git a/tools/lsp/squirrel/app/Main.hs b/tools/lsp/squirrel/app/Main.hs
index 4c9ee24b8..aa18cde9a 100644
--- a/tools/lsp/squirrel/app/Main.hs
+++ b/tools/lsp/squirrel/app/Main.hs
@@ -7,6 +7,7 @@ import           Control.Exception as E
 import           Control.Lens
 import           Control.Monad
 
+import           Data.Default
 import qualified Data.Text                             as Text
 import           Data.String.Interpolate (i)
 
@@ -26,7 +27,7 @@ import qualified System.Log                            as L
 import           ParseTree
 import           Parser
 import           Range
-import           AST
+import           AST hiding (def)
 import           HasErrors
 import           Pretty
 
@@ -49,6 +50,7 @@ mainLoop = do
         }
 
     Core.setupLogger (Just "log.txt") [] L.INFO
+    CTRL.run callbacks (lspHandlers chan) lspOptions (Just "log.txt")
     return 0
   `catches`
     [ Handler \(e :: SomeException) -> do
@@ -56,6 +58,43 @@ mainLoop = do
         return 1
     ]
 
+syncOptions :: J.TextDocumentSyncOptions
+syncOptions = J.TextDocumentSyncOptions
+  { J._openClose         = Just True
+  , J._change            = Just J.TdSyncIncremental
+  , J._willSave          = Just False
+  , J._willSaveWaitUntil = Just False
+  , J._save              = Just $ J.SaveOptions $ Just False
+  }
+
+lspOptions :: Core.Options
+lspOptions = def { Core.textDocumentSync = Just syncOptions
+                 , Core.executeCommandCommands = Just ["lsp-hello-command"]
+                 }
+
+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.didOpenTextDocumentNotificationHandler   = Just $ passHandler rin NotDidOpenTextDocument
+        , Core.didSaveTextDocumentNotificationHandler   = Just $ passHandler rin NotDidSaveTextDocument
+        , Core.didChangeTextDocumentNotificationHandler = Just $ passHandler rin NotDidChangeTextDocument
+        , Core.didCloseTextDocumentNotificationHandler  = Just $ passHandler rin NotDidCloseTextDocument
+        , Core.cancelNotificationHandler                = Just $ passHandler rin NotCancelRequestFromClient
+        , Core.responseHandler                          = Just $ responseHandlerCb rin
+        , Core.codeActionHandler                        = Just $ passHandler rin ReqCodeAction
+        , Core.executeCommandHandler                    = Just $ passHandler rin ReqExecuteCommand
+        }
+
+passHandler :: TChan FromClientMessage -> (a -> FromClientMessage) -> Core.Handler a
+passHandler rin c notification = do
+  atomically $ writeTChan rin (c notification)
+
+responseHandlerCb :: TChan FromClientMessage -> Core.Handler J.BareResponseMessage
+responseHandlerCb _rin resp = do
+  U.logs $ "******** got ResponseMessage, ignoring:" ++ show resp
+
 send :: Core.LspFuncs () -> FromServerMessage -> IO ()
 send = Core.sendFunc
 
@@ -115,6 +154,8 @@ eventLoop funs chan = do
           (J.uriToFilePath doc)
           (Just 0)
 
+      _ -> putStrLn "unknown msg"
+
 
 collectErrors
   :: Core.LspFuncs ()