From 08b1a44d8b36fcc8d0021fe9e1d42195b659a9c2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?F=C3=A9lix=20Baylac-Jacqu=C3=A9?= Date: Wed, 4 May 2022 20:07:00 +0200 Subject: [PATCH] Implement h--filepath-from-clone-url. This function is meant to find where we should checkout a new git repo in the coderoot. --- h-tests.el | 13 +++++++++++++ h.el | 19 +++++++++++++++++++ 2 files changed, 32 insertions(+) diff --git a/h-tests.el b/h-tests.el index 2f3ead1..726da72 100644 --- a/h-tests.el +++ b/h-tests.el @@ -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 diff --git a/h.el b/h.el index f104343..b66c545 100644 --- a/h.el +++ b/h.el @@ -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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;