Improve performance of glob path matcher

This replaces the usage of `fs/glob` with a besboke implementation based
on the original.

Primarily this implementation allows combining multiple glob patterns
to avoid traversing the file tree multiple times.

This also directly matches for `deps.edn` files which avoids the need
for a second pass on the final results.

Author: julienvincent

packages/kmono-core/src/k16/kmono/core/fs.clj

@@ -2,7 +2,11 @@
   (:require
    [babashka.fs :as fs]
    [clojure.edn :as edn]
-   [clojure.string :as str]))
+   [clojure.string :as str])
+  (:import
+   java.nio.file.FileSystems
+   java.nio.file.Path
+   java.nio.file.PathMatcher))
 
 (set! *warn-on-reflection* true)
 
@@ -69,13 +73,89 @@
                       {:file-path file-path}
                       ex)))))
 
-(defn find-package-directories [root packages-glob]
+(defn- escape-glob-chars
+  "Escapes special glob characters in the input string."
+  [s]
+  (let [special-chars #{\\ \* \? \[ \] \{ \}}
+        escape-char (fn [c]
+                      (if (contains? special-chars c)
+                        (str "\\" c)
+                        (str c)))]
+    (apply str (mapv escape-char s))))
+
+(defn- glob->matcher ^PathMatcher [root glob]
+  (let [base-path (-> root fs/absolutize fs/normalize str)
+        escaped-base-path (escape-glob-chars base-path)
+        pattern (let [separator (when-not (str/ends-with? base-path fs/file-separator)
+                                  (str fs/file-separator))]
+                  (str escaped-base-path separator glob))
+        pattern (str "glob:" pattern)]
+    (.getPathMatcher
+     (FileSystems/getDefault)
+     pattern)))
+
+(defn- globs->matcher ^PathMatcher [root globs]
+  (let [matchers (mapv #(glob->matcher root %) globs)]
+    (proxy [PathMatcher] []
+      (matches [^Path path]
+        (reduce
+         (fn [acc matcher]
+           (if (PathMatcher/.matches matcher path)
+             (reduced true)
+             acc))
+         false
+         matchers)))))
+
+(def ^:no-doc ?Path
+  [:fn {:error/message "Should be an instance of java.nio.file.Path"}
+   (partial instance? Path)])
+
+;; TODO: It would be nice if this could skip/not traverse into directories that
+;; are included in gitignored files
+;; 
+;; This would require either a way to convert `.gitignore` syntax to Java
+;; PathMatcher compatible globs or using something like JGit.
+(defn find-package-directories
+  "Find packages in a given `root` that are described by the given set of
+   `package-globs`."
+  {:malli/schema [:-> :string [:or :string [:set :string]] [:vector ?Path]]}
+  [root package-globs]
   (let [root (-> (fs/path root)
                  fs/normalize
-                 fs/absolutize)]
-    (into [root]
-          (comp
-           (filter (fn [path]
-                     (= "deps.edn" (fs/file-name path))))
-           (map fs/parent))
-          (fs/glob root packages-glob))))
+                 fs/absolutize)
+
+        matcher (if (string? package-globs)
+                  (glob->matcher root package-globs)
+                  (globs->matcher root package-globs))
+
+        base-path (-> root fs/absolutize fs/normalize str)
+        results (atom (transient #{root}))
+        past-root? (volatile! nil)
+
+        match (fn match-path [^Path path]
+                (when (and (PathMatcher/.matches matcher path)
+                           (= "deps.edn" (fs/file-name path)))
+                  (swap! results conj! (fs/parent path)))
+                nil)]
+
+    (fs/walk-file-tree
+     base-path
+     {:follow-links false
+      :pre-visit-dir (fn [dir _attrs]
+                       (cond
+                         (and @past-root?
+                              (fs/hidden? dir))
+                         :skip-subtree
+
+                         (not @past-root?)
+                         (do (vreset! past-root? true)
+                             :continue)
+
+                         :else :continue))
+
+      :visit-file (fn [path _attrs]
+                    (when-not (fs/hidden? path)
+                      (match path))
+                    :continue)})
+
+    (persistent! @results)))

packages/kmono-core/src/k16/kmono/core/packages.clj

@@ -142,8 +142,7 @@
   (let [globs (:packages workspace-config)
         globs (if (string? globs) #{globs} globs)
 
-        dirs (mapcat #(core.fs/find-package-directories project-root %)
-                     globs)
+        dirs (core.fs/find-package-directories project-root globs)
 
         packages
         (into {}