|
1 | 1 | (ns com.github.clojure-lsp.intellij.client |
2 | 2 | (:require |
3 | | - [clojure.core.async :as async] |
4 | | - [clojure.string :as string] |
5 | | - [com.github.clojure-lsp.intellij.db :as db] |
6 | | - [com.github.ericdallo.clj4intellij.logger :as logger] |
7 | | - [lsp4clj.coercer :as coercer] |
8 | | - [lsp4clj.io-chan :as io-chan] |
9 | | - [lsp4clj.lsp.requests :as lsp.requests] |
10 | | - [lsp4clj.lsp.responses :as lsp.responses] |
11 | 3 | [lsp4clj.protocols.endpoint :as protocols.endpoint]) |
12 | 4 | (:import |
13 | 5 | [com.intellij.openapi.project Project] |
|
21 | 13 | (defmulti progress (fn [_context {:keys [token]}] token)) |
22 | 14 | (defmulti workspace-apply-edit (fn [_context {:keys [label]}] label)) |
23 | 15 |
|
24 | | -(defn ^:private publish-diagnostics [{:keys [project]} {:keys [uri diagnostics]}] |
25 | | - (db/assoc-in project [:diagnostics uri] diagnostics)) |
26 | | - |
27 | | -(defn ^:private receive-message |
28 | | - [client context message] |
29 | | - (let [message-type (coercer/input-message-type message)] |
30 | | - (try |
31 | | - (let [response |
32 | | - (case message-type |
33 | | - (:parse-error :invalid-request) |
34 | | - (protocols.endpoint/log client :error "Error reading message" message) |
35 | | - :request |
36 | | - (protocols.endpoint/receive-request client context message) |
37 | | - (:response.result :response.error) |
38 | | - (protocols.endpoint/receive-response client message) |
39 | | - :notification |
40 | | - (protocols.endpoint/receive-notification client context message))] |
41 | | - ;; Ensure client only responds to requests |
42 | | - (when (identical? :request message-type) |
43 | | - response)) |
44 | | - (catch Throwable e |
45 | | - (protocols.endpoint/log client :error "Error receiving:" e) |
46 | | - (throw e))))) |
47 | | - |
48 | | -(defrecord Client [client-id |
49 | | - input-ch |
50 | | - output-ch |
51 | | - join |
52 | | - request-id |
53 | | - sent-requests |
54 | | - trace-level] |
55 | | - protocols.endpoint/IEndpoint |
56 | | - (start [this context] |
57 | | - (protocols.endpoint/log this :verbose "lifecycle:" "starting") |
58 | | - (let [pipeline (async/pipeline-blocking |
59 | | - 1 ;; no parallelism preserves server message order |
60 | | - output-ch |
61 | | - ;; TODO: return error until initialize request is received? https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#initialize |
62 | | - ;; `keep` means we do not reply to responses and notifications |
63 | | - (keep #(receive-message this context %)) |
64 | | - input-ch)] |
65 | | - (async/thread |
66 | | - ;; wait for pipeline to close, indicating input closed |
67 | | - (async/<!! pipeline) |
68 | | - (deliver join :done))) |
69 | | - ;; invokers can deref the return of `start` to stay alive until server is |
70 | | - ;; shut down |
71 | | - join) |
72 | | - (shutdown [this] |
73 | | - (protocols.endpoint/log this :verbose "lifecycle:" "shutting down") |
74 | | - ;; closing input will drain pipeline, then close output, then close |
75 | | - ;; pipeline |
76 | | - (async/close! input-ch) |
77 | | - (if (= :done (deref join 10e3 :timeout)) |
78 | | - (protocols.endpoint/log this :verbose "lifecycle:" "shutdown") |
79 | | - (protocols.endpoint/log this :verbose "lifecycle:" "shutdown timed out"))) |
80 | | - (log [this msg params] |
81 | | - (protocols.endpoint/log this :verbose msg params)) |
82 | | - (log [_this level msg params] |
83 | | - (when (or (identical? trace-level level) |
84 | | - (identical? trace-level :verbose)) |
85 | | - ;; TODO apply color |
86 | | - (logger/info (string/join " " [msg params])))) |
87 | | - (send-request [this method body] |
88 | | - (let [req (lsp.requests/request (swap! request-id inc) method body) |
89 | | - p (promise) |
90 | | - start-ns (System/nanoTime)] |
91 | | - (protocols.endpoint/log this :messages "sending request:" req) |
92 | | - ;; Important: record request before sending it, so it is sure to be |
93 | | - ;; available during receive-response. |
94 | | - (swap! sent-requests assoc (:id req) {:request p |
95 | | - :start-ns start-ns}) |
96 | | - (async/>!! output-ch req) |
97 | | - p)) |
98 | | - (send-notification [this method body] |
99 | | - (let [notif (lsp.requests/notification method body)] |
100 | | - (protocols.endpoint/log this :messages "sending notification:" notif) |
101 | | - (async/>!! output-ch notif))) |
102 | | - (receive-response [this {:keys [id] :as resp}] |
103 | | - (if-let [{:keys [request start-ns]} (get @sent-requests id)] |
104 | | - (let [ms (float (/ (- (System/nanoTime) start-ns) 1000000))] |
105 | | - (protocols.endpoint/log this :messages (format "received response (%.0fms):" ms) resp) |
106 | | - (swap! sent-requests dissoc id) |
107 | | - (deliver request (if (:error resp) |
108 | | - resp |
109 | | - (:result resp)))) |
110 | | - (protocols.endpoint/log this :error "received response for unmatched request:" resp))) |
111 | | - (receive-request [this context {:keys [id method params] :as req}] |
112 | | - (protocols.endpoint/log this :messages "received request:" req) |
113 | | - (when-let [response-body (case method |
114 | | - "window/showMessageRequest" (show-message-request params) |
115 | | - "window/showDocument" (show-document context params) |
116 | | - "workspace/applyEdit" (workspace-apply-edit context params) |
117 | | - (logger/warn "Unknown LSP request method" method))] |
118 | | - (let [resp (lsp.responses/response id response-body)] |
119 | | - (protocols.endpoint/log this :messages "sending response:" resp) |
120 | | - resp))) |
121 | | - (receive-notification [this context {:keys [method params] :as notif}] |
122 | | - (protocols.endpoint/log this :messages "received notification:" notif) |
123 | | - (case method |
124 | | - "window/showMessage" (show-message context params) |
125 | | - "$/progress" (progress context params) |
126 | | - "textDocument/publishDiagnostics" (publish-diagnostics context params) |
127 | | - |
128 | | - (logger/warn "Unknown LSP notification method" method)))) |
129 | | - |
130 | | -(defn client [in out trace-level] |
131 | | - (map->Client |
132 | | - {:client-id 1 |
133 | | - :input-ch (io-chan/input-stream->input-chan out) |
134 | | - :output-ch (io-chan/output-stream->output-chan in) |
135 | | - :join (promise) |
136 | | - :sent-requests (atom {}) |
137 | | - :request-id (atom 0) |
138 | | - :trace-level trace-level})) |
139 | | - |
140 | | -(defn start-client! [client context] |
141 | | - (protocols.endpoint/start client context)) |
142 | | - |
143 | 16 | (defn request! [client [method body]] |
144 | 17 | (protocols.endpoint/send-request client (subs (str method) 1) body)) |
145 | 18 |
|
|
0 commit comments