diff --git a/resources/coalton-lsp-user.lisp b/resources/coalton-lsp-user.lisp new file mode 100644 index 0000000..5dd406f --- /dev/null +++ b/resources/coalton-lsp-user.lisp @@ -0,0 +1,24 @@ +;;;; helpers for interactive development: starting network server, +;;;; changing logging options + +(defpackage #:coalton-lsp-user + (:use #:cl + #:coalton-lsp)) + +(in-package #:coalton-lsp-user) + +(defun restart-server () + (when *server* + (stop-server)) + (start-server *server-port*)) + +;;; (restart-server) + +(defun enable-debugging () + (set-log-level :debug)) + +(defun enable-worker-debugging () + (setf coalton-lsp::*worker-debug* t)) + +(defun enable-file-logger () + (set-log-file "~/git/coalton-mode/rpc.log")) diff --git a/src/lib/log.lisp b/src/lib/log.lisp index 6bca6d3..8bd342b 100644 --- a/src/lib/log.lisp +++ b/src/lib/log.lisp @@ -38,6 +38,8 @@ :reader log-level) (lock :initform (bt:make-lock)))) +(defmethod stop ((self stream-logger))) + (defvar *levels* '(:trace :debug :info :warn :error)) @@ -59,7 +61,8 @@ (write-string " : " stream) (%write-context stream) (apply #'format stream format format-args) - (terpri stream))))) + (terpri stream) + (force-output stream))))) (defparameter *logger* (make-instance 'stream-logger :stream t :level ':info)) @@ -71,6 +74,24 @@ (defun set-log-level (level) (setf (slot-value *logger* 'level) level)) +(defclass file-logger (stream-logger) + ()) + +(defmethod stop ((self file-logger)) + (close (slot-value self 'stream))) + +(defun set-log-file (filename) + (when *logger* + (stop *logger*)) + (let ((stream (open filename + :direction ':output + :if-exists ':append + :if-does-not-exist ':create + :element-type 'character))) + (setf *logger* (make-instance 'file-logger + :stream stream + :level ':debug)))) + (defun /trace-p () (log-p *logger* ':trace)) diff --git a/src/lib/process.lisp b/src/lib/process.lisp index e3cef1b..d885698 100644 --- a/src/lib/process.lisp +++ b/src/lib/process.lisp @@ -73,20 +73,21 @@ (loop :while (and (run-p worker) (not (empty-p worker))) :do (let ((element (dequeue worker))) - (/debug "about to process one entry") - (handler-case - (funcall (slot-value worker 'fn) element) - (condition (condition) - (when *worker-debug* - (signal condition)) - (/error "ignoring error : ~a" condition)))))) + (/trace "service-queue: process ~a" element) + (cond (*worker-debug* + (funcall (slot-value worker 'fn) element)) + (t + (handler-case + (funcall (slot-value worker 'fn) element) + (condition (condition) + (/error "ignoring error : ~a" condition)))))))) (defmethod run ((self worker)) (with-logging-context (:worker (lambda (stream) (write-string "worker" stream))) - (/debug "starting") + (/trace "starting") (unwind-protect (loop :while (run-p self) :do (service-queue self) (sleep *worker-poll-interval*)) - (/debug "stopping")))) + (/trace "stopping")))) diff --git a/src/package.lisp b/src/package.lisp index bf0f6c1..8356233 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -2,6 +2,9 @@ (:documentation "An LSP server for the Coalton language") (:use #:cl) (:export #:main - #:start - #:stop - #:restart)) + #:*server* + #:*server-port* + #:set-log-level + #:set-log-file + #:start-server + #:stop-server)) diff --git a/src/protocol.lisp b/src/protocol.lisp index 5493a1d..09b117f 100644 --- a/src/protocol.lisp +++ b/src/protocol.lisp @@ -388,6 +388,43 @@ (:resolve-provider (boolean :optional t)) (:completion-item (completion-item-options :optional t))) +(define-message document-filter () + (:language (string :optional t)) + (:scheme (string :optional t)) + (:pattern (string :optional t))) + +(define-message text-document-registration-options () + (:document-selector (document-filter :vector t :optional t))) + +(define-message empty ()) + +(define-message delta () + (:delta (boolean :optional t))) + +(define-union range-option (boolean empty)) + +(define-union full-option (boolean delta)) + +(define-message semantic-tokens-legend () + (:token-types (string :vector t)) + (:token-modifiers (string :vector t))) + +(define-message semantic-tokens-options (work-done-progress-options) + (:legend semantic-tokens-legend) + (:range (range-option :optional t)) + (:full (full-option :optional t))) + +(define-message static-registration-options () + (:id (string :optional t))) + +(define-message semantic-tokens-registration-options + (text-document-registration-options + semantic-tokens-options + static-registration-options)) + +(define-union document-symbol-provider-options + (boolean document-symbol-options)) + (define-message server-capabilities () (:position-encoding (position-encoding-kind :optional t)) (:text-document-sync (text-document-sync-options :optional t)) @@ -401,7 +438,7 @@ #++ (:implementation-provider (or boolean implementation-options implementation-registration-options)) #++ (:references-provider (or boolean reference-options)) #++ (:document-highlight-provider (or boolean document-highlight-options)) - (:document-symbol-provider (document-symbol-options :optional t)) + (:document-symbol-provider (document-symbol-provider-options :optional t)) #++ (:code-action-provider (or boolean code-action-options)) #++ (:code-lens-provider (code-lens-options :optional t)) (:document-link-provider (document-link-options :optional t)) @@ -415,7 +452,7 @@ #++ (:selection-range-provider (or boolean selection-range-options selection-range-registration-options)) #++ (:linked-editing-range-provider (or boolean linked-editing-range-options linked-editing-range-registration-options)) #++ (:call-hierarchy-provider (or boolean call-hierarchy-options call-hierarchy-registration-options)) - #++ (:semantic-tokens-provider (or semantic-tokens-options semantic-tokens-registration-options)) + (:semantic-tokens-provider semantic-tokens-registration-options) #++ (:moniker-provider (or boolean moniker-options moniker-registration-options)) #++ (:type-hierarchy-provider (or boolean type-hierarchy-options type-hierarchy-registration-options)) #++ (:inline-value-provider (or boolean inline-value-options inline-value-registration-options)) @@ -437,6 +474,14 @@ (set-field result (list :capabilities :text-document-sync :change) :full) (set-field result (list :capabilities :definition-provider :work-done-progress) t) (set-field result (list :capabilities :document-formatting-provider :work-done-progress) t) + (set-field result (list :capabilities :document-symbol-provider) t) + (set-field result (list :capabilities :semantic-tokens-provider :legend :token-types) + '("namespace" "type" "function" "macro" "keyword" "class" "variable" "method" + "event" "interface")) + (set-field result (list :capabilities :semantic-tokens-provider :legend :token-modifiers) + '("definition" "defaultLibrary" "implementation")) + (set-field result (list :capabilities :semantic-tokens-provider :range) t) + (set-field result (list :capabilities :semantic-tokens-provider :full) t) (set-field result (list :capabilities :position-encoding) (position-encoding session)) result)) @@ -445,6 +490,15 @@ initialize-params handle-initialize) +(defun handle-shutdown (session params) + (declare (ignore params)) + (shutdown-session session) + (make-message 'empty)) + +(define-handler "shutdown" + empty + handle-shutdown) + (define-message initialized-params ()) (defun handle-initialized (session params) diff --git a/src/server.lisp b/src/server.lisp index df7ab19..4ebe692 100644 --- a/src/server.lisp +++ b/src/server.lisp @@ -72,7 +72,7 @@ (stop session)))) (call-next-method)) -(defvar *default-port* 7887 +(defvar *server-port* 7887 "The default port of LSP sessions.") (defvar *server* nil @@ -87,7 +87,7 @@ (setf *server* nil) (/info "server halted")) -(defun start-server (&optional (port *default-port*)) +(defun start-server (&optional (port *server-port*)) "Run a Coalton LSP server on PORT." (when *server* (/info "halting server at tcp:~a" (server-address *server*)) @@ -98,7 +98,7 @@ :host "127.0.0.1")))) (/info "server started at tcp:~a" (server-address *server*))) -(defun main (&key (port *default-port*)) +(defun main (&key (port *server-port*)) "Run a Coalton LSP server on PORT, halting on interrupt." (start-server port) (handler-case diff --git a/src/session.lisp b/src/session.lisp index fb78e4d..0003e94 100644 --- a/src/session.lisp +++ b/src/session.lisp @@ -24,14 +24,14 @@ (defun submit-event (session method value) (with-session-context (session) - (/debug "submit-event ~a ~a" method value) + (/trace "submit-event ~a ~a" method value) (with-slots (event-queue) session (enqueue event-queue (cons method value))))) (defun process-event (session event) (with-session-context (session) (destructuring-bind (method . value) event - (/debug "process-event ~a" method) + (/trace "process-event ~a" method) (funcall method session value)))) (defun session-uri (session) @@ -49,6 +49,9 @@ (setf (session-state session) 'initializing) (setf (session-params session) params)) +(defun shutdown-session (session) + (setf (session-state session) 'shutting-down)) + (defun initialized-session (session) (with-session-context (session) (setf (session-state session) 'initialized) @@ -262,9 +265,11 @@ (defun process-request (session request) (handler-case - (let* ((handler (get-message-handler (request-method request))) + (let* ((method (request-method request)) + (handler (get-message-handler method)) (params (request-params request)) (result (funcall (message-handler-fn handler) session params))) + (/debug "processing request: '~a'" method) (make-response (get-field request :id) result)) (lsp-error (condition) (make-error-response (get-field request :id) condition)))) diff --git a/tests/session-tests.lisp b/tests/session-tests.lisp index f8535c8..31c1a9e 100644 --- a/tests/session-tests.lisp +++ b/tests/session-tests.lisp @@ -5,13 +5,43 @@ (is (equalp (lsp::message-value (lsp::process-request session (lsp::make-request (rpc-example "initialize.json")))) - '(("result" - ("capabilities" ("positionEncoding" . "utf-16") - ("documentFormattingProvider" ("workDoneProgress" . T)) - ("definitionProvider" ("workDoneProgress" . T)) - ("textDocumentSync" ("change" . 1) ("openClose" . T))) - ("serverInfo" ("name" . "Coalton"))) - ("id" . 1) ("jsonrpc" . "2.0")))))) + '(("result" + ("capabilities" + ("positionEncoding" + . "utf-16") + ("semanticTokensProvider" + ("full" . T) + ("range" . T) + ("legend" + ("tokenModifiers" + "definition" + "defaultLibrary" + "implementation") + ("tokenTypes" + "namespace" + "type" + "function" + "macro" + "keyword" + "class" + "variable" + "method" + "event" + "interface"))) + ("documentSymbolProvider" + . T) + ("documentFormattingProvider" + ("workDoneProgress" + . T)) + ("definitionProvider" + ("workDoneProgress" + . T)) + ("textDocumentSync" + ("change" . 1) + ("openClose" + . T))) + ("serverInfo" ("name" . "Coalton"))) + ("id" . 1) ("jsonrpc" . "2.0")))))) (deftest session-tests/get-field () (let ((init (lsp::make-request (rpc-example "initialize.json")))) @@ -46,8 +76,32 @@ \"definitionProvider\": { \"workDoneProgress\": true }, + \"documentSymbolProvider\": true, \"documentFormattingProvider\": { \"workDoneProgress\": true + }, + \"semanticTokensProvider\": { + \"legend\": { + \"tokenTypes\": [ + \"namespace\", + \"type\", + \"function\", + \"macro\", + \"keyword\", + \"class\", + \"variable\", + \"method\", + \"event\", + \"interface\" + ], + \"tokenModifiers\": [ + \"definition\", + \"defaultLibrary\", + \"implementation\" + ] + }, + \"range\": true, + \"full\": true } }, \"serverInfo\": {