DRAFT find-up

src/babashka/fs.cljc

@@ -1272,3 +1272,61 @@
   ([app]
    (cond-> (xdg-home-for :state)
      (seq app) (path app))))
+
+(defn find-up
+  "Starting in folder `start` and traversing up, either searches for existance of a file or checks if the folder passes the provided predicate.
+  Yields (normalized) path of file/folder found, or `nil` when not found.
+
+  Raises `IllegalArgumentException` when `start` does not exist.
+
+  Examples:
+
+    ``` clojure
+  (fs/find-up \"README.md\") ;; search for README.md starting from CWD.
+
+  ;; find .gitignore starting from parent folder
+  (fs/find-up \".gitignore\" (fs/parent (fs/cwd)))
+  (fs/find-up \".gitignore\" \"..\")
+  (fs/find-up \"../.gitignore\")
+
+  ;; find the git work tree using a predicate
+  (let [git-work-tree? #(fs/exists? (fs/path % \".git\"))]
+    (fs/find-up git-work-tree?))
+
+  ;; find root of Clojure project we're in (if any).
+  (let [file-finder (fn [file]
+                      #(-> % (fs/path file) fs/exists?))
+        clj-project? (some-fn (file-finder \"project.clj\") (file-finder \"deps.edn\"))]
+    (fs/find-up clj-project?))
+
+  ;; `start` may be a file
+  (fs/find-up \".gitignore\" \"~/.gitignore\") ;; => /full/path/to/home/.gitignore
+
+  ;; find all .gitignore files in CWD and ancestors
+  (let [to-find \".gitignore\"]
+    (take-while some?
+      (iterate #(fs/find-up (fs/parent to-find) %) (find-up to-find))))
+  ```
+  "
+  ([file-or-pred] (find-up file-or-pred (cwd)))
+  ([file-or-pred start]
+   (when (and file-or-pred start)
+     (letfn [(below-root? [file start-folder]
+               (when-not (fn? file)
+                 (let [required-start-folder-depth (count (filter #(= ".." %) (map str (normalize file))))
+                       start-folder-depth          (count (seq start-folder))]
+                   (< start-folder-depth required-start-folder-depth))))]
+       (let [start-folder        (let [expanded (canonicalize (expand-home (path start)))]
+                                   (cond-> expanded
+                                     (regular-file? expanded) parent))
+             start-and-ancestors (take-while some? (iterate parent (normalize start-folder)))
+             folder-map-fn       (if (fn? file-or-pred) identity #(path % file-or-pred))
+             folder-filter-fn    (if (fn? file-or-pred) file-or-pred exists?)]
+         (when (not (exists? start-folder))
+           (throw (IllegalArgumentException. (str "Folder does not exist: " start-folder))))
+         (when-not (below-root? file-or-pred start-folder)
+           (->> start-and-ancestors
+                (map folder-map-fn)
+                (filter folder-filter-fn)
+                first
+                (#(some-> % normalize)))))))))

test/babashka/fs_test.clj

@@ -736,3 +736,74 @@
                 fs/delete-on-exit)
           file-in-dir (fs/create-temp-file {:dir dir})]
       (is (= (str (fs/owner dir)) (str (fs/owner file-in-dir)))))))
+
+
+(deftest find-up-test
+  (let [cwd-name  (fs/file-name (fs/cwd))
+        cwd-depth (count (seq (fs/cwd)))]
+    (testing "searching up from cwd"
+      (is (nil? (fs/find-up nil))
+          "it should accept nil as this allows for traversing up via parent of previous result")
+      (is (= (fs/path (fs/cwd) "README.md")
+             (fs/find-up "README.md"))
+          "it should find an existing file in CWD")
+      (is (= (fs/path (fs/cwd) "README.md")
+             (fs/find-up (fs/path "README.md")))
+          "it should accept a path")
+      (is (= (fs/path (fs/cwd) "src" "babashka" "fs.cljc")
+             (fs/find-up (fs/path "src" "babashka" "fs.cljc")))
+          "it should accept a deeper path to find")
+      (is (= (fs/cwd)
+             (fs/normalize (fs/find-up (str ".." fs/file-separator cwd-name))))
+          "it should find cwd with a relative path")
+      (let [dotdots-til-root (str/join fs/file-separator (take cwd-depth (repeat "..")))]
+        (is (= (fs/cwd)
+               (fs/find-up (str dotdots-til-root (fs/cwd))))
+            "it should accept a relative path")
+        (is (nil? (fs/find-up (str dotdots-til-root
+                                   fs/file-separator ".." ;; one below
+                                   (fs/cwd))))
+            "it should yield nil when a relative `file` goes below root")))
+
+    (testing "providing a start-folder"
+      (is (nil? (fs/find-up ".gitignore" nil))
+          "it should accept nil as `start` and return nil")
+      (is (= (fs/path (fs/cwd) ".gitignore")
+             (fs/find-up ".gitignore" "."))
+          "it should accept \".\" as `start`")
+      (is (= (fs/path (fs/cwd))
+             (fs/find-up cwd-name ".."))
+          "it should find cwd starting at \"..\"")
+      (let [home-folder-depth     (count (seq (fs/home)))
+            tilde-dotdots-project (str "~" fs/file-separator
+                                       (str/join fs/file-separator (take home-folder-depth (repeat "..")))
+                                       (fs/cwd))]
+        (is (= (fs/path (fs/cwd) ".gitignore")
+               (fs/find-up ".gitignore" tilde-dotdots-project))
+            "it accepts a string starting with ~ as `start`"))
+      (let [start-path          (fs/create-dirs (fs/path (temp-dir) "find-up-test" "start"))
+            to-find             (fs/create-file (fs/path (fs/parent start-path) "in-parent"))
+            tilde-dotdots-start (let [depth            (->> (fs/home) seq count)
+                                      dotdots-til-root (str/join fs/file-separator
+                                                                 (take depth (repeat "..")))]
+                                  (str "~" fs/file-separator
+                                       dotdots-til-root
+                                       start-path))]
+        (is (= (fs/canonicalize to-find)
+               (fs/find-up "in-parent" start-path))
+            "it should find files in a parent")
+        (is (= (fs/canonicalize to-find)
+               (fs/find-up "in-parent" tilde-dotdots-start))
+            "it should accept a string containing ~ as `start`")
+        (is (thrown-with-msg? IllegalArgumentException #"Folder does not exist"
+                              (fs/find-up "in-parent" (fs/path start-path "bogus")))
+            "should throw an exception when `start` does not exist")
+        (testing "`start` being a file"
+          (is (= (fs/canonicalize to-find)
+                 (fs/find-up "in-parent" (fs/create-file (fs/path start-path "in-start"))))
+              "it should accept `start` being a file"))))
+
+    (testing "passing a predicate"
+      (is (= (fs/cwd)
+             (let [git-working-tree? #(-> % (fs/path ".git") fs/exists?)]
+               (fs/find-up git-working-tree?)))))))