From mboxrd@z Thu Jan 1 00:00:00 1970 From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Subject: bug#27284: [PATCH 4/8] gexp: Add 'file-union'. Date: Fri, 20 Oct 2017 18:05:53 +0200 Message-ID: <20171020160557.27096-5-ludo@gnu.org> References: <87poamv2i7.fsf@gnu.org> <20171020160557.27096-1-ludo@gnu.org> Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:46594) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1e5ZpC-0003eS-7H for bug-guix@gnu.org; Fri, 20 Oct 2017 12:07:07 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1e5Zp9-0007aM-GM for bug-guix@gnu.org; Fri, 20 Oct 2017 12:07:06 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:43920) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1e5Zp9-0007aI-CR for bug-guix@gnu.org; Fri, 20 Oct 2017 12:07:03 -0400 Sender: "Debbugs-submit" Resent-Message-ID: In-Reply-To: <20171020160557.27096-1-ludo@gnu.org> List-Id: Bug reports for GNU Guix List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guix-bounces+gcggb-bug-guix=m.gmane.org@gnu.org Sender: "bug-Guix" To: 27284@debbugs.gnu.org * gnu/services.scm (file-union): Move to... * guix/gexp.scm (file-union): ... here. New procedure. * doc/guix.texi (G-Expressions): Document it. --- doc/guix.texi | 17 +++++++++++++++++ gnu/services.scm | 20 -------------------- guix/gexp.scm | 32 ++++++++++++++++++++++++++++++++ 3 files changed, 49 insertions(+), 20 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index b7f4f88f9..1de3494da 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4990,6 +4990,23 @@ as in: This is the declarative counterpart of @code{text-file*}. @end deffn +@deffn {Scheme Procedure} file-union @var{name} @var{files} +Return a @code{} that builds a directory containing all of @var{files}. +Each item in @var{files} must be a two-element list where the first element is the +file name to use in the new directory, and the second element is a gexp +denoting the target file. Here's an example: + +@example +(file-union "etc" + `(("hosts" ,(plain-file "hosts" + "127.0.0.1 localhost")) + ("bashrc" ,(plain-file "bashrc" + "alias ls='ls --color'")))) +@end example + +This yields an @code{etc} directory containing these two files. +@end deffn + @deffn {Scheme Procedure} file-append @var{obj} @var{suffix} @dots{} Return a file-like object that expands to the concatenation of @var{obj} and @var{suffix}, where @var{obj} is a lowerable object and each diff --git a/gnu/services.scm b/gnu/services.scm index 0bd362085..bc866eafe 100644 --- a/gnu/services.scm +++ b/gnu/services.scm @@ -97,7 +97,6 @@ %activation-service etc-service - file-union ;XXX: for lack of a better place directory-union)) ;;; Comment: @@ -388,25 +387,6 @@ boot." (list (service-extension boot-service-type cleanup-gexp))))) -(define* (file-union name files) ;FIXME: Factorize. - "Return a that builds a directory containing all of FILES. -Each item in FILES must be a list where the first element is the file name to -use in the new directory, and the second element is a gexp denoting the target -file." - (computed-file name - #~(begin - (mkdir #$output) - (chdir #$output) - #$@(map (match-lambda - ((target source) - #~(begin - ;; Stat the source to abort early if it - ;; does not exist. - (stat #$source) - - (symlink #$source #$target)))) - files)))) - (define (directory-union name things) "Return a directory that is the union of THINGS." (match things diff --git a/guix/gexp.scm b/guix/gexp.scm index 2622c5cb6..9835599bb 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -78,6 +78,7 @@ gexp->script text-file* mixed-text-file + file-union imported-files imported-modules compiled-modules @@ -1171,6 +1172,37 @@ This is the declarative counterpart of 'text-file*'." (computed-file name build)) +(define (file-union name files) + "Return a that builds a directory containing all of FILES. +Each item in FILES must be a two-element list where the first element is the +file name to use in the new directory, and the second element is a gexp +denoting the target file. Here's an example: + + (file-union \"etc\" + `((\"hosts\" ,(plain-file \"hosts\" + \"127.0.0.1 localhost\")) + (\"bashrc\" ,(plain-file \"bashrc\" + \"alias ls='ls --color'\")))) + +This yields an 'etc' directory containing these two files." + (computed-file name + (gexp + (begin + (mkdir (ungexp output)) + (chdir (ungexp output)) + (ungexp-splicing + (map (match-lambda + ((target source) + (gexp + (begin + ;; Stat the source to abort early if it does + ;; not exist. + (stat (ungexp source)) + + (symlink (ungexp source) + (ungexp target)))))) + files)))))) + ;;; ;;; Syntactic sugar. -- 2.14.2