nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

grafts: Add high-level 'graft' procedure on the build side. 

* guix/build/graft.scm (graft): New procedure.
* guix/grafts.scm (graft-derivation/shallow)[build]: Use it instead of
inline code.
This commit is contained in:
Ludovic Courtès 2018-08-21 15:09:11 +02:00
parent c1352b4bad
commit e4297aa8b9
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 21 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
guix/build/graft.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015, 2016, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2016 Mark H Weaver <mhw@netris.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -27,7 +27,8 @@
#:use-module (srfi srfi-1) ; list library #:use-module (srfi srfi-1) ; list library
#:use-module (srfi srfi-26) ; cut and cute #:use-module (srfi srfi-26) ; cut and cute
#:export (replace-store-references #:export (replace-store-references
rewrite-directory)) rewrite-directory
graft))
;;; Commentary: ;;; Commentary:
;;; ;;;
@ -321,4 +322,20 @@ file name pairs."
#:directories? #t)) #:directories? #t))
(rename-matching-files output mapping)) (rename-matching-files output mapping))
(define* (graft old-outputs new-outputs mapping
#:key (log-port (current-output-port)))
"Apply the grafts described by MAPPING on OLD-OUTPUTS, leading to
NEW-OUTPUTS. MAPPING must be a list of file name pairs; OLD-OUTPUTS and
NEW-OUTPUTS are lists of output name/file name pairs."
(for-each (lambda (input output)
(format log-port "grafting '~a' -> '~a'...~%" input output)
(force-output)
(rewrite-directory input output mapping))
(match old-outputs
(((names . files) ...)
files))
(match new-outputs
(((names . files) ...)
files))))
;;; graft.scm ends here ;;; graft.scm ends here

13
guix/grafts.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -117,16 +117,7 @@ are not recursively applied to dependencies of DRV."
(cons (assoc-ref old-outputs name) (cons (assoc-ref old-outputs name)
file))) file)))
%outputs)))) %outputs))))
(for-each (lambda (input output) (graft old-outputs %outputs mapping))))
(format #t "grafting '~a' -> '~a'...~%" input output)
(force-output)
(rewrite-directory input output mapping))
(match old-outputs
(((names . files) ...)
files))
(match %outputs
(((names . files) ...)
files))))))
(define add-label (define add-label
(cut cons "x" <>)) (cut cons "x" <>))