Fix getTypeDefinitions

[lsp-test.git] / test / dummy-server / Main.hs

diff --git a/test/dummy-server/Main.hs b/test/dummy-server/Main.hs
index f67b043a2f213fb873650b0d2e814e614c82d818..ab917e8fa50ff825b35b996f78fd94fb80ad96b6 100644 (file)
--- a/test/dummy-server/Main.hs
+++ b/test/dummy-server/Main.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 import Data.Aeson
 import Data.Default
+import Data.List (isSuffixOf)
 import qualified Data.HashMap.Strict as HM
 import Language.Haskell.LSP.Core
 import Language.Haskell.LSP.Control
@@ -8,6 +9,8 @@ import Language.Haskell.LSP.Messages
 import Language.Haskell.LSP.Types
 import Control.Concurrent
 import Control.Monad
+import System.Directory
+import System.FilePath
 
 main = do
   lfvar <- newEmptyMVar
@@ -35,30 +38,60 @@ handlers lfvar = def
                               Nothing
                               SkObject
                               Nothing
-                              (Range (Position 0 0) (Position 0 1))
-                              (Range (Position 0 0) (Position 0 1))
+                              (mkRange 0 0 3 6)
+                              (mkRange 0 0 3 6)
                               Nothing
              ]
-  , didOpenTextDocumentNotificationHandler = pure $ \noti ->
-      void $ forkIO $ do
-        threadDelay (2 * 10^6)
+  , didOpenTextDocumentNotificationHandler = pure $ \noti -> do
       let NotificationMessage _ _ (DidOpenTextDocumentParams doc) = noti
           TextDocumentItem uri _ _ _ = doc
-            diag = Diagnostic (Range (Position 0 0) (Position 0 1))
+          Just fp = uriToFilePath uri
+          diag = Diagnostic (mkRange 0 0 0 1)
                             (Just DsWarning)
                             (Just (NumberValue 42))
                             (Just "dummy-server")
                             "Here's a warning"
                             Nothing
                             Nothing
+      when (".hs" `isSuffixOf` fp) $ void $ forkIO $ do
+        threadDelay (2 * 10^6)
         send $ NotPublishDiagnostics $
           fmServerPublishDiagnosticsNotification $ PublishDiagnosticsParams uri $ List [diag]
+
+      -- also act as a registerer for workspace/didChangeWatchedFiles
+      when (".register" `isSuffixOf` fp) $ do
+        reqId <- readMVar lfvar >>= getNextReqId
+        send $ ReqRegisterCapability $ fmServerRegisterCapabilityRequest reqId $
+          RegistrationParams $ List $
+            [ Registration "0" WorkspaceDidChangeWatchedFiles $ Just $ toJSON $
+                DidChangeWatchedFilesRegistrationOptions $ List
+                [ FileSystemWatcher "*.watch" (Just (WatchKind True True True)) ]
+            ]
+      when (".register.abs" `isSuffixOf` fp) $ do
+        curDir <- getCurrentDirectory
+        reqId <- readMVar lfvar >>= getNextReqId
+        send $ ReqRegisterCapability $ fmServerRegisterCapabilityRequest reqId $
+          RegistrationParams $ List $
+            [ Registration "1" WorkspaceDidChangeWatchedFiles $ Just $ toJSON $
+                DidChangeWatchedFilesRegistrationOptions $ List
+                [ FileSystemWatcher (curDir </> "*.watch") (Just (WatchKind True True True)) ]
+            ]
+
+      -- also act as an unregisterer for workspace/didChangeWatchedFiles
+      when (".unregister" `isSuffixOf` fp) $ do
+        reqId <- readMVar lfvar >>= getNextReqId
+        send $ ReqUnregisterCapability $ fmServerUnregisterCapabilityRequest reqId $
+          UnregistrationParams $ List [ Unregistration "0" "workspace/didChangeWatchedFiles" ]
+      when (".unregister.abs" `isSuffixOf` fp) $ do
+        reqId <- readMVar lfvar >>= getNextReqId
+        send $ ReqUnregisterCapability $ fmServerUnregisterCapabilityRequest reqId $
+          UnregistrationParams $ List [ Unregistration "1" "workspace/didChangeWatchedFiles" ]
   , executeCommandHandler = pure $ \req -> do
       send $ RspExecuteCommand $ makeResponseMessage req Null
       reqId <- readMVar lfvar >>= getNextReqId
       let RequestMessage _ _ _ (ExecuteCommandParams "doAnEdit" (Just (List [val])) _) = req
           Success docUri = fromJSON val
-          edit = List [TextEdit (Range (Position 0 0) (Position 0 5)) "howdy"]
+          edit = List [TextEdit (mkRange 0 0 0 5) "howdy"]
       send $ ReqApplyWorkspaceEdit $ fmServerApplyWorkspaceEditRequest reqId $
         ApplyWorkspaceEditParams $ WorkspaceEdit (Just (HM.singleton docUri edit))
                                                  Nothing
@@ -74,5 +107,16 @@ handlers lfvar = def
                        Nothing
                       (Just (Command "" "deleteThis" Nothing))
       send $ RspCodeAction $ makeResponseMessage req caresults
+  , didChangeWatchedFilesNotificationHandler = pure $ \_ ->
+      send $ NotLogMessage $ fmServerLogMessageNotification MtLog "got workspace/didChangeWatchedFiles"
+  , completionHandler = pure $ \req -> do
+      let res = CompletionList (CompletionListType False (List [item]))
+          item =
+            CompletionItem "foo" (Just CiConstant) (List []) Nothing
+            Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+            Nothing Nothing Nothing Nothing Nothing
+      send $ RspCompletion $ makeResponseMessage req res
   }
   where send msg = readMVar lfvar >>= \lf -> (sendFunc lf) msg
+
+mkRange sl sc el ec = Range (Position sl sc) (Position el ec)