wait notification for each with-document

introduce notification-channel for this case

misc:
- use rackunit in hover.rkt
- use rackunit

Author: dannypsnl

info.rkt

@@ -15,6 +15,6 @@
                "racket-index" ;; for cross references (setup/xref)
                "html-parsing" ;; for parsing documentation text
                ))
-(define build-deps '("chk-lib"))
+(define build-deps '("chk-lib" "rackunit-lib"))
 (define pkg-desc "Language Server Protocol implementation for Racket.")
 (define version "1.0")

tests/client.rkt

@@ -5,6 +5,7 @@
 (provide with-racket-lsp
          client-send
          client-wait-response
+         client-wait-notification
          make-request
          make-expected-response
          make-notification
@@ -14,10 +15,8 @@
          racket/async-channel
          racket/match
          json
-         data/queue
          "../server.rkt"
-         "../methods.rkt"
-         "../msg-io.rkt")
+         "../methods.rkt")
 
 (define id 0)
 (define (Lsp-genid lsp)
@@ -26,6 +25,7 @@
 
 (define server-output-ch (make-parameter #f))
 (define response-channel (make-parameter #f))
+(define notification-channel (make-parameter #f))
 
 (define/contract (process-message-from-server lsp msg)
   (-> any/c jsexpr? void?)
@@ -37,18 +37,21 @@
      (handle-server-request lsp msg)]
     ;; Server notification - queue diagnostic notifications, ignore others
     [(hash-table ['method (? string? method)])
-     (when (equal? method "textDocument/publishDiagnostics")
-       (async-channel-put (response-channel) msg))]
+     (match method
+       ["textDocument/publishDiagnostics"
+        (async-channel-put (notification-channel) msg)]
+       ; ignore unknown method
+       [_ (void)])]
     ;; Response - put it to another channel for client-wait-response
-    [else
-     (async-channel-put (response-channel) msg)]))
+    [msg (async-channel-put (response-channel) msg)]))
 
 (define/contract (with-racket-lsp proc)
   (-> (-> any/c any/c) void?)
   (define ch (make-async-channel))
 
   (parameterize ([server-output-ch ch]
-                 [response-channel (make-async-channel)])
+                 [response-channel (make-async-channel)]
+                 [notification-channel (make-async-channel)])
     (set-current-server! (new server% [output-channel ch]))
     (define lsp current-server)
 
@@ -92,6 +95,9 @@
   (define js (async-channel-get (response-channel)))
   (make-immutable-hasheq (hash->list js)))
 
+(define (client-wait-notification lsp)
+  (async-channel-get (notification-channel)))
+
 (define/contract (client-should-no-response lsp)
   (-> any/c eof-object?)
 

tests/sync/test.rkt

@@ -1,8 +1,7 @@
 #lang racket/base
 
 (require "../client.rkt"
-         "../../json-util.rkt"
-         chk)
+         "../../json-util.rkt")
 
 (module+ test
   (require rackunit
@@ -22,17 +21,16 @@
                                              'text "#lang racke"))))
         ;; should report "collection not found" diagnostic error
         (client-send lsp didopen-req)
-        (let ([resp (client-wait-response lsp)])
-          (chk*
-           (chk (jsexpr-has-key? resp '(params diagnostics)))
-           (define diagnostics-msg (jsexpr-ref resp '(params diagnostics)))
-           (check-false (null? diagnostics-msg))
-           (define dm (with-input-from-string
-                          (jsexpr->string (car diagnostics-msg))
-                        (lambda () (read-json))))
-           (define resp-no-message (hash-remove dm 'message))
-           (check-equal? (jsexpr->string resp-no-message)
-                         (jsexpr->string (read-json (open-input-file "diagnostics.json"))))))
+        (let ([resp (client-wait-notification lsp)])
+          (check-true (jsexpr-has-key? resp '(params diagnostics)))
+          (define diagnostics-msg (jsexpr-ref resp '(params diagnostics)))
+          (check-false (null? diagnostics-msg))
+          (define dm (with-input-from-string
+                         (jsexpr->string (car diagnostics-msg))
+                       (lambda () (read-json))))
+          (define resp-no-message (hash-remove dm 'message))
+          (check-equal? (jsexpr->string resp-no-message)
+                        (jsexpr->string (read-json (open-input-file "diagnostics.json")))))
 
 
         (define didchange-req
@@ -44,10 +42,9 @@
                                      (list (hasheq 'text "#lang racket")))))
         ;; should not report any error
         (client-send lsp didchange-req)
-        (let ([resp (client-wait-response lsp)])
-          (chk*
-           (chk (jsexpr-has-key? resp '(params diagnostics)))
-           (chk (null? (jsexpr-ref resp '(params diagnostics))))))
+        (let ([resp (client-wait-notification lsp)])
+          (check-true (jsexpr-has-key? resp '(params diagnostics)))
+          (check-true (null? (jsexpr-ref resp '(params diagnostics)))))
 
 
         ;; no response for didClose request

tests/textDocument/completion/completion.rkt

@@ -21,7 +21,7 @@ END
       ;; only move cursor to that position is not enough.
       (define didchange-req (read-json (open-input-file "change-req.json")))
       (client-send lsp didchange-req)
-      (client-wait-response lsp)
+      (client-wait-notification lsp)
 
       (define comp-req (read-json (open-input-file "comp-req.json")))
       (client-send lsp comp-req)

tests/textDocument/formatting.rkt

@@ -37,7 +37,7 @@ END
                                      'rangeLength 0
                                      'text "\n"))))])
         (client-send lsp notif)
-        (client-wait-response lsp))
+        (client-wait-notification lsp))
 
       ;; Format on type for pre-indented new line 3
       (let* ([req (make-request lsp

tests/textDocument/hover.rkt

@@ -1,8 +1,7 @@
 #lang racket
 
 (require "../../json-util.rkt"
-         "with-document.rkt"
-         chk)
+         "with-document.rkt")
 
 (define uri "file:///test.rkt")
 
@@ -30,13 +29,13 @@ END
       (client-send lsp hover-req)
 
       (let ([resp (client-wait-response lsp)])
-        (chk (jsexpr-has-key? resp '(result contents)))
-        (chk (not (string=? "" (jsexpr-ref resp '(result contents)))))
+        (check-true (jsexpr-has-key? resp '(result contents)))
+        (check-false (string=? "" (jsexpr-ref resp '(result contents))))
 
-        (chk (jsexpr-has-key? resp '(result range start line)))
-        (chk (jsexpr-has-key? resp '(result range start character)))
-        (chk (jsexpr-has-key? resp '(result range end line)))
-        (chk (jsexpr-has-key? resp '(result range end character)))
+        (check-true (jsexpr-has-key? resp '(result range start line)))
+        (check-true (jsexpr-has-key? resp '(result range start character)))
+        (check-true (jsexpr-has-key? resp '(result range end line)))
+        (check-true (jsexpr-has-key? resp '(result range end character)))
         (check-equal? (jsexpr-ref resp '(result range start line)) 2)
         (check-equal? (jsexpr-ref resp '(result range start character)) 1)
         (check-equal? (jsexpr-ref resp '(result range end line)) 2)

tests/textDocument/resyntax/resyntax.rkt

@@ -28,8 +28,8 @@ END
   (when has-resyntax?
     (with-document uri code
       (λ (lsp)
-        (define diag (client-wait-response lsp))
-        (chk #:= (jsexpr-ref diag '(method)) "textDocument/publishDiagnostics")
+        (define diag (client-wait-notification lsp))
+        (check-equal? (jsexpr-ref diag '(method)) "textDocument/publishDiagnostics")
         (let ([req (read-json (open-input-file "req.json"))]
               [resp (read-json (open-input-file "resp.json"))])
           (client-send lsp req)

tests/textDocument/with-document.rkt

@@ -3,6 +3,7 @@
 (provide with-document
          client-send
          client-wait-response
+         client-wait-notification
          make-request
          make-expected-response
          make-notification)
@@ -22,7 +23,7 @@
                                              'version 0
                                              'text text))))
         (client-send lsp didopen-req)
-        (client-wait-response lsp)
+        (client-wait-notification lsp)
 
         (proc lsp)