mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-01-19 14:07:01 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

grafts: Shallow grafting can be performed on a subset of the outputs.

Browse source 
* guix/grafts.scm (graft-derivation/shallow): Add #:outputs parameter.
[outputs]: Rename to...
[output-pairs]: ... this.  Adjust 'build-expression->derivation' call
accordingly.
This commit is contained in:
Ludovic Courtès 2017-01-24 17:48:24 +01:00
parent 0769cea697
commit fd7d1235f1
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 13 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
guix/grafts.scm
View file

@ -78,11 +78,12 @@ (define (graft-origin-file-name graft)
(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 @@ (define mapping
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 @@ (define build
(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 @@ (define add-label
(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