diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2019-03-12 22:12:18 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2019-03-17 22:55:01 +0100 |
| commit | 0c0ff42a243b2da4f1deb52fe3961801008341da (patch) | |
| tree | c19bada34aacdf17d4957ead183d75d083353cc3 | |
| parent | f258d8862852db9779945658b3a3f2b8a2a4c217 (diff) | |
| download | gnu-guix-0c0ff42a243b2da4f1deb52fe3961801008341da.tar gnu-guix-0c0ff42a243b2da4f1deb52fe3961801008341da.tar.gz | |
guix build: Factorize 'package-git-url'.
* guix/scripts/build.scm (package-git-url): New procedure.
(evaluate-git-replacement-specs): Use it.
| -rw-r--r-- | guix/scripts/build.scm | 23 |
1 files changed, 14 insertions, 9 deletions
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 @@ current 'gnutls' package, after which version 3.5.4 is grafted onto them." (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 @@ syntax, or if a package it refers to could not be found." ((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)))) |