From a3d77c51bc8f641c12989e18dc5e03add776f87e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludovic.courtes@inria.fr>
Date: Fri, 30 Nov 2018 16:41:22 +0100
Subject: [PATCH] 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.
---
 guix/git.scm               | 28 ++++++++++++++++++++++++++--
 po/guix/POTFILES.in        |  1 +
 tests/guix-build-branch.sh |  3 +++
 3 files changed, 30 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 @@ (define-record-type* <git-checkout>
   (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)
diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in
index 74c223b283..e0da801587 100644
--- a/po/guix/POTFILES.in
+++ b/po/guix/POTFILES.in
@@ -43,4 +43,5 @@ guix/http-client.scm
 guix/nar.scm
 guix/channels.scm
 guix/profiles.scm
+guix/git.scm
 nix/nix-daemon/guix-daemon.cc
diff --git a/tests/guix-build-branch.sh b/tests/guix-build-branch.sh
index 89c1a3cce0..e64782c831 100644
--- a/tests/guix-build-branch.sh
+++ b/tests/guix-build-branch.sh
@@ -51,3 +51,6 @@ v0_1_0_drv="`guix build guix --with-commit=guile-gcrypt=9e3eacdec1d -d`"
 guix gc -R "$v0_1_0_drv" | grep guile-gcrypt-git.9e3eacd
 test "$v0_1_0_drv" != "$latest_drv"
 test "$v0_1_0_drv" != "$orig_drv"
+
+if guix build guix --with-commit=guile-gcrypt=000 -d
+then false; else true; fi