Implement h--filepath-from-clone-url.

This function is meant to find where we should checkout a new git repo
in the coderoot.
This commit is contained in:
Félix Baylac-Jacqué 2022-05-04 20:07:00 +02:00
parent db74a5794a
commit 08b1a44d8b
No known key found for this signature in database
GPG key ID: EFD315F31848DBA4
2 changed files with 32 additions and 0 deletions

View file

@ -226,5 +226,18 @@ For reference: a empty test root looks like this:
(should (equal (h--parse-repo-identifier "Ninjatrappeur/h.el") 'owner-repo))
(should (equal (h--parse-repo-identifier "h.el") 'repo)))
(ert-deftest h--test-filepath-from-clone-url ()
"Test h--filepath-from-clone-url."
;; HTTP/HTTPS
(should (equal (h--filepath-from-clone-url "http://github.com/NinjaTrappeur/h.el.git") "github.com/NinjaTrappeur/h.el"))
(should (equal (h--filepath-from-clone-url "http://github.com/NinjaTrappeur/h.el") "github.com/NinjaTrappeur/h.el"))
(should (equal (h--filepath-from-clone-url "https://github.com/NinjaTrappeur/h.el.git") "github.com/NinjaTrappeur/h.el"))
(should (equal (h--filepath-from-clone-url "https://github.com/NinjaTrappeur/h.el") "github.com/NinjaTrappeur/h.el"))
;; SSH
(should (equal (h--filepath-from-clone-url "ssh://git@github.com:NinjaTrappeur/h.el.git") "github.com/NinjaTrappeur/h.el"))
(should (equal (h--filepath-from-clone-url "ssh://git@github.com:NinjaTrappeur/h.el") "github.com/NinjaTrappeur/h.el"))
(should (equal (h--filepath-from-clone-url "git@github.com:NinjaTrappeur/h.el.git") "github.com/NinjaTrappeur/h.el"))
(should (equal (h--filepath-from-clone-url "git@github.com:NinjaTrappeur/h.el") "github.com/NinjaTrappeur/h.el")))
(provide 'h-tests)
;;; h-tests.el ends here

19
h.el
View file

@ -186,6 +186,25 @@ A valid REPO-STR is in one of the 4 following formats:
((string-match "^.*/.*$" repo-str) 'owner-repo)
(t 'repo)))
(defun h--filepath-from-clone-url (clone-url)
"Return the relative path relative to the coderoot for CLONE-URL.
CLONE-STR being the git clone URL we want to find the local path for."
(let*
((is-http (string-match-p "^https?://.*$" clone-url))
(is-ssh (string-match-p "^\\(ssh://\\)?.*@.*:.*$" clone-url)))
(cond (is-http
(string-remove-suffix
".git"
(cadr(split-string clone-url "//"))))
(is-ssh
(let*
((url-without-user (cadr(split-string clone-url "@")))
(colon-split (split-string url-without-user ":"))
(fqdn (car colon-split))
(repo-url (string-remove-suffix ".git" (cadr colon-split))))
(format "%s/%s" fqdn repo-url))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Internal: code-root management functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;