Provide a unified (lsp-interface INTERFACE ...) pcase form (#4559)

* 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.

Author: chrisbouchard

CHANGELOG.org

@@ -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.

lsp-completion.el

@@ -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

lsp-mode.el

@@ -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
@@ -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"))
@@ -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))

lsp-protocol.el

@@ -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)
@@ -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)

test/lsp-protocol-test.el

@@ -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)))
 
@@ -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)))))