diff mbox series

[bug#34838,3/6] guix build: Factorize 'package-git-url'.

Message ID 20190313104751.20758-3-ludo@gnu.org
State Accepted
Commit 0c0ff42a243b2da4f1deb52fe3961801008341da
Headers show
Series [bug#34838,1/6] guix build: Add '--with-git-url'. | expand

Checks

Context Check Description
cbaines/applying patch success Successfully applied
cbaines/applying patch success Successfully applied
cbaines/applying patch success Successfully applied
cbaines/applying patch success Successfully applied
cbaines/applying patch success Successfully applied

Commit Message

Ludovic Courtès March 13, 2019, 10:47 a.m. UTC 
* 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(-)
diff mbox series

Patch

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))))