[PATCH] guix hash: -g hashes a git repository

[Andy Wingo]

* guix/scripts/hash.scm (show-help, %options): Add -g option.
(guix-hash): Support hashing of Git URLs.
* doc/guix.texi (Invoking guix hash): Document guix hash --git.
---
 doc/guix.texi         | 18 ++++++++++++++++++
 guix/scripts/hash.scm | 37 +++++++++++++++++++++++++++++--------
 2 files changed, 47 insertions(+), 8 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 8da82b4d8..7d35d9f45 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -5281,6 +5281,24 @@ $ git clone http://example.org/foo.git
 $ cd foo
 $ guix hash -rx .
 @end example
+
+Hashing a git repository is so common that it has its own alias:
+
address@hidden --git
address@hidden -g
+Clones the git repository at @var{file} into a temporary directory and
+recursively hashes it, excluding the @file{.git} subdirectory.
+
+For example:
address@hidden
+$ git clone http://example.org/foo.git
+$ guix hash -g foo
address@hidden example
+
+Or even:
address@hidden
+$ guix hash -g http://example.org/foo.git
address@hidden example
 @end table
 
 @node Invoking guix import
diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm
index a048b5346..104a6a864 100644
--- a/guix/scripts/hash.scm
+++ b/guix/scripts/hash.scm
@@ -25,6 +25,7 @@
   #:use-module (guix ui)
   #:use-module (guix scripts)
   #:use-module (guix base16)
+  #:use-module (guix utils)
   #:use-module (ice-9 binary-ports)
   #:use-module (rnrs files)
   #:use-module (ice-9 match)
@@ -52,6 +53,9 @@ and 'hexadecimal' can be used as well).\n"))
   (format #t (_ "
   -x, --exclude-vcs      exclude version control directories"))
   (format #t (_ "
+  -g, --git              clone the git repository at FILE and hash it
+                         (implies -r)"))
+  (format #t (_ "
   -f, --format=FMT       write the hash in the given format"))
   (format #t (_ "
   -r, --recursive        compute the hash on FILE recursively"))
@@ -68,6 +72,10 @@ and 'hexadecimal' can be used as well).\n"))
   (list (option '(#\x "exclude-vcs") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'exclude-vcs? #t result)))
+        (option '(#\g "git") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'git? #t
+                              (alist-cons 'exclude-vcs? #t result))))
         (option '(#\f "format") #t #f
                 (lambda (opt name arg result)
                   (define fmt-proc
@@ -133,18 +141,31 @@ and 'hexadecimal' can be used as well).\n"))
                       (negate vcs-file?)
                       (const #t))))
 
+    (define (recursive-hash file)
+      (let-values (((port get-hash) (open-sha256-port)))
+        (write-file file port #:select? select?)
+        (force-output port)
+        (get-hash)))
+
     (define (file-hash file)
       ;; Compute the hash of FILE.
       ;; Catch and gracefully report possible '&nar-error' conditions.
       (with-error-handling
-        (if (assoc-ref opts 'recursive?)
-            (let-values (((port get-hash) (open-sha256-port)))
-              (write-file file port #:select? select?)
-              (force-output port)
-              (get-hash))
-            (match file
-              ("-" (port-sha256 (current-input-port)))
-              (_   (call-with-input-file file port-sha256))))))
+        (cond
+         ((assoc-ref opts 'git?)
+          (call-with-temporary-directory
+           (lambda (dir)
+             (let ((checkout (in-vicinity dir "git-checkout")))
+               (unless (zero? (system* "git" "clone" "--" file checkout))
+                 (leave (_ "git clone failed~%")))
+               (pk "git" "clone" file checkout)
+               (recursive-hash checkout)))))
+         ((assoc-ref opts 'recursive?)
+          (recursive-hash file))
+         (else
+          (match file
+            ("-" (port-sha256 (current-input-port)))
+            (_   (call-with-input-file file port-sha256)))))))
 
     (match args
       ((file)
-- 
2.12.2