X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=test%2Fdummy-server%2FMain.hs;h=ab917e8fa50ff825b35b996f78fd94fb80ad96b6;hb=72257c6a7b5461c529c415b93e1c3507e1c843a7;hp=a7e6439078ead5af4db0275c3863bc610294d5e1;hpb=ea87bf94ca92b6de74505ba8df208ad3e2110de5;p=lsp-test.git

diff --git a/test/dummy-server/Main.hs b/test/dummy-server/Main.hs
index a7e6439..ab917e8 100644
--- 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
@@ -39,11 +42,10 @@ handlers lfvar = def
                               (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
+          Just fp = uriToFilePath uri
           diag = Diagnostic (mkRange 0 0 0 1)
                             (Just DsWarning)
                             (Just (NumberValue 42))
@@ -51,8 +53,39 @@ handlers lfvar = def
                             "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
@@ -74,6 +107,15 @@ 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