Skip to content

Commit

Permalink
Provide a unified (lsp-interface INTERFACE ...) pcase form (#4559)
Browse files Browse the repository at this point in the history
* Provide a unified (lsp-interface INTERFACE ...) pcase form

This commit provides a new unified pcase form (lsp-interface INTERFACE ...) to
replace the old per-interface (INTERFACE ...) forms -- the latter are now
deprecated. (Unfortunately, I don't think there's a way to mark a pcase form as
obsolete.)

I've turned the existing pcase-defmacro definition into a helper function. The
new pcase form delegates to that helper function, and the old pcase forms now
delegate to the new form.

This change addresses a few issues, which are detailed in #4430. In short:

* The existing forms aren't namespaced.
* The lsp-mode package adds hundreds of forms, which each add several lines to
  pcase's generated docstring, adding up to over 1000 lines.
* Starting in Emacs 31, the number of forms added by lsp-mode causes a
  noticeable slowdown when loading the interactive help for pcase.

* Add a comment and TODO about deprecating per-interface pcase forms

* Improve docstring for (lsp-interface ...) pcase form

I've tried to summarize the behavior of the existing implementation.

* Replace per-interface pcase forms with the new unified form

I used ripgrep to search for all occurrences of `pcase`, and then checked each
to see if it was using a pattern that looked like an LSP interface name. It's
very possible I missed something, but hopefully not.

* Remove the per-interface pcase forms

The consensus in #4430 is that we're ok with making this breaking change and
communicating it in the CHANGELOG. I've replaced all uses in lsp-mode itself.

* Add CHANGELOG entry for pcase changes

I'm an Org newb, so hopefully this is well-formatted.
  • Loading branch information
chrisbouchard authored Sep 26, 2024
1 parent a52ef29 commit 522b1ad
Show file tree
Hide file tree
Showing 5 changed files with 58 additions and 28 deletions.
4 changes: 3 additions & 1 deletion CHANGELOG.org
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,9 @@
* Change ~ruff-lsp~ to ~ruff~ for python lsp client. All ~ruff-lsp~ customizable variable change to ~ruff~. Lsp server command now is ~["ruff" "server"]~ instead of ~["ruff-lsp"]~.
* Add futhark support
* Optimize overlay creation by checking window visibility first

* Replace the per-interface ~(INTERFACE ...)~ pcase forms with a single,
unified ~(lsp-interface INTERFACE ...)~ form. The per-interface forms are no
longer generated. *This is a breaking change.* (See #4430.)

** 9.0.0
* Add language server config for QML (Qt Modeling Language) using qmlls.
Expand Down
4 changes: 2 additions & 2 deletions lsp-completion.el
Original file line number Diff line number Diff line change
Expand Up @@ -575,8 +575,8 @@ Others: CANDIDATES"
(apply #'delete-region markers)
(insert prefix)
(pcase text-edit?
((TextEdit) (lsp--apply-text-edit text-edit?))
((InsertReplaceEdit :insert :replace :new-text)
((lsp-interface TextEdit) (lsp--apply-text-edit text-edit?))
((lsp-interface InsertReplaceEdit :insert :replace :new-text)
(lsp--apply-text-edit
(lsp-make-text-edit
:new-text new-text
Expand Down
16 changes: 8 additions & 8 deletions lsp-mode.el
Original file line number Diff line number Diff line change
Expand Up @@ -5245,11 +5245,11 @@ identifier and the position respectively."
type Location, LocationLink, Location[] or LocationLink[]."
(setq locations
(pcase locations
((seq (or (Location)
(LocationLink)))
((seq (or (lsp-interface Location)
(lsp-interface LocationLink)))
(append locations nil))
((or (Location)
(LocationLink))
((or (lsp-interface Location)
(lsp-interface LocationLink))
(list locations))))

(cl-labels ((get-xrefs-in-file
Expand Down Expand Up @@ -5616,9 +5616,9 @@ When language is nil render as markup if `markdown-mode' is loaded."
(let ((inhibit-message t))
(or
(pcase content
((MarkedString :value :language)
((lsp-interface MarkedString :value :language)
(lsp--render-string value language))
((MarkupContent :value :kind)
((lsp-interface MarkupContent :value :kind)
(lsp--render-string value kind))
;; plain string
((pred stringp) (lsp--render-string content "markdown"))
Expand Down Expand Up @@ -6408,11 +6408,11 @@ perform the request synchronously."
(-mapcat
(-lambda (sym)
(pcase-exhaustive sym
((DocumentSymbol :name :children? :selection-range (Range :start))
((lsp-interface DocumentSymbol :name :children? :selection-range (lsp-interface Range :start))
(cons (cons (concat path name)
(lsp--position-to-point start))
(lsp--xref-elements-index children? (concat path name " / "))))
((SymbolInformation :name :location (Location :range (Range :start)))
((lsp-interface SymbolInformation :name :location (lsp-interface Location :range (lsp-interface Range :start)))
(list (cons (concat path name)
(lsp--position-to-point start))))))
symbols))
Expand Down
21 changes: 20 additions & 1 deletion lsp-protocol.el
Original file line number Diff line number Diff line change
Expand Up @@ -129,7 +129,7 @@ Allowed params: %s" interface (reverse (-map #'cl-first params)))
$$result))
(-partition 2 plist))
$$result)))
`(pcase-defmacro ,interface (&rest property-bindings)
`(cl-defun ,(intern (format "lsp--pcase-macroexpander-%s" interface)) (&rest property-bindings)
,(if lsp-use-plists
``(and
(pred listp)
Expand Down Expand Up @@ -246,6 +246,25 @@ Allowed params: %s" interface (reverse (-map #'cl-first params)))
(apply #'append)
(cl-list* 'progn))))

(pcase-defmacro lsp-interface (interface &rest property-bindings)
"If EXPVAL is an instance of INTERFACE, destructure it by matching its
properties. EXPVAL should be a plist or hash table depending on the variable
`lsp-use-plists'.
INTERFACE should be an LSP interface defined with `lsp-interface'. This form
will not match if any of INTERFACE's required fields are missing in EXPVAL.
Each :PROPERTY keyword matches a field in EXPVAL. The keyword may be followed by
an optional PATTERN, which is a `pcase' pattern to apply to the field's value.
Otherwise, PROPERTY is let-bound to the field's value.
\(fn INTERFACE [:PROPERTY [PATTERN]]...)"
(cl-check-type interface symbol)
(let ((lsp-pcase-macroexpander
(intern (format "lsp--pcase-macroexpander-%s" interface))))
(cl-assert (fboundp lsp-pcase-macroexpander) "not a known LSP interface: %s" interface)
(apply lsp-pcase-macroexpander property-bindings)))

(if lsp-use-plists
(progn
(defun lsp-get (from key)
Expand Down
41 changes: 25 additions & 16 deletions test/lsp-protocol-test.el
Original file line number Diff line number Diff line change
Expand Up @@ -81,37 +81,43 @@
(lsp-make-my-position :line 30 :character 40 :camelCase nil)
:specialProperty 42)))
(should (pcase particular-range
((MyRange :start (MyPosition :line start-line :character start-char :camel-case start-camelcase)
:end (MyPosition :line end-line :character end-char :camel-case end-camelCase))
((lsp-interface MyRange
:start (lsp-interface MyPosition
:line start-line :character start-char :camel-case start-camelcase)
:end (lsp-interface MyPosition
:line end-line :character end-char :camel-case end-camelCase))
t)
(_ nil)))

(should (pcase particular-extended-range
((MyExtendedRange)
((lsp-interface MyExtendedRange)
t)
(_ nil)))

;; a subclass can be matched by a pattern for a parent class
(should (pcase particular-extended-range
((MyRange :start (MyPosition :line start-line :character start-char :camel-case start-camelcase)
:end (MyPosition :line end-line :character end-char :camel-case end-camelCase))
((lsp-interface MyRange
:start (lsp-interface MyPosition
:line start-line :character start-char :camel-case start-camelcase)
:end (lsp-interface MyPosition
:line end-line :character end-char :camel-case end-camelCase))
t)
(_ nil)))

;; the new patterns should be able to be used with existing ones
(should (pcase (list particular-range
particular-extended-range)
((seq (MyRange)
(MyExtendedRange))
((seq (lsp-interface MyRange)
(lsp-interface MyExtendedRange))
t)
(_ nil)))

;; the existing seq pattern should detect that the ranges are
;; not in the order specified by the inner patterns
(should-not (pcase (list particular-range
particular-extended-range)
((seq (MyExtendedRange)
(MyRange))
((seq (lsp-interface MyExtendedRange)
(lsp-interface MyRange))
t)
(_ nil)))

Expand All @@ -122,40 +128,43 @@
;; and the second instance is an equality check against the other
;; :character value, which is different.
(should-not (pcase particular-range
((MyRange :start (MyPosition :line start-line :character :camel-case start-camelcase)
:end (MyPosition :line end-line :character :camel-case end-camelCase))
((lsp-interface MyRange
:start (lsp-interface MyPosition
:line start-line :character :camel-case start-camelcase)
:end (lsp-interface MyPosition
:line end-line :character :camel-case end-camelCase))
t)
(_ nil)))

;; if an optional property is requested when it does not exist, we
;; should still match if the required stuff matches. Missing
;; optional properties are bound to nil.
(should (pcase particular-range
((MyRange :start (MyPosition :optional?))
((lsp-interface MyRange :start (lsp-interface MyPosition :optional?))
(null optional?))
(_ nil)))

;; we cannot request a key (whether or not it is optional) not in
;; the interface, even if the expr-val has all the types specified
;; by the interface. This is a programmer error.
(should-error (pcase particular-range
((MyRange :something-unrelated)
((lsp-interface MyRange :something-unrelated)
t)
(_ nil)))

;; we do not use camelCase at this stage. This is a programmer error.
(should-error (pcase particular-range
((MyRange :start (MyPosition :camelCase))
((lsp-interface MyRange :start (lsp-interface MyPosition :camelCase))
t)
(_ nil)))
(should (pcase particular-range
((MyRange :start (MyPosition :camel-case))
((lsp-interface MyRange :start (lsp-interface MyPosition :camel-case))
t)
(_ nil)))

;; :end is missing, so we should fail to match the interface.
(should-not (pcase (lsp-make-my-range :start (lsp-make-my-position :line 10 :character 20 :camelCase nil))
((MyRange)
((lsp-interface MyRange)
t)
(_ nil)))))

Expand Down

0 comments on commit 522b1ad

Please sign in to comment.