diff options
author | Ludovic Courtès <ludovic.courtes@inria.fr> | 2018-11-30 16:41:22 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2018-11-30 17:03:04 +0100 |
commit | a3d77c51bc8f641c12989e18dc5e03add776f87e (patch) | |
tree | a3f5755b17a943a66c9bc24f7a7909fd2fd5d571 /guix/git.scm | |
parent | b18f7234aac9eb42097c1b4cda7efe0be5aab132 (diff) | |
download | gnu-guix-a3d77c51bc8f641c12989e18dc5e03add776f87e.tar gnu-guix-a3d77c51bc8f641c12989e18dc5e03add776f87e.tar.gz |
git: Nicely report '--with-commit' errors.
* guix/git.scm (latest-repository-commit*): Rewrite to catch
'git-error'.
* po/guix/POTFILES.in: Add guix/git.scm.
* tests/guix-build-branch.sh: Test --with-commit errors.
Diffstat (limited to 'guix/git.scm')
-rw-r--r-- | guix/git.scm | 28 |
1 files changed, 26 insertions, 2 deletions
diff --git a/guix/git.scm b/guix/git.scm index f5593ab57c..0666f0c0a9 100644 --- a/guix/git.scm +++ b/guix/git.scm @@ -20,6 +20,7 @@ (define-module (guix git) #:use-module (git) #:use-module (git object) + #:use-module (guix i18n) #:use-module (guix base32) #:use-module (gcrypt hash) #:use-module ((guix build utils) #:select (mkdir-p)) @@ -206,8 +207,31 @@ Log progress and checkout info to LOG-PORT." (branch git-checkout-branch (default "master")) (commit git-checkout-commit (default #f))) -(define latest-repository-commit* - (store-lift latest-repository-commit)) +(define* (latest-repository-commit* url #:key ref log-port) + ;; Monadic variant of 'latest-repository-commit'. + (lambda (store) + ;; The caller--e.g., (guix scripts build)--may not handle 'git-error' so + ;; translate it into '&message' conditions that we know will be properly + ;; handled. + (catch 'git-error + (lambda () + (values (latest-repository-commit store url + #:ref ref #:log-port log-port) + store)) + (lambda (key error . _) + (raise (condition + (&message + (message + (match ref + (('commit . commit) + (format #f (G_ "cannot fetch commit ~a from ~a: ~a") + commit url (git-error-message error))) + (('branch . branch) + (format #f (G_ "cannot fetch branch '~a' from ~a: ~a") + branch url (git-error-message error))) + (_ + (format #f (G_ "Git failure while fetching ~a: ~a") + url (git-error-message error)))))))))))) (define-gexp-compiler (git-checkout-compiler (checkout <git-checkout>) system target) |