diff options
author | Ludovic Courtès <ludo@gnu.org> | 2019-09-24 10:11:38 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2019-09-24 10:11:38 +0200 |
commit | 11da634a6e64afa2904542e2174aa2a185f9ac3a (patch) | |
tree | 5aeb8e6bd01761813650067af492b1c336886e34 /guix/git.scm | |
parent | e5efdbce21a0afcbb3e73cc7b59111ccf62cb532 (diff) | |
parent | 7b3f56f5d7f4d2bb936e1579ed442e7f5b080abd (diff) | |
download | guix-patches-11da634a6e64afa2904542e2174aa2a185f9ac3a.tar guix-patches-11da634a6e64afa2904542e2174aa2a185f9ac3a.tar.gz |
Merge branch 'master' into core-updates
Diffstat (limited to 'guix/git.scm')
-rw-r--r-- | guix/git.scm | 58 |
1 files changed, 57 insertions, 1 deletions
diff --git a/guix/git.scm b/guix/git.scm index de98fed40c..d7dddde3a7 100644 --- a/guix/git.scm +++ b/guix/git.scm @@ -28,6 +28,7 @@ #:use-module (guix utils) #:use-module (guix records) #:use-module (guix gexp) + #:use-module (guix sets) #:use-module (rnrs bytevectors) #:use-module (ice-9 match) #:use-module (srfi srfi-1) @@ -37,8 +38,10 @@ #:export (%repository-cache-directory honor-system-x509-certificates! + with-repository update-cached-checkout latest-repository-commit + commit-difference git-checkout git-checkout? @@ -220,6 +223,21 @@ dynamic extent of EXP." (G_ "Support for submodules is missing; \ please upgrade Guile-Git.~%")))) +(define (reference-available? repository ref) + "Return true if REF, a reference such as '(commit . \"cabba9e\"), is +definitely available in REPOSITORY, false otherwise." + (match ref + (('commit . commit) + (catch 'git-error + (lambda () + (->bool (commit-lookup repository (string->oid commit)))) + (lambda (key error . rest) + (if (= GIT_ENOTFOUND (git-error-code error)) + #f + (apply throw key error rest))))) + (_ + #f))) + (define* (update-cached-checkout url #:key (ref '(branch . "master")) @@ -254,7 +272,8 @@ When RECURSIVE? is true, check out submodules as well, if any." (repository-open cache-directory) (clone* url cache-directory)))) ;; Only fetch remote if it has not been cloned just before. - (when cache-exists? + (when (and cache-exists? + (not (reference-available? repository ref))) (remote-fetch (remote-lookup repository "origin"))) (when recursive? (update-submodules repository #:log-port log-port)) @@ -325,6 +344,43 @@ Log progress and checkout info to LOG-PORT." ;;; +;;; Commit difference. +;;; + +(define (commit-closure commit) + "Return the closure of COMMIT as a set." + (let loop ((commits (list commit)) + (visited (setq))) + (match commits + (() + visited) + ((head . tail) + (if (set-contains? visited head) + (loop tail visited) + (loop (append (commit-parents head) tail) + (set-insert head visited))))))) + +(define (commit-difference new old) + "Return the list of commits between NEW and OLD, where OLD is assumed to be +an ancestor of NEW. + +Essentially, this computes the set difference between the closure of NEW and +that of OLD." + (let loop ((commits (list new)) + (result '()) + (visited (commit-closure old))) + (match commits + (() + (reverse result)) + ((head . tail) + (if (set-contains? visited head) + (loop tail result visited) + (loop (append (commit-parents head) tail) + (cons head result) + (set-insert head visited))))))) + + +;;; ;;; Checkouts. ;;; |