From 0c0ff42a243b2da4f1deb52fe3961801008341da Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 12 Mar 2019 22:12:18 +0100 Subject: guix build: Factorize 'package-git-url'. * guix/scripts/build.scm (package-git-url): New procedure. (evaluate-git-replacement-specs): Use it. --- guix/scripts/build.scm | 23 ++++++++++++++--------- 1 file changed, 14 insertions(+), 9 deletions(-) (limited to 'guix/scripts/build.scm') diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 5883dbfb44..7b24cc8eb1 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -275,6 +275,19 @@ (define (replacement-pair old new) (define %not-equal (char-set-complement (char-set #\=))) +(define (package-git-url package) + "Return the URL of the Git repository for package, or raise an error if +the source of PACKAGE is not fetched from a Git repository." + (let ((source (package-source package))) + (cond ((and (origin? source) + (git-reference? (origin-uri source))) + (git-reference-url (origin-uri source))) + ((git-checkout? source) + (git-checkout-url source)) + (else + (leave (G_ "the source of ~a is not a Git reference~%") + (package-full-name package)))))) + (define (evaluate-git-replacement-specs specs proc) "Parse SPECS, a list of strings like \"guile=stable-2.2\", and return a list of package pairs, where (PROC PACKAGE URL BRANCH-OR-COMMIT) returns the @@ -285,15 +298,7 @@ (define (evaluate-git-replacement-specs specs proc) ((name branch-or-commit) (let* ((old (specification->package name)) (source (package-source old)) - (url (cond ((and (origin? source) - (git-reference? (origin-uri source))) - (git-reference-url (origin-uri source))) - ((git-checkout? source) - (git-checkout-url source)) - (else - (leave (G_ "the source of ~a is not a Git \ -reference~%") - (package-full-name old)))))) + (url (package-git-url old))) (cons old (proc old url branch-or-commit)))) (x (leave (G_ "invalid replacement specification: ~s~%") spec)))) -- cgit v1.2.3