futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

union: Parametrize the symlink procedure .

Browse Source 
* guix/gexp.scm (directory-union): Add #:hard-links and honor it.
* guix/build/union.scm (union-build): Add #:symlink parameter.
This commit is contained in:
Ludovic Courtès 2017-10-19 16:07:34 +02:00
parent 5c1f38bf8b
commit 59523429d6
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 22 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
guix/build/union.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2014, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2017 Huang Ying <huang.ying.caritas@gmail.com> ;;; Copyright © 2017 Huang Ying <huang.ying.caritas@gmail.com>
;;; ;;;
@ -78,11 +78,12 @@ identical, #f otherwise."
(define* (union-build output inputs (define* (union-build output inputs
#:key (log-port (current-error-port)) #:key (log-port (current-error-port))
(create-all-directories? #f)) (create-all-directories? #f)
(symlink symlink))
"Build in the OUTPUT directory a symlink tree that is the union of all the "Build in the OUTPUT directory a symlink tree that is the union of all the
INPUTS. As a special case, if CREATE-ALL-DIRECTORIES?, creates the INPUTS, using SYMLINK to create symlinks. As a special case, if
subdirectories in the output directory to make sure the caller can modify them CREATE-ALL-DIRECTORIES?, creates the subdirectories in the output directory to
later." make sure the caller can modify them later."
(define (symlink* input output) (define (symlink* input output)
(format log-port "`~a' ~~> `~a'~%" input output) (format log-port "`~a' ~~> `~a'~%" input output)

19
guix/gexp.scm
View File

@ -1204,13 +1204,24 @@ This yields an 'etc' directory containing these two files."
(ungexp target)))))) (ungexp target))))))
files)))))) files))))))
(define (directory-union name things) (define* (directory-union name things
#:key (copy? #f))
"Return a directory that is the union of THINGS, where THINGS is a list of "Return a directory that is the union of THINGS, where THINGS is a list of
file-like objects denoting directories. For example: file-like objects denoting directories. For example:
(directory-union \"guile+emacs\" (list guile emacs)) (directory-union \"guile+emacs\" (list guile emacs))
yields a directory that is the union of the 'guile' and 'emacs' packages." yields a directory that is the union of the 'guile' and 'emacs' packages.
When COPY? is true, copy files instead of creating symlinks."
(define symlink
(if copy?
(gexp (lambda (old new)
(if (file-is-directory? old)
(symlink old new)
(copy-file old new))))
(gexp symlink)))
(match things (match things
((one) ((one)
;; Only one thing; return it. ;; Only one thing; return it.
@ -1221,7 +1232,9 @@ yields a directory that is the union of the 'guile' and 'emacs' packages."
(gexp (begin (gexp (begin
(use-modules (guix build union)) (use-modules (guix build union))
(union-build (ungexp output) (union-build (ungexp output)
'(ungexp things))))))))) '(ungexp things)
#:symlink (ungexp symlink)))))))))
;;; ;;;