aboutsummaryrefslogtreecommitdiff
path: root/guix/git.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludovic.courtes@inria.fr>2018-11-30 16:41:22 +0100
committerLudovic Courtès <ludo@gnu.org>2018-11-30 17:03:04 +0100
commita3d77c51bc8f641c12989e18dc5e03add776f87e (patch)
treea3f5755b17a943a66c9bc24f7a7909fd2fd5d571 /guix/git.scm
parentb18f7234aac9eb42097c1b4cda7efe0be5aab132 (diff)
downloadgnu-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.scm28
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)