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
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user