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.
master
Ludovic Courtès 2015-09-08 22:44:26 +02:00
parent 919370291f
commit 15a01c7220
3 changed files with 63 additions and 4 deletions

View File

@ -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}.

View File

@ -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.

View File

@ -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