guix build: '-e' can be passed a monadic thunk.

* guix/ui.scm (read/eval): New procedure.
  (read/eval-package-expression): Use it.
* guix/scripts/build.scm (derivations-from-package-expressions): Rename to...
  (derivation-from-expression): ... this.  Accept procedures, under the
  assumption that they are monadic thunk.
  (show-help): Adjust accordingly.
  (guix-build): Ditto.
* tests/guix-build.sh: Add test.
* doc/guix.texi (Invoking guix build): Augment description of '-e'.

4 files changed, 50 insertions, 28 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index cfa5aac326..847c73ab8c 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -1483,12 +1483,16 @@ The @var{options} may be zero or more of the following:
 
 @item --expression=@var{expr}
 @itemx -e @var{expr}
-Build the package @var{expr} evaluates to.
+Build the package or derivation @var{expr} evaluates to.
 
 For example, @var{expr} may be @code{(@@ (gnu packages guile)
 guile-1.8)}, which unambiguously designates this specific variant of
 version 1.8 of Guile.
 
+Alternately, @var{expr} may refer to a zero-argument monadic procedure
+(@pxref{The Store Monad}).  The procedure must return a derivation as a
+monadic value, which is then passed through @code{run-with-store}.
+
 @item --source
 @itemx -S
 Build the packages' source derivations, rather than the packages
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index f63736c09c..dd9a9b8127 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -23,6 +23,7 @@
   #:use-module (guix derivations)
   #:use-module (guix packages)
   #:use-module (guix utils)
+  #:use-module (guix monads)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (ice-9 vlist)
@@ -38,19 +39,23 @@
 (define %store
   (make-parameter #f))
 
-(define (derivations-from-package-expressions str package-derivation
-                                              system source?)
+(define (derivation-from-expression str package-derivation
+                                    system source?)
   "Read/eval STR and return the corresponding derivation path for SYSTEM.
-When SOURCE? is true, return the derivations of the package sources;
-otherwise, use PACKAGE-DERIVATION to compute the derivation of a package."
-  (let ((p (read/eval-package-expression str)))
-    (if source?
-        (let ((source (package-source p)))
-          (if source
-              (package-source-derivation (%store) source)
-              (leave (_ "package `~a' has no source~%")
-                     (package-name p))))
-        (package-derivation (%store) p system))))
+When SOURCE? is true and STR evaluates to a package, return the derivation of
+the package source; otherwise, use PACKAGE-DERIVATION to compute the
+derivation of a package."
+  (match (read/eval str)
+    ((? package? p)
+     (if source?
+         (let ((source (package-source p)))
+           (if source
+               (package-source-derivation (%store) source)
+               (leave (_ "package `~a' has no source~%")
+                      (package-name p))))
+         (package-derivation (%store) p system)))
+    ((? procedure? proc)
+     (run-with-store (%store) (proc) #:system system))))
 
 
 ;;;
@@ -68,7 +73,7 @@ otherwise, use PACKAGE-DERIVATION to compute the derivation of a package."
   (display (_ "Usage: guix build [OPTION]... PACKAGE-OR-DERIVATION...
 Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
   (display (_ "
-  -e, --expression=EXPR  build the package EXPR evaluates to"))
+  -e, --expression=EXPR  build the package or derivation EXPR evaluates to"))
   (display (_ "
   -S, --source           build the packages' source derivations"))
   (display (_ "
@@ -255,7 +260,7 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
                  (sys  (assoc-ref opts 'system))
                  (drv  (filter-map (match-lambda
                                     (('expression . str)
-                                     (derivations-from-package-expressions
+                                     (derivation-from-expression
                                       str package->derivation sys src?))
                                     (('argument . (? derivation-path? drv))
                                      (call-with-input-file drv read-derivation))
diff --git a/guix/ui.scm b/guix/ui.scm
index 8a28574c3c..f15419f7a8 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -45,6 +45,7 @@
             show-what-to-build
             call-with-error-handling
             with-error-handling
+            read/eval
             read/eval-package-expression
             location->string
             switch-symlinks
@@ -193,25 +194,29 @@ General help using GNU software: <http://www.gnu.org/gethelp/>"))
         (leave (_ "~a~%")
                (strerror (system-error-errno args)))))))
 
-(define (read/eval-package-expression str)
-  "Read and evaluate STR and return the package it refers to, or exit an
-error."
+(define (read/eval str)
+  "Read and evaluate STR, raising an error if something goes wrong."
   (let ((exp (catch #t
                (lambda ()
                  (call-with-input-string str read))
                (lambda args
                  (leave (_ "failed to read expression ~s: ~s~%")
                         str args)))))
-    (let ((p (catch #t
-               (lambda ()
-                 (eval exp the-scm-module))
-               (lambda args
-                 (leave (_ "failed to evaluate expression `~a': ~s~%")
-                        exp args)))))
-      (if (package? p)
-          p
-          (leave (_ "expression `~s' does not evaluate to a package~%")
-                 exp)))))
+    (catch #t
+      (lambda ()
+        (eval exp the-scm-module))
+      (lambda args
+        (leave (_ "failed to evaluate expression `~a': ~s~%")
+               exp args)))))
+
+(define (read/eval-package-expression str)
+  "Read and evaluate STR and return the package it refers to, or exit an
+error."
+  (match (read/eval str)
+    ((? package? p) p)
+    (_
+     (leave (_ "expression ~s does not evaluate to a package~%")
+            str))))
 
 (define* (show-what-to-build store drv
                              #:key dry-run? (use-substitutes? #t))
diff --git a/tests/guix-build.sh b/tests/guix-build.sh
index e228b38616..391e7b9da3 100644
--- a/tests/guix-build.sh
+++ b/tests/guix-build.sh
@@ -72,3 +72,11 @@ if guix build -n time-3.2;	# FAIL, version not found
 then false; else true; fi
 if guix build -n something-that-will-never-exist; # FAIL
 then false; else true; fi
+
+# Invoking a monadic procedure.
+guix build -e "(begin
+                 (use-modules (guix monads) (guix utils))
+                 (lambda ()
+                   (derivation-expression \"test\" (%current-system)
+                                          '(mkdir %output) '())))" \
+   --dry-run