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 | ||||
| 
 | ||||
| @cindex file-like objects | ||||
| The @code{local-file}, @code{plain-file}, and @code{computed-file} | ||||
| procedures below return @dfn{file-like objects}.  That is, when unquoted | ||||
| in a G-expression, these objects lead to a file in the store.  Consider | ||||
| this G-expression: | ||||
| The @code{local-file}, @code{plain-file}, @code{computed-file}, and | ||||
| @code{program-file} procedures below return @dfn{file-like objects}. | ||||
| That is, when unquoted in a G-expression, these objects lead to a file | ||||
| in the store.  Consider this G-expression: | ||||
| 
 | ||||
| @example | ||||
| #~(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 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} | ||||
| Return a derivation that builds a file @var{name} containing @var{exp}. | ||||
| 
 | ||||
|  |  | |||
|  | @ -50,6 +50,13 @@ | |||
|             computed-file-modules | ||||
|             computed-file-options | ||||
| 
 | ||||
|             program-file | ||||
|             program-file? | ||||
|             program-file-name | ||||
|             program-file-gexp | ||||
|             program-file-modules | ||||
|             program-file-guile | ||||
| 
 | ||||
|             gexp->derivation | ||||
|             gexp->file | ||||
|             gexp->script | ||||
|  | @ -247,6 +254,32 @@ This is the declarative counterpart of 'gexp->derivation'." | |||
|     (($ <computed-file> name gexp 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. | ||||
|  |  | |||
|  | @ -619,6 +619,23 @@ | |||
|       (return (and (zero? (close-pipe pipe)) | ||||
|                    (= (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*" | ||||
|   (let ((references (store-lift references))) | ||||
|     (run-with-store %store | ||||
|  |  | |||
		Reference in a new issue