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
;;; 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 © 2017 Huang Ying <huang.ying.caritas@gmail.com>
;;;
@ -78,11 +78,12 @@ identical, #f otherwise."
(define* (union-build output inputs
#: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
INPUTS. As a special case, if CREATE-ALL-DIRECTORIES?, creates the
subdirectories in the output directory to make sure the caller can modify them
later."
INPUTS, using SYMLINK to create symlinks. As a special case, if
CREATE-ALL-DIRECTORIES?, creates the subdirectories in the output directory to
make sure the caller can modify them later."
(define (symlink* 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))))))
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
file-like objects denoting directories. For example:
(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
((one)
;; Only one thing; return it.
@ -1221,7 +1232,9 @@ yields a directory that is the union of the 'guile' and 'emacs' packages."
(gexp (begin
(use-modules (guix build union))
(union-build (ungexp output)
'(ungexp things)))))))))
'(ungexp things)
#:symlink (ungexp symlink)))))))))
;;;