Skip to content

Commit

Permalink
Merge pull request #8 from NinjaTrappeur/nin/limit-recursion
Browse files Browse the repository at this point in the history
  • Loading branch information
Ninjatrappeur authored Jul 17, 2022
2 parents 939a4df + 274e116 commit 3a85c41
Show file tree
Hide file tree
Showing 3 changed files with 159 additions and 36 deletions.
12 changes: 12 additions & 0 deletions README.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -86,6 +86,18 @@ All the code fetched using `my-repo-pins` will end up in this root directory. A

For instance, after checking out https://git.savannah.gnu.org/git/emacs/org-mode.git, the source code will live in the my-repo-pins-code-root/git.savannah.gnu.org/git/emacs/org-mode/ local directory

### my-repo-pins-max-depth

Maximum search depth starting from the `my-repo-pins-code-root` directory.

Set this variable to nil if you don't want any limit.

This is a performance stop gap. It'll prevent my repo pins from accidentally walking too deep if it fails to detect a project boundary.

By default, this limit is set to 2 to materialize the `<forge>/<username>` directories that are supposed to contain the projects.

We won't search further once we reach this limit. A warning message is issued to the `*Messages*` buffer to warn the user the limit has been reached.

### my-repo-pins-git-bin

Path pointing to the git binary. By default, it'll look for git in the current `$PATH`.
Expand Down
80 changes: 73 additions & 7 deletions my-repo-pins-tests.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -114,6 +114,36 @@ For reference: test-root-2 looks like this:
(my-repo-pins--tests-init-fake-git-repo (concat temp-dir "example2.tld/user1/proj1"))
(funcall func temp-dir)))))

(defun my-repo-pins--tests-run-on-nested-testroot (func)
"Run the FUNC function on testroot2.
FUNC is called with the directory cotaining test root 2 as parameter.
For reference: test-root-2 looks like this:
test-root-2
├── example1.tld
│ ├── user1
│ │ ├── proj1
│ │ ├── nested
│ │ │ └── repo
│ │ └── nested2
│ │ └── git
│ │ └── repo
│ └── user2
│ └── proj1
└── example2.tld
└── user1
└── proj1"
(my-repo-pins--tests-with-temp-dir
(lambda (temp-dir)
(progn
(my-repo-pins--tests-init-fake-git-repo (concat temp-dir "example1.tld/user1/proj1"))
(my-repo-pins--tests-init-fake-git-repo (concat temp-dir "example1.tld/user1/nested/repo"))
(my-repo-pins--tests-init-fake-git-repo (concat temp-dir "example1.tld/user1/nested2/git/repo"))
(my-repo-pins--tests-init-fake-git-repo (concat temp-dir "example1.tld/user2/proj1"))
(my-repo-pins--tests-init-fake-git-repo (concat temp-dir "example2.tld/user1/proj1"))
(funcall func temp-dir)))))


(defun my-repo-pins--tests-run-on-empty-testroot (func)
"Run the FUNC function on testroot1.
Expand All @@ -134,7 +164,7 @@ For reference: a empty test root looks like this:
"Test the `my-repo-pins--get-code-root-projects with test-root-1 setup."
(let
((results
(my-repo-pins--tests-run-on-testroot-1 (lambda (root) (my-repo-pins--get-code-root-projects root))))
(my-repo-pins--tests-run-on-testroot-1 (lambda (root) (my-repo-pins--get-code-root-projects root 3))))
)
(should (member "example1.tld/user1/proj1" results))
(should (member "example1.tld/user1/proj2" results))
Expand All @@ -151,7 +181,7 @@ For reference: a empty test root looks like this:
(my-repo-pins--tests-run-on-testroot-1
(lambda (root)
(progn (setq r root)
(my-repo-pins--find-git-dirs-recursively root))))))
(my-repo-pins--find-git-dirs-recursively root 3))))))
(should (member (concat r "example1.tld/user1/proj1/") results))
(should (member (concat r "example1.tld/user1/proj2/") results))
(should (member (concat r "example1.tld/user2/proj1/") results))
Expand All @@ -162,13 +192,49 @@ For reference: a empty test root looks like this:
"Test the `my-repo-pins--get-code-root-projects with test-root-2 setup."
(let
((results
(my-repo-pins--tests-run-on-testroot-2 (lambda (root) (my-repo-pins--get-code-root-projects root))))
(my-repo-pins--tests-run-on-testroot-2 (lambda (root) (my-repo-pins--get-code-root-projects root 3))))
)
(should (member "example1.tld/user1/proj1" results))
(should (member "example1.tld/user2/proj1" results))
(should (member "example2.tld/user1/proj1" results))
(should (eq (length results) 3))))

(ert-deftest my-repo-pins--tests-get-code-root-projects-nested-coderoot-max-depth-2 ()
"Test the `my-repo-pins--get-code-root-projects with nested-test-root setup."
(let
((results
(my-repo-pins--tests-run-on-nested-testroot (lambda (root) (my-repo-pins--get-code-root-projects root 2))))
)
(should (member "example1.tld/user1/proj1" results))
(should (member "example1.tld/user2/proj1" results))
(should (member "example2.tld/user1/proj1" results))
(should (eq (length results) 3))))

(ert-deftest my-repo-pins--tests-get-code-root-projects-nested-coderoot-max-depth-3 ()
"Test the `my-repo-pins--get-code-root-projects with nested-test-root setup."
(let
((results
(my-repo-pins--tests-run-on-nested-testroot (lambda (root) (my-repo-pins--get-code-root-projects root 3))))
)
(should (member "example1.tld/user1/proj1" results))
(should (member "example1.tld/user2/proj1" results))
(should (member "example2.tld/user1/proj1" results))
(should (member "example1.tld/user1/nested/repo" results))
(should (not (member "example1.tld/user1/nested2/git/repo" results)))
(should (eq (length results) 4))))

(ert-deftest my-repo-pins--tests-get-code-root-projects-nested-coderoot-max-depth-no-limit ()
"Test the `my-repo-pins--get-code-root-projects with nested-test-root setup."
(let
((results
(my-repo-pins--tests-run-on-nested-testroot (lambda (root) (my-repo-pins--get-code-root-projects root nil)))))
(should (member "example1.tld/user1/proj1" results))
(should (member "example1.tld/user2/proj1" results))
(should (member "example2.tld/user1/proj1" results))
(should (member "example1.tld/user1/nested/repo" results))
(should (member "example1.tld/user1/nested2/git/repo" results))
(should (eq (length results) 5))))

(ert-deftest my-repo-pins--tests-find-git-dirs-recursively-coderoot-2 ()
"Test the `my-repo-pins--get-code-root-projects with test-root-2 setup."
(let*
Expand All @@ -177,7 +243,7 @@ For reference: a empty test root looks like this:
(my-repo-pins--tests-run-on-testroot-2
(lambda (root)
(progn (setq r root)
(my-repo-pins--find-git-dirs-recursively root))))))
(my-repo-pins--find-git-dirs-recursively root 3))))))
(should (member (concat r "example1.tld/user1/proj1/") results))
(should (member (concat r "example1.tld/user2/proj1/") results))
(should (member (concat r "example2.tld/user1/proj1/") results))
Expand All @@ -187,22 +253,22 @@ For reference: a empty test root looks like this:
"Test the `my-repo-pins--get-code-root-projects with a empty coderoot."
(let
((results
(my-repo-pins--tests-run-on-empty-testroot (lambda (root) (my-repo-pins--get-code-root-projects root))))
(my-repo-pins--tests-run-on-empty-testroot (lambda (root) (my-repo-pins--get-code-root-projects root 3))))
)
(should (seq-empty-p results))))

(ert-deftest my-repo-pins--tests-find-git-dirs-recursively-empty-coderoot ()
"Test the `my-repo-pins--get-code-root-projects with a empty coderoot."
(let
((results
(my-repo-pins--tests-run-on-empty-testroot (lambda (root) (my-repo-pins--find-git-dirs-recursively root))))
(my-repo-pins--tests-run-on-empty-testroot (lambda (root) (my-repo-pins--find-git-dirs-recursively root 3))))
)
(should (seq-empty-p results))))

(ert-deftest my-repo-pins--tests-get-code-root-projects-no-coderoot ()
"Test the `my-repo-pins--get-code-root-projects with a non-existing coderoot."
(let
((results (my-repo-pins--get-code-root-projects "/does/not/exist")))
((results (my-repo-pins--get-code-root-projects "/does/not/exist" 3)))
(should (seq-empty-p results))))


Expand Down
103 changes: 74 additions & 29 deletions my-repo-pins.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@
;;; Copyright (C) 2022 Félix Baylac Jacqué
;;; Author: Félix Baylac Jacqué <felix at alternativebit.fr>
;;; Maintainer: Félix Baylac Jacqué <felix at alternativebit.fr>
;;; Version: 0.1
;;; Version: 0.2
;;; Homepage: https://alternativebit.fr/projects/my-repo-pins/
;;; Package-Requires: ((emacs "26.1"))
;;; License:
Expand All @@ -22,7 +22,6 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>
;;
;;; Commentary:
;;
;; Open source developers often have to jump between projects, either
;; to read code, or to craft patches. My Repo Pins reduces the
;; friction so that it becomes trivial to do so.
Expand Down Expand Up @@ -197,6 +196,26 @@ A ongoing/failed lookup will also be represented by an entry in this alist:
(make-mutex "my-repo-pins-ui-mutex")
"Mutex in charge of preventing several fetchers to update the state concurently.")

(defcustom my-repo-pins-max-depth
2
"Maximum search depth starting from the ‘my-repo-pins-code-root’ directory.
Set this variable to nil if you don't want any limit.
This is a performance stop gap. It'll prevent my repo pins from
accidentally walking too deep if it fails to detect a project
boundary.
By default, this limit is set to 2 to materialize the
<forge>/<username> directories that are supposed to contain the
projects.
We won't search further once we reach this limit. A warning message is
issued to the *Messages* buffer to warn the user the limit has been
reached."
:type 'integer
:group 'my-repo-pins-group)

;; Sourcehut Fetcher
(defun my-repo-pins--query-sourcehut-owner-repo (instance-url user-name repo-name callback)
"Query the INSTANCE-URL Sourcehut instance and retrieve some infos about a repo.
Expand Down Expand Up @@ -424,7 +443,7 @@ Errors out if ‘my-repo-pins-code-root’ has not been set yet."
(expand-file-name (file-name-as-directory my-repo-pins-code-root)))


(defun my-repo-pins--find-git-dirs-recursively (dir)
(defun my-repo-pins--find-git-dirs-recursively (dir max-depth)
"Vendored, slightly modified version of ‘directory-files-recursively’.
This library isn't available for Emacs > 25.1. Vendoring it for
Expand All @@ -438,30 +457,52 @@ recursively. Files are returned in \"depth first\" order, and files
from each directory are sorted in alphabetical order. Each file name
appears in the returned list in its absolute form.
By default, the returned list excludes directories, but if
optional argument INCLUDE-DIRECTORIES is non-nil, they are
included."
(let* ((projects nil)
(recur-result nil)
(dir (directory-file-name dir)))
(dolist (file (sort (file-name-all-completions "" dir)
'string<))
(unless (member file '("./" "../"))
(if (directory-name-p file)
;; Don't follow symlinks to other directories.
(let ((full-file (concat dir "/" file)))
(when (not (file-symlink-p full-file))
(if (file-directory-p (concat full-file ".git"))
;; It's a git repo, let's stop here.
(setq projects (nconc projects (list full-file)))
;; It's not a git repo, let's recurse into it.
(setq recur-result
(nconc recur-result
(my-repo-pins--find-git-dirs-recursively full-file)))))))))
(nconc recur-result (nreverse projects))))


(defun my-repo-pins--get-code-root-projects (code-root)
The recursion will halt once MAX-DEPTH is reached. In that case, a
information message will be written to the message buffer.
If MAX-DEPTH is set to nil, do not use any recursion stop gap."
(cl-labels
((recurse-in-dir
(dir depth)
(let* ((projects nil)
(recur-result nil)
(dir (directory-file-name dir)))
(dolist (file (sort (file-name-all-completions "" dir)
'string<))
(unless (member file '("./" "../"))
(if (directory-name-p file)
(let ((full-file (concat dir "/" file)))
;; Don't follow symlinks to other directories.
(when (not (file-symlink-p full-file))
(if (file-directory-p (concat full-file ".git"))
;; It's a git repo, let's stop here.
(setq projects (nconc projects (list full-file)))
;; It's not a git repo, let's recurse into it.
(if max-depth
;; if we didn't reach the max depth yet, recurse.
(if (not (> (+ depth 1) max-depth))
(setq recur-result
(nconc recur-result
(recurse-in-dir full-file (+ depth 1))))
;; we reached the max depth limit, issue a info message
(message
(concat
"my-repo-pins: max depth reached for "
"%s, we won't search for projects in that directory. "
"We might miss some projects. "
"Increase the my-repo-pins-max-depth variable value if "
"you want to look for projects in that directory.")
full-file))
;; There's no max depth, let's recurse.
(setq recur-result
(nconc recur-result
(recurse-in-dir full-file nil))))))))))
(nconc recur-result (nreverse projects)))))
(if max-depth
(recurse-in-dir dir 0)
(recurse-in-dir dir nil))))

(defun my-repo-pins--get-code-root-projects (code-root max-depth)
"Retrieve the projects contained in the CODE-ROOT directory.
We're going to make some hard assumptions about how the
‘my-repo-pins-code-root’ directory should look like. First of all, if
Expand All @@ -471,6 +512,10 @@ considered as a project root.
It means that after encountering a git repository, we won't recurse
any further.
We also won't recurse for directories nested deeper than MAX-DEPTH.
If MAX-DEPTH is set to -1, do not use any recursion stop gap.
If the directory pointed by ‘my-repo-pins-code-root’ does not exists
yet, returns an empty list."
(if (not (file-directory-p code-root))
Expand All @@ -480,7 +525,7 @@ yet, returns an empty list."
(lambda (path)
(let ((path-without-prefix (string-remove-prefix code-root path)))
(substring path-without-prefix 0 (1- (length path-without-prefix))))))
(projects-absolute-path (my-repo-pins--find-git-dirs-recursively code-root))
(projects-absolute-path (my-repo-pins--find-git-dirs-recursively code-root max-depth))
(projects-relative-to-code-root
(mapcar remove-code-root-prefix-and-trailing-slash projects-absolute-path)))
projects-relative-to-code-root)))
Expand Down Expand Up @@ -774,7 +819,7 @@ available forge sources."
(let ((user-query
(my-repo-pins--completing-read-or-custom
"Jump to project: "
(my-repo-pins--get-code-root-projects (my-repo-pins--safe-get-code-root)))))
(my-repo-pins--get-code-root-projects (my-repo-pins--safe-get-code-root) my-repo-pins-max-depth))))
(cond
((equal (car user-query) 'in-collection)
(let ((selected-project-absolute-path (concat (my-repo-pins--safe-get-code-root) (cdr user-query))))
Expand Down

0 comments on commit 3a85c41

Please sign in to comment.