guix build: Extract '--with-input' replacement spec parsing.

* guix/scripts/build.scm (evaluate-replacement-specs): New procedure.
(transform-package-inputs)[not-equal]: Remove.
[replacements]: Define in terms of 'evaluate-replacement-specs'.
This commit is contained in:
Ludovic Courtès 2016-10-17 22:43:49 +02:00
parent 00bfd498f9
commit 5cf01aa53f
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 21 additions and 17 deletions

View File

@ -179,27 +179,31 @@ matching URIs given in SOURCES."
(_
obj)))))
(define (transform-package-inputs replacement-specs)
"Return a procedure that, when passed a package, replaces its direct
dependencies according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of
strings like \"guile=guile@2.1\" meaning that, any direct dependency on a
package called \"guile\" must be replaced with a dependency on a version 2.1
of \"guile\"."
(define (evaluate-replacement-specs specs proc)
"Parse SPECS, a list of strings like \"guile=guile@2.1\", and invoke PROC on
each package pair specified by SPECS. Return the resulting list. Raise an
error if an element of SPECS uses invalid syntax, or if a package it refers to
could not be found."
(define not-equal
(char-set-complement (char-set #\=)))
(define replacements
;; List of name/package pairs.
(map (lambda (spec)
(match (string-tokenize spec not-equal)
((old new)
(cons (specification->package old)
(specification->package new)))
(x
(leave (_ "invalid replacement specification: ~s~%") spec))))
replacement-specs))
(map (lambda (spec)
(match (string-tokenize spec not-equal)
((old new)
(proc (specification->package old)
(specification->package new)))
(x
(leave (_ "invalid replacement specification: ~s~%") spec))))
specs))
(let ((rewrite (package-input-rewriting replacements)))
(define (transform-package-inputs replacement-specs)
"Return a procedure that, when passed a package, replaces its direct
dependencies according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of
strings like \"guile=guile@2.1\" meaning that, any dependency on a package
called \"guile\" must be replaced with a dependency on a version 2.1 of
\"guile\"."
(let* ((replacements (evaluate-replacement-specs replacement-specs cons))
(rewrite (package-input-rewriting replacements)))
(lambda (store obj)
(if (package? obj)
(rewrite obj)