gexp: Add 'program-file'.
* guix/gexp.scm (<program-file>): New record type.
  (program-file, program-file-compiler): New procedures.
* tests/gexp.scm ("program-file"): New test.
* doc/guix.texi (G-Expressions): Document it.
			
			
This commit is contained in:
		
							parent
							
								
									919370291f
								
							
						
					
					
						commit
						15a01c7220
					
				
					 3 changed files with 63 additions and 4 deletions
				
			
		|  | @ -3345,10 +3345,10 @@ The other arguments are as for @code{derivation} (@pxref{Derivations}). | ||||||
| @end deffn | @end deffn | ||||||
| 
 | 
 | ||||||
| @cindex file-like objects | @cindex file-like objects | ||||||
| The @code{local-file}, @code{plain-file}, and @code{computed-file} | The @code{local-file}, @code{plain-file}, @code{computed-file}, and | ||||||
| procedures below return @dfn{file-like objects}.  That is, when unquoted | @code{program-file} procedures below return @dfn{file-like objects}. | ||||||
| in a G-expression, these objects lead to a file in the store.  Consider | That is, when unquoted in a G-expression, these objects lead to a file | ||||||
| this G-expression: | in the store.  Consider this G-expression: | ||||||
| 
 | 
 | ||||||
| @example | @example | ||||||
| #~(system* (string-append #$glibc "/sbin/nscd") "-f" | #~(system* (string-append #$glibc "/sbin/nscd") "-f" | ||||||
|  | @ -3421,6 +3421,15 @@ executable file @file{/gnu/store/@dots{}-list-files} along these lines: | ||||||
| @end example | @end example | ||||||
| @end deffn | @end deffn | ||||||
| 
 | 
 | ||||||
|  | @deffn {Scheme Procedure} program-file @var{name} @var{exp} @ | ||||||
|  |           [#:modules '()] [#:guile #f] | ||||||
|  | Return an object representing the executable store item @var{name} that | ||||||
|  | runs @var{gexp}.  @var{guile} is the Guile package used to execute that | ||||||
|  | script, and @var{modules} is the list of modules visible to that script. | ||||||
|  | 
 | ||||||
|  | This is the declarative counterpart of @code{gexp->script}. | ||||||
|  | @end deffn | ||||||
|  | 
 | ||||||
| @deffn {Monadic Procedure} gexp->file @var{name} @var{exp} | @deffn {Monadic Procedure} gexp->file @var{name} @var{exp} | ||||||
| Return a derivation that builds a file @var{name} containing @var{exp}. | Return a derivation that builds a file @var{name} containing @var{exp}. | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
|  | @ -50,6 +50,13 @@ | ||||||
|             computed-file-modules |             computed-file-modules | ||||||
|             computed-file-options |             computed-file-options | ||||||
| 
 | 
 | ||||||
|  |             program-file | ||||||
|  |             program-file? | ||||||
|  |             program-file-name | ||||||
|  |             program-file-gexp | ||||||
|  |             program-file-modules | ||||||
|  |             program-file-guile | ||||||
|  | 
 | ||||||
|             gexp->derivation |             gexp->derivation | ||||||
|             gexp->file |             gexp->file | ||||||
|             gexp->script |             gexp->script | ||||||
|  | @ -247,6 +254,32 @@ This is the declarative counterpart of 'gexp->derivation'." | ||||||
|     (($ <computed-file> name gexp modules options) |     (($ <computed-file> name gexp modules options) | ||||||
|      (apply gexp->derivation name gexp #:modules modules options)))) |      (apply gexp->derivation name gexp #:modules modules options)))) | ||||||
| 
 | 
 | ||||||
|  | (define-record-type <program-file> | ||||||
|  |   (%program-file name gexp modules guile) | ||||||
|  |   program-file? | ||||||
|  |   (name       program-file-name)                  ;string | ||||||
|  |   (gexp       program-file-gexp)                  ;gexp | ||||||
|  |   (modules    program-file-modules)               ;list of module names | ||||||
|  |   (guile      program-file-guile))                ;package | ||||||
|  | 
 | ||||||
|  | (define* (program-file name gexp | ||||||
|  |                        #:key (modules '()) (guile #f)) | ||||||
|  |   "Return an object representing the executable store item NAME that runs | ||||||
|  | GEXP.  GUILE is the Guile package used to execute that script, and MODULES is | ||||||
|  | the list of modules visible to that script. | ||||||
|  | 
 | ||||||
|  | This is the declarative counterpart of 'gexp->script'." | ||||||
|  |   (%program-file name gexp modules guile)) | ||||||
|  | 
 | ||||||
|  | (define-gexp-compiler (program-file-compiler (file program-file?) | ||||||
|  |                                              system target) | ||||||
|  |   ;; Compile FILE by returning a derivation that builds the script. | ||||||
|  |   (match file | ||||||
|  |     (($ <program-file> name gexp modules guile) | ||||||
|  |      (gexp->script name gexp | ||||||
|  |                    #:modules modules | ||||||
|  |                    #:guile (or guile (default-guile)))))) | ||||||
|  | 
 | ||||||
|  |  | ||||||
| ;;; | ;;; | ||||||
| ;;; Inputs & outputs. | ;;; Inputs & outputs. | ||||||
|  |  | ||||||
|  | @ -619,6 +619,23 @@ | ||||||
|       (return (and (zero? (close-pipe pipe)) |       (return (and (zero? (close-pipe pipe)) | ||||||
|                    (= (expt n 2) (string->number str))))))) |                    (= (expt n 2) (string->number str))))))) | ||||||
| 
 | 
 | ||||||
|  | (test-assertm "program-file" | ||||||
|  |   (let* ((n      (random (expt 2 50))) | ||||||
|  |          (exp    (gexp (begin | ||||||
|  |                          (use-modules (guix build utils)) | ||||||
|  |                          (display (ungexp n))))) | ||||||
|  |          (file   (program-file "program" exp | ||||||
|  |                                #:modules '((guix build utils)) | ||||||
|  |                                #:guile %bootstrap-guile))) | ||||||
|  |     (mlet* %store-monad ((drv (lower-object file)) | ||||||
|  |                          (out -> (derivation->output-path drv))) | ||||||
|  |       (mbegin %store-monad | ||||||
|  |         (built-derivations (list drv)) | ||||||
|  |         (let* ((pipe  (open-input-pipe out)) | ||||||
|  |                (str   (get-string-all pipe))) | ||||||
|  |           (return (and (zero? (close-pipe pipe)) | ||||||
|  |                        (= n (string->number str))))))))) | ||||||
|  | 
 | ||||||
| (test-assert "text-file*" | (test-assert "text-file*" | ||||||
|   (let ((references (store-lift references))) |   (let ((references (store-lift references))) | ||||||
|     (run-with-store %store |     (run-with-store %store | ||||||
|  |  | ||||||
		Reference in a new issue