[glob] Remove top-level braces, if any (#2373)

* [glob] Remove top-level braces, if any

This works around long braced glob expressions that some servers send.

* [lsp-rf]: don't keep track of number for match group

Author: leungbk

clients/lsp-rf.el

@@ -84,8 +84,10 @@
   (mapcar 'expand-file-name lsp-rf-language-server-start-command))
 
 (defun parse-rf-language-server-globs-to-regex (vector)
-  "Converts `vector' with globs to regex."
-  (concat "\\(" (mapconcat #'lsp-glob-to-regexp vector "\\|") "\\)"))
+  "Convert a VECTOR of globs to a regex."
+  (--> (mapcan #'lsp-glob-to-regexps vector)
+       (s-join "\\|" it)
+       (concat "\\(?:" it "\\)")))
 
 (defun parse-rf-language-server-include-path-regex (vector)
   "Creates regexp to select files from workspace directory."

lsp-mode.el

@@ -2545,9 +2545,27 @@ an Elisp regexp."
            glob-segments)
           current-regexp)))))
 
-(defun lsp-glob-to-regexp (pattern)
-  "Convert a PATTERN from LSP's glob syntax to an Elisp regexp."
-  (concat "\\`" (lsp--glob-to-regexp (string-trim pattern)) "\\'"))
+;; See https://github.com/emacs-lsp/lsp-mode/issues/2365
+(defun lsp-glob-unbrace-at-top-level (glob-pattern)
+  "If GLOB-PATTERN does not start with a brace, return a singleton list containing GLOB-PATTERN.
+
+If GLOB-PATTERN does start with a brace, return a list of the
+comma-separated globs within the top-level braces."
+  (if (not (string-prefix-p "{" glob-pattern))
+      (list glob-pattern)
+    (lsp-split-glob-pattern (substring glob-pattern 1 -1) ?\,)))
+
+(defun lsp-glob-convert-to-wrapped-regexp (glob-pattern)
+  "Convert GLOB-PATTERN to a regexp wrapped with the beginning-
+and end-of-string meta-characters."
+  (concat "\\`" (lsp--glob-to-regexp (string-trim glob-pattern)) "\\'"))
+
+(defun lsp-glob-to-regexps (glob-pattern)
+  "Convert a GLOB-PATTERN to a list of Elisp regexps."
+  (let* ((trimmed-pattern (string-trim glob-pattern))
+         (top-level-unbraced-patterns (lsp-glob-unbrace-at-top-level trimmed-pattern)))
+    (seq-map #'lsp-glob-convert-to-wrapped-regexp
+             top-level-unbraced-patterns)))
 
 
 
@@ -3314,6 +3332,7 @@ disappearing, unset all the variables related to it."
 (defun lsp--file-process-event (session root-folder event)
   "Process file event."
   (let* ((changed-file (cl-third event))
+         (rel-changed-file (f-relative changed-file root-folder))
          (event-numeric-kind (alist-get (cl-second event) lsp--file-change-type))
          (bit-position (1- event-numeric-kind))
          (watch-bit (ash 1 bit-position)))
@@ -3338,9 +3357,11 @@ disappearing, unset all the variables related to it."
                             (-lambda ((&FileSystemWatcher :glob-pattern :kind?))
                               (when (or (null kind?)
                                         (> (logand kind? watch-bit) 0))
-                                (-let [glob-regex (lsp-glob-to-regexp glob-pattern)]
-                                  (or (string-match glob-regex changed-file)
-                                      (string-match glob-regex (f-relative changed-file root-folder))))))))))))
+                                (-let [regexes (lsp-glob-to-regexps glob-pattern)]
+                                  (-any? (lambda (re)
+                                           (or (string-match re changed-file)
+                                               (string-match re rel-changed-file)))
+                                         regexes))))))))))
                  (with-lsp-workspace workspace
                    (lsp-notify
                     "workspace/didChangeWatchedFiles"

test/lsp-file-watch-test.el

@@ -142,59 +142,65 @@
     (should (equal expected-events events))
     (lsp-kill-watch watch)))
 
+(ert-deftest lsp-file-watch--glob-split ()
+  (should (equal (lsp-glob-unbrace-at-top-level "{/home/alice/project/**/*.hs,/home/alice/project/stack.yaml}")
+                 '("/home/alice/project/**/*.hs" "/home/alice/project/stack.yaml")))
+  (should (equal (lsp-glob-unbrace-at-top-level "{/home/alice/project/**/*.{ml,eliom},/home/alice/project/dune.project}")
+                 '("/home/alice/project/**/*.{ml,eliom}" "/home/alice/project/dune.project"))))
+
 (ert-deftest lsp-file-watch--glob-pattern ()
-  (should (string-match (lsp-glob-to-regexp "pom.xml") "pom.xml"))
-  (should (string-match (lsp-glob-to-regexp "**/pom.xml") "/pom.xml"))
-  (should (string-match (lsp-glob-to-regexp "**/*.xml") "data/pom.xml"))
-  (should (string-match (lsp-glob-to-regexp "**/*.xml") "pom.xml"))
+  (should (string-match (lsp-glob-convert-to-wrapped-regexp "pom.xml") "pom.xml"))
+  (should (string-match (lsp-glob-convert-to-wrapped-regexp "**/pom.xml") "/pom.xml"))
+  (should (string-match (lsp-glob-convert-to-wrapped-regexp "**/*.xml") "data/pom.xml"))
+  (should (string-match (lsp-glob-convert-to-wrapped-regexp "**/*.xml") "pom.xml"))
 
   ;; Some VSCode tests
   ;; (https://github.com/Microsoft/vscode/blob/466da1c9013c624140f6d1473b23a870abc82d44/src/vs/base/test/node/glob.test.ts)
-  (should (string-match (lsp-glob-to-regexp "**/.*") ".git"))
-  (should (string-match (lsp-glob-to-regexp "**/.*") ".hidden.txt"))
-  (should (not (string-match (lsp-glob-to-regexp "**/.*") "git")))
-  (should (not (string-match (lsp-glob-to-regexp "**/.*") "hidden.txt")))
+  (should (string-match (lsp-glob-convert-to-wrapped-regexp "**/.*") ".git"))
+  (should (string-match (lsp-glob-convert-to-wrapped-regexp "**/.*") ".hidden.txt"))
+  (should (not (string-match (lsp-glob-convert-to-wrapped-regexp "**/.*") "git")))
+  (should (not (string-match (lsp-glob-convert-to-wrapped-regexp "**/.*") "hidden.txt")))
 
-  (should (string-match (lsp-glob-to-regexp "**/.*") "path/.git"))
-  (should (string-match (lsp-glob-to-regexp "**/.*") "path/.hidden.txt"))
-  (should (not (string-match (lsp-glob-to-regexp "**/.*") "path/git")))
-  (should (not (string-match (lsp-glob-to-regexp "**/.*") "pat.h/hidden.txt")))
+  (should (string-match (lsp-glob-convert-to-wrapped-regexp "**/.*") "path/.git"))
+  (should (string-match (lsp-glob-convert-to-wrapped-regexp "**/.*") "path/.hidden.txt"))
+  (should (not (string-match (lsp-glob-convert-to-wrapped-regexp "**/.*") "path/git")))
+  (should (not (string-match (lsp-glob-convert-to-wrapped-regexp "**/.*") "pat.h/hidden.txt")))
 
-  (should (string-match (lsp-glob-to-regexp "**/node_modules/**") "node_modules"))
-  (should (string-match (lsp-glob-to-regexp "**/node_modules/**") "node_modules/"))
-  (should (not (string-match (lsp-glob-to-regexp "**/node_modules/**") "node/_modules/")))
+  (should (string-match (lsp-glob-convert-to-wrapped-regexp "**/node_modules/**") "node_modules"))
+  (should (string-match (lsp-glob-convert-to-wrapped-regexp "**/node_modules/**") "node_modules/"))
+  (should (not (string-match (lsp-glob-convert-to-wrapped-regexp "**/node_modules/**") "node/_modules/")))
 
-  (should (string-match (lsp-glob-to-regexp "?") "h"))
-  (should (not (string-match (lsp-glob-to-regexp "?") "hi")))
+  (should (string-match (lsp-glob-convert-to-wrapped-regexp "?") "h"))
+  (should (not (string-match (lsp-glob-convert-to-wrapped-regexp "?") "hi")))
 
-  (should (string-match (lsp-glob-to-regexp "foo.[[]") "foo.["))
+  (should (string-match (lsp-glob-convert-to-wrapped-regexp "foo.[[]") "foo.["))
 
-  (should (string-match (lsp-glob-to-regexp "{foo,bar}/**") "foo"))
-  (should (string-match (lsp-glob-to-regexp "{foo,bar}/**") "bar"))
-  (should (string-match (lsp-glob-to-regexp "{foo,bar}/**") "foo/test"))
-  (should (string-match (lsp-glob-to-regexp "{foo,bar}/**") "bar/test"))
+  (should (string-match (lsp-glob-convert-to-wrapped-regexp "{foo,bar}/**") "foo"))
+  (should (string-match (lsp-glob-convert-to-wrapped-regexp "{foo,bar}/**") "bar"))
+  (should (string-match (lsp-glob-convert-to-wrapped-regexp "{foo,bar}/**") "foo/test"))
+  (should (string-match (lsp-glob-convert-to-wrapped-regexp "{foo,bar}/**") "bar/test"))
 
-  (should (string-match (lsp-glob-to-regexp "{**/*.d.ts,**/*.js}") "/testing/foo.js"))
-  (should (string-match (lsp-glob-to-regexp "{**/*.d.ts,**/*.js}") "testing/foo.d.ts"))
-  (should (string-match (lsp-glob-to-regexp "{**/*.d.ts,**/*.js,foo.[0-9]}") "foo.5"))
+  (should (string-match (lsp-glob-convert-to-wrapped-regexp "{**/*.d.ts,**/*.js}") "/testing/foo.js"))
+  (should (string-match (lsp-glob-convert-to-wrapped-regexp "{**/*.d.ts,**/*.js}") "testing/foo.d.ts"))
+  (should (string-match (lsp-glob-convert-to-wrapped-regexp "{**/*.d.ts,**/*.js,foo.[0-9]}") "foo.5"))
 
-  (should (string-match (lsp-glob-to-regexp "some/**/*") "some/foo.js"))
-  (should (string-match (lsp-glob-to-regexp "some/**/*") "some/folder/foo.js"))
+  (should (string-match (lsp-glob-convert-to-wrapped-regexp "some/**/*") "some/foo.js"))
+  (should (string-match (lsp-glob-convert-to-wrapped-regexp "some/**/*") "some/folder/foo.js"))
 
-  (should (not (string-match (lsp-glob-to-regexp "some/**/*") "something/foo.js")))
-  (should (not (string-match (lsp-glob-to-regexp "some/**/*") "something/folder/foo.js")))
+  (should (not (string-match (lsp-glob-convert-to-wrapped-regexp "some/**/*") "something/foo.js")))
+  (should (not (string-match (lsp-glob-convert-to-wrapped-regexp "some/**/*") "something/folder/foo.js")))
 
-  (should (not (string-match (lsp-glob-to-regexp "{**/*.d.ts,**/*.js,foo.[0-9]}") "foo.f")))
-  (should (string-match (lsp-glob-to-regexp "prefix/{**/*.d.ts,**/*.js,foo.[0-9]}") "prefix/foo.8"))
-  (should (not (string-match (lsp-glob-to-regexp "prefix/{**/*.d.ts,**/*.js,foo.[0-9]}") "prefix/foo.f")))
+  (should (not (string-match (lsp-glob-convert-to-wrapped-regexp "{**/*.d.ts,**/*.js,foo.[0-9]}") "foo.f")))
+  (should (string-match (lsp-glob-convert-to-wrapped-regexp "prefix/{**/*.d.ts,**/*.js,foo.[0-9]}") "prefix/foo.8"))
+  (should (not (string-match (lsp-glob-convert-to-wrapped-regexp "prefix/{**/*.d.ts,**/*.js,foo.[0-9]}") "prefix/foo.f")))
 
-  (should (not (string-match (lsp-glob-to-regexp "foo.[!0-9]") "foo.5")))
-  (should (not (string-match (lsp-glob-to-regexp "foo.[!0-9]") "foo.8")))
-  (should (string-match (lsp-glob-to-regexp "foo.[!0-9]") "foo.f"))
+  (should (not (string-match (lsp-glob-convert-to-wrapped-regexp "foo.[!0-9]") "foo.5")))
+  (should (not (string-match (lsp-glob-convert-to-wrapped-regexp "foo.[!0-9]") "foo.8")))
+  (should (string-match (lsp-glob-convert-to-wrapped-regexp "foo.[!0-9]") "foo.f"))
 
-  (should (not (string-match (lsp-glob-to-regexp "foo.[^0-9]") "foo.5")))
-  (should (not (string-match (lsp-glob-to-regexp "foo.[^0-9]") "foo.8")))
-  (should (string-match (lsp-glob-to-regexp "foo.[^0-9]") "foo.f"))
+  (should (not (string-match (lsp-glob-convert-to-wrapped-regexp "foo.[^0-9]") "foo.5")))
+  (should (not (string-match (lsp-glob-convert-to-wrapped-regexp "foo.[^0-9]") "foo.8")))
+  (should (string-match (lsp-glob-convert-to-wrapped-regexp "foo.[^0-9]") "foo.f"))
 
   ;; ???: This should properly fail since path-separators should be
   ;; ignored inside brackets, but here (and in VSCode) it fails for a
@@ -206,7 +212,7 @@
   ;; way of handling this to recognize that because we're unbalanced
   ;; at the end, that everything should be treated as a literal. But
   ;; after experimenting with zsh, this isn't what they use.
-  (should (not (string-match (lsp-glob-to-regexp "foo[/]bar") "foo/bar"))))
+  (should (not (string-match (lsp-glob-convert-to-wrapped-regexp "foo[/]bar") "foo/bar"))))
 
 (ert-deftest lsp-file-watch--ignore-list ()
   :tags '(no-win)