From ac5de156ae5de8cb61870469863fb862b6a1205e Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 18 Nov 2013 23:08:20 +0100
Subject: 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'.
---
 guix/scripts/build.scm | 33 +++++++++++++++++++--------------
 guix/ui.scm            | 31 ++++++++++++++++++-------------
 2 files changed, 37 insertions(+), 27 deletions(-)

(limited to 'guix')

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 @@ (define-module (guix scripts build)
   #: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-module (guix scripts build)
 (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 @@ (define (show-help)
   (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 @@ (define package->derivation
                  (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 @@ (define-module (guix ui)
             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 @@ (define (call-with-error-handling thunk)
         (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))
-- 
cgit v1.2.3