kreyren/guix-kreyren
1
0
Fork 0
Code Issues 1 Pull Requests 1 Releases Activity

guix build: Factorize 'package-git-url'.

Browse Source 
* guix/scripts/build.scm (package-git-url): New procedure.
(evaluate-git-replacement-specs): Use it.
This commit is contained in:
Ludovic Courtès 2019-03-12 22:12:18 +01:00
parent f258d88628
commit 0c0ff42a24
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 14 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
guix/scripts/build.scm
View File

@ -275,6 +275,19 @@ current 'gnutls' package, after which version 3.5.4 is grafted onto them."
(define %not-equal (define %not-equal
(char-set-complement (char-set #\=))) (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) (define (evaluate-git-replacement-specs specs proc)
"Parse SPECS, a list of strings like \"guile=stable-2.2\", and return a list "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 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) ((name branch-or-commit)
(let* ((old (specification->package name)) (let* ((old (specification->package name))
(source (package-source old)) (source (package-source old))
(url (cond ((and (origin? source) (url (package-git-url old)))
(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))))))
(cons old (proc old url branch-or-commit)))) (cons old (proc old url branch-or-commit))))
(x (x
(leave (G_ "invalid replacement specification: ~s~%") spec)))) (leave (G_ "invalid replacement specification: ~s~%") spec))))