From 477ee01afb090c00451fdbb05a83d77b4ed92cae Mon Sep 17 00:00:00 2001 From: Gert Goet Date: Wed, 27 Sep 2023 10:26:35 +0200 Subject: [PATCH] DRAFT find-up --- src/babashka/fs.cljc | 58 ++++++++++++++++++++++++++++++++ test/babashka/fs_test.clj | 71 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 129 insertions(+) diff --git a/src/babashka/fs.cljc b/src/babashka/fs.cljc index 718c098..81f97bc 100644 --- a/src/babashka/fs.cljc +++ b/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))))))))) diff --git a/test/babashka/fs_test.clj b/test/babashka/fs_test.clj index 7105d19..f731e15 100644 --- a/test/babashka/fs_test.clj +++ b/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?)))))))