mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-01-31 23:06:59 +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 (define* (graft-derivation/shallow store drv grafts
#:key #:key
(name (derivation-name drv)) (name (derivation-name drv))
(outputs (derivation-output-names drv))
(guile (%guile-for-build)) (guile (%guile-for-build))
(system (%current-system))) (system (%current-system)))
"Return a derivation called NAME, based on DRV but with all the GRAFTS "Return a derivation called NAME, which applies GRAFTS to the specified
applied. This procedure performs \"shallow\" grafting in that GRAFTS are not OUTPUTS of DRV. This procedure performs \"shallow\" grafting in that GRAFTS
recursively applied to dependencies of DRV." are not recursively applied to dependencies of DRV."
;; XXX: Someday rewrite using gexps. ;; XXX: Someday rewrite using gexps.
(define mapping (define mapping
;; List of store item pairs. ;; List of store item pairs.
@ -96,14 +97,12 @@ (define mapping
target)))) target))))
grafts)) grafts))
(define outputs (define output-pairs
(map (match-lambda (map (lambda (output)
((name . output) (cons output
(cons name (derivation-output-path output)))) (derivation-output-path
(derivation-outputs drv))) (assoc-ref (derivation-outputs drv) output))))
outputs))
(define output-names
(derivation-output-names drv))
(define build (define build
`(begin `(begin
@ -111,7 +110,7 @@ (define build
(guix build utils) (guix build utils)
(ice-9 match)) (ice-9 match))
(let* ((old-outputs ',outputs) (let* ((old-outputs ',output-pairs)
(mapping (append ',mapping (mapping (append ',mapping
(map (match-lambda (map (match-lambda
((name . file) ((name . file)
@ -143,10 +142,10 @@ (define add-label
(guix build utils)) (guix build utils))
#:inputs `(,@(map (lambda (out) #:inputs `(,@(map (lambda (out)
`("x" ,drv ,out)) `("x" ,drv ,out))
output-names) outputs)
,@(append (map add-label sources) ,@(append (map add-label sources)
(map add-label targets))) (map add-label targets)))
#:outputs output-names #:outputs outputs
#:local-build? #t))))) #:local-build? #t)))))
(define (item->deriver store item) (define (item->deriver store item)
"Return two values: the derivation that led to ITEM (a store item), and the "Return two values: the derivation that led to ITEM (a store item), and the