summaryrefslogtreecommitdiff
path: root/guix/grafts.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-01-24 17:48:24 +0100
committerLudovic Courtès <ludo@gnu.org>2017-01-24 23:09:06 +0100
commitfd7d1235f1d2e053bbc20d555bd9eed889845ca2 (patch)
tree28be1f3117ee3db9f047aa2ac4f0bfced1f02a7e /guix/grafts.scm
parent0769cea6970444dd5f5db75f9863ec6ff428e7cb (diff)
grafts: Shallow grafting can be performed on a subset of the outputs.
* guix/grafts.scm (graft-derivation/shallow): Add #:outputs parameter. [outputs]: Rename to... [output-pairs]: ... this. Adjust 'build-expression->derivation' call accordingly.
Diffstat (limited to 'guix/grafts.scm')
-rw-r--r--guix/grafts.scm27
1 files changed, 13 insertions, 14 deletions
diff --git a/guix/grafts.scm b/guix/grafts.scm
index e14a40f8d1..e44fc0544f 100644
--- a/guix/grafts.scm
+++ b/guix/grafts.scm
@@ -78,11 +78,12 @@
(define* (graft-derivation/shallow store drv grafts
#:key
(name (derivation-name drv))
+ (outputs (derivation-output-names drv))
(guile (%guile-for-build))
(system (%current-system)))
- "Return a derivation called NAME, based on DRV but with all the GRAFTS
-applied. This procedure performs \"shallow\" grafting in that GRAFTS are not
-recursively applied to dependencies of DRV."
+ "Return a derivation called NAME, which applies GRAFTS to the specified
+OUTPUTS of DRV. This procedure performs \"shallow\" grafting in that GRAFTS
+are not recursively applied to dependencies of DRV."
;; XXX: Someday rewrite using gexps.
(define mapping
;; List of store item pairs.
@@ -96,14 +97,12 @@ recursively applied to dependencies of DRV."
target))))
grafts))
- (define outputs
- (map (match-lambda
- ((name . output)
- (cons name (derivation-output-path output))))
- (derivation-outputs drv)))
-
- (define output-names
- (derivation-output-names drv))
+ (define output-pairs
+ (map (lambda (output)
+ (cons output
+ (derivation-output-path
+ (assoc-ref (derivation-outputs drv) output))))
+ outputs))
(define build
`(begin
@@ -111,7 +110,7 @@ recursively applied to dependencies of DRV."
(guix build utils)
(ice-9 match))
- (let* ((old-outputs ',outputs)
+ (let* ((old-outputs ',output-pairs)
(mapping (append ',mapping
(map (match-lambda
((name . file)
@@ -143,10 +142,10 @@ recursively applied to dependencies of DRV."
(guix build utils))
#:inputs `(,@(map (lambda (out)
`("x" ,drv ,out))
- output-names)
+ outputs)
,@(append (map add-label sources)
(map add-label targets)))
- #:outputs output-names
+ #:outputs outputs
#:local-build? #t)))))
(define (item->deriver store item)
"Return two values: the derivation that led to ITEM (a store item), and the