02/03: git: Increase modularity and expose 'update-cached-checkout'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 9188198692e3899ed9179af73cf721c19bb05db4
Author: Ludovic Courtès <address@hidden>
Date:   Mon Apr 2 23:11:07 2018 +0200

    git: Increase modularity and expose 'update-cached-checkout'.
    
    * guix/git.scm (repository->head-sha1, copy-to-store): Remove.
    (switch-to-ref): Return the OID of OBJ.
    (update-cached-checkout): New procedure, with code from
    'latest-repository-commit'.
    (latest-repository-commit): Use it.
---
 guix/git.scm | 87 +++++++++++++++++++++++++++++++++---------------------------
 1 file changed, 48 insertions(+), 39 deletions(-)

diff --git a/guix/git.scm b/guix/git.scm
index 103749d..9e89cc0 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -28,9 +28,11 @@
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:export (%repository-cache-directory
+            update-cached-checkout
             latest-repository-commit))
 
 (define %repository-cache-directory
@@ -68,11 +70,6 @@ make sure no empty directory is left behind."
     (lambda _
       (false-if-exception (rmdir directory)))))
 
-(define (repository->head-sha1 repo)
-  "Return the sha1 of the HEAD commit in REPOSITORY as a string."
-  (let ((oid (reference-target (repository-head repo))))
-    (oid->string (commit-id (commit-lookup repo oid)))))
-
 (define (url+commit->name url sha1)
   "Return the string \"<REPO-NAME>-<SHA1:7>\" where REPO-NAME is the name of
 the git repository, extracted from URL and SHA1:7 the seven first digits
@@ -82,21 +79,9 @@ of SHA1 string."
     (last (string-split url #\/)) ".git" "")
    "-" (string-take sha1 7)))
 
-(define* (copy-to-store store cache-directory #:key url repository)
-  "Copy CACHE-DIRECTORY recursively to STORE.  URL and REPOSITORY are used to
-create the store directory name."
-  (define (dot-git? file stat)
-    (and (string=? (basename file) ".git")
-         (eq? 'directory (stat:type stat))))
-
-  (let* ((commit (repository->head-sha1 repository))
-         (name   (url+commit->name url commit)))
-    (values (add-to-store store name #t "sha256" cache-directory
-                          #:select? (negate dot-git?))
-            commit)))
-
 (define (switch-to-ref repository ref)
-  "Switch to REPOSITORY's branch, commit or tag specified by REF."
+  "Switch to REPOSITORY's branch, commit or tag specified by REF.  Return the
+OID (roughly the commit hash) corresponding to REF."
   (define obj
     (match ref
       (('branch . branch)
@@ -122,7 +107,38 @@ create the store directory name."
                                        (string-append "refs/tags/" tag))))
          (object-lookup repository oid)))))
 
-  (reset repository obj RESET_HARD))
+  (reset repository obj RESET_HARD)
+  (object-id obj))
+
+(define* (update-cached-checkout url
+                                 #:key
+                                 (ref '(branch . "origin/master"))
+                                 (cache-directory
+                                  (%repository-cache-directory)))
+  "Update the cached checkout of URL to REF in CACHE-DIRECTORY.  Return two
+values: the cache directory name, and the SHA1 commit (a string) corresponding
+to REF.
+
+REF is pair whose key is [branch | commit | tag] and value the associated
+data, respectively [<branch name> | <sha1> | <tag name>]."
+  (with-libgit2
+   (let* ((cache-dir     (url-cache-directory url cache-directory))
+          (cache-exists? (openable-repository? cache-dir))
+          (repository    (if cache-exists?
+                             (repository-open cache-dir)
+                             (clone* url cache-dir))))
+     ;; Only fetch remote if it has not been cloned just before.
+     (when cache-exists?
+       (remote-fetch (remote-lookup repository "origin")))
+     (let ((oid (switch-to-ref repository ref)))
+
+       ;; Reclaim file descriptors and memory mappings associated with
+       ;; REPOSITORY as soon as possible.
+       (when (module-defined? (resolve-interface '(git repository))
+                              'repository-close!)
+         (repository-close! repository))
+
+       (values cache-dir (oid->string oid))))))
 
 (define* (latest-repository-commit store url
                                    #:key
@@ -137,23 +153,16 @@ data, respectively [<branch name> | <sha1> | <tag name>].
 
 Git repositories are kept in the cache directory specified by
 %repository-cache-directory parameter."
-  (with-libgit2
-   (let* ((cache-dir     (url-cache-directory url cache-directory))
-          (cache-exists? (openable-repository? cache-dir))
-          (repository    (if cache-exists?
-                             (repository-open cache-dir)
-                             (clone* url cache-dir))))
-     ;; Only fetch remote if it has not been cloned just before.
-     (when cache-exists?
-       (remote-fetch (remote-lookup repository "origin")))
-     (switch-to-ref repository ref)
-
-     ;; Reclaim file descriptors and memory mappings associated with
-     ;; REPOSITORY as soon as possible.
-     (when (module-defined? (resolve-interface '(git repository))
-                            'repository-close!)
-       (repository-close! repository))
+  (define (dot-git? file stat)
+    (and (string=? (basename file) ".git")
+         (eq? 'directory (stat:type stat))))
 
-     (copy-to-store store cache-dir
-                    #:url url
-                    #:repository repository))))
+  (let*-values (((checkout commit)
+                 (update-cached-checkout url
+                                         #:ref ref
+                                         #:cache-directory cache-directory))
+                ((name)
+                 (url+commit->name url commit)))
+    (values (add-to-store store name #t "sha256" checkout
+                          #:select? (negate dot-git?))
+            commit)))