gexp: Add 'file-union'.
* gnu/services.scm (file-union): Move to... * guix/gexp.scm (file-union): ... here. New procedure. * doc/guix.texi (G-Expressions): Document it.
This commit is contained in:
		
							parent
							
								
									7a51c78c6e
								
							
						
					
					
						commit
						dedb512f8f
					
				
					 3 changed files with 49 additions and 20 deletions
				
			
		|  | @ -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{<computed-file>} 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 | ||||
|  |  | |||
|  | @ -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 <computed-file> 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 | ||||
|  |  | |||
|  | @ -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 <computed-file> 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. | ||||
|  |  | |||
		Reference in a new issue