Send traces to channel

Author: mainej

.dir-locals.el

@@ -0,0 +1,2 @@
+((clojure-mode
+  (cider-clojure-cli-aliases . "test")))

server/src/lsp4clj/server.clj

@@ -128,7 +128,7 @@
   (logger/debug "received unexpected notification" method))
 
 (defrecord ChanServer [parallelism
-                       trace?
+                       trace-ch
                        input
                        output
                        ^java.time.Clock clock
@@ -162,7 +162,7 @@
           now (.instant clock)
           req (json-rpc.messages/request id method body)
           pending-request (pending-request id method now this)]
-      (when trace? (logger/debug (trace/sending-request id method body now)))
+      (some-> trace-ch (async/put! (trace/sending-request id method body now)))
       ;; Important: record request before sending it, so it is sure to be
       ;; available during receive-response.
       (swap! pending-requests* assoc id pending-request)
@@ -172,37 +172,37 @@
   (send-notification [_this method body]
     (let [now (.instant clock)
           notif (json-rpc.messages/request method body)]
-      (when trace? (logger/debug (trace/sending-notification method body now)))
+      (some-> trace-ch (async/put! (trace/sending-notification method body now)))
       ;; respect back pressure from clients that are slow to read; (go (>!)) will not suffice
       (async/>!! output notif)))
   (receive-response [_this {:keys [id] :as resp}]
-    (if-let [{:keys [id method p started]} (get @pending-requests* id)]
-      (let [now (.instant clock)
-            error (:error resp)
-            result (:result resp)]
-        (when trace? (logger/debug (trace/received-response id method result error started now)))
-        (swap! pending-requests* dissoc id)
-        (deliver p (if error resp result)))
-      (logger/debug "received response for unmatched request:" resp)))
+    (let [now (.instant clock)]
+      (if-let [{:keys [id method p started]} (get @pending-requests* id)]
+        (let [error (:error resp)
+              result (:result resp)]
+          (some-> trace-ch (async/put! (trace/received-response id method result error started now)))
+          (swap! pending-requests* dissoc id)
+          (deliver p (if error resp result)))
+        (some-> trace-ch (async/put! (trace/received-unmatched-response now resp))))))
   (receive-request [_this context {:keys [id method params]}]
     (let [started (.instant clock)]
-      (when trace? (logger/debug (trace/received-request id method params started)))
+      (some-> trace-ch (async/put! (trace/received-request id method params started)))
       (let [result (receive-request method context params)
             resp (json-rpc.messages/response id result)
             finished (.instant clock)]
-        (when trace? (logger/debug (trace/sending-response id method result started finished)))
+        (some-> trace-ch (async/put! (trace/sending-response id method result started finished)))
         resp)))
   (receive-notification [_this context {:keys [method params]}]
-    (when trace? (logger/debug (trace/received-notification method params (.instant clock))))
+    (some-> trace-ch (async/put! (trace/received-notification method params (.instant clock))))
     (receive-notification method context params)))
 
 (defn chan-server [{:keys [output input parallelism trace? clock]
                     :or {parallelism 4, trace? false, clock (java.time.Clock/systemDefaultZone)}}]
   (map->ChanServer
     {:parallelism parallelism
-     :trace? trace?
      :output output
      :input input
+     :trace-ch (when trace? (async/chan (async/sliding-buffer 20)))
      :clock clock
      :request-id* (atom 0)
      :pending-requests* (atom {})

server/src/lsp4clj/trace.clj

@@ -2,56 +2,64 @@
   (:require
    [cheshire.core :as json]))
 
+(defn ^:private trace-tag [at]
+  (format "[Trace - %s]"
+          (str (.truncatedTo at java.time.temporal.ChronoUnit/MILLIS))))
+
 (defn ^:private trace-header
-  ([at description method]
-   (format "[Trace - %s] %s '%s'"
-           (str (.truncatedTo at java.time.temporal.ChronoUnit/MILLIS))
-           description
-           method))
-  ([at description method id]
-   (format "[Trace - %s] %s '%s - (%s)'"
-           (str (.truncatedTo at java.time.temporal.ChronoUnit/MILLIS))
-           description
-           method
-           id)))
+  ([description method]
+   (format "%s '%s'" description method))
+  ([description method id]
+   (format "%s '%s - (%s)'" description method id)))
 
 (defn ^:private trace-body
   ([params] (trace-body "Params" params))
   ([label params] (str label ": " (json/generate-string params {:pretty true}))))
 
 (defn ^:private trace-str
-  ([header latency body]
-   (trace-str (str header latency) body))
-  ([header body]
-   (str header "\n"
+  ([tag header latency body]
+   (trace-str tag (str header latency) body))
+  ([tag header body]
+   (str tag " " header "\n"
         body "\n\n\n")))
 
 (defn ^:private latency [started finished]
   (- (.toEpochMilli finished) (.toEpochMilli started)))
 
 (defn received-notification [method params at]
-  (trace-str (trace-header at "Received notification" method)
+  (trace-str (trace-tag at)
+             (trace-header "Received notification" method)
              (trace-body params)))
 
 (defn received-request [id method params at]
-  (trace-str (trace-header at "Received request" method id)
+  (trace-str (trace-tag at)
+             (trace-header "Received request" method id)
              (trace-body params)))
 
 (defn received-response [id method result error started finished]
-  (trace-str (trace-header finished "Received response" method id)
+  (trace-str (trace-tag finished)
+             (trace-header "Received response" method id)
              (str (format " in %sms." (latency started finished))
                   (when error (format " Request failed: %s (%s)." (:message error) (:code error))))
              (if error (trace-body "Error data" (:data error)) (trace-body "Result" result))))
 
+(defn received-unmatched-response [at resp]
+  (trace-str (trace-tag at)
+             "Received response for unmatched request:"
+             (trace-body "Body" resp)))
+
 (defn sending-notification [method params at]
-  (trace-str (trace-header at "Sending notification" method)
+  (trace-str (trace-tag at)
+             (trace-header "Sending notification" method)
              (trace-body params)))
 
 (defn sending-request [id method params at]
-  (trace-str (trace-header at "Sending request" method id)
+  (trace-str (trace-tag at)
+             (trace-header "Sending request" method id)
              (trace-body params)))
 
 (defn sending-response [id method params started finished]
-  (trace-str (trace-header finished "Sending response" method id)
+  (trace-str (trace-tag finished)
+             (trace-header "Sending response" method id)
              (format ". Processing request took %sms" (latency started finished))
              (trace-body "Result" params)))