02/12: gexp: Add 'program-file'.

[Ludovic Courtès]

civodul pushed a commit to branch wip-service-refactor
in repository guix.

commit 5f00284542e3d472b379dc32cc622b32063c3982
Author: Ludovic Courtès <address@hidden>
Date:   Tue Sep 8 22:44:26 2015 +0200

    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.
---
 doc/guix.texi  |   17 +++++++++++++----
 guix/gexp.scm  |   33 +++++++++++++++++++++++++++++++++
 tests/gexp.scm |   17 +++++++++++++++++
 3 files changed, 63 insertions(+), 4 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index e646ec5..1272ca2 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -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
address@hidden 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
 
address@hidden {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}.
address@hidden deffn
+
 @deffn {Monadic Procedure} gexp->file @var{name} @var{exp}
 Return a derivation that builds a file @var{name} containing @var{exp}.
 
diff --git a/guix/gexp.scm b/guix/gexp.scm
index ebb147d..10acf2b 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -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.
diff --git a/tests/gexp.scm b/tests/gexp.scm
index ccbbbae..0a8ce65 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -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