summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-03-01 21:55:42 +0100
committerLudovic Courtès <ludo@gnu.org>2013-03-01 21:55:42 +0100
commiteb0880e71d326753829a41b7afd66392960434cc (patch)
tree94fe7fc3f4773c23ae21032f15df9a0858b917ed
parent5d4b411f8a3372455a8c92d10a28e88e9edba6eb (diff)
downloadguix-eb0880e71d326753829a41b7afd66392960434cc.tar.gz
ui: Factorize `read/eval-package-expression'.
* guix/scripts/package.scm (read/eval-package-expression): Move to...
* guix/ui.scm (read/eval-package-expression): ... here.
* guix/scripts/build.scm (derivations-from-package-expressions): Use it.
-rw-r--r--guix/scripts/build.scm33
-rw-r--r--guix/scripts/package.scm20
-rw-r--r--guix/ui.scm21
3 files changed, 35 insertions, 39 deletions
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index fbd22a9e29..a49bfdbeb8 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -38,21 +38,18 @@
 (define %store
   (make-parameter #f))
 
-(define (derivations-from-package-expressions exp system source?)
-  "Eval EXP and return the corresponding derivation path for SYSTEM.
+(define (derivations-from-package-expressions str system source?)
+  "Read/eval STR and return the corresponding derivation path for SYSTEM.
 When SOURCE? is true, return the derivations of the package sources."
-  (let ((p (eval exp (current-module))))
-    (if (package? p)
-        (if source?
-            (let ((source (package-source p))
-                  (loc    (package-location p)))
-              (if source
-                  (package-source-derivation (%store) source)
-                  (leave (_ "~a: error: package `~a' has no source~%")
-                         (location->string loc) (package-name p))))
-            (package-derivation (%store) p system))
-        (leave (_ "expression `~s' does not evaluate to a package~%")
-               exp))))
+  (let ((p (read/eval-package-expression str)))
+    (if source?
+        (let ((source (package-source p))
+              (loc    (package-location p)))
+          (if source
+              (package-source-derivation (%store) source)
+              (leave (_ "~a: error: package `~a' has no source~%")
+                     (location->string loc) (package-name p))))
+        (package-derivation (%store) p system))))
 
 
 ;;;
@@ -119,9 +116,7 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
                   (alist-cons 'derivations-only? #t result)))
         (option '(#\e "expression") #t #f
                 (lambda (opt name arg result)
-                  (alist-cons 'expression
-                              (call-with-input-string arg read)
-                              result)))
+                  (alist-cons 'expression arg result)))
         (option '(#\K "keep-failed") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'keep-failed? #t result)))
@@ -227,8 +222,8 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
         (let* ((src? (assoc-ref opts 'source?))
                (sys  (assoc-ref opts 'system))
                (drv  (filter-map (match-lambda
-                                  (('expression . exp)
-                                   (derivations-from-package-expressions exp sys
+                                  (('expression . str)
+                                   (derivations-from-package-expressions str sys
                                                                          src?))
                                   (('argument . (? derivation-path? drv))
                                    drv)
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 28ef721603..ccca614d88 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -266,26 +266,6 @@ matching packages."
                        (assoc-ref (derivation-outputs drv) sub-drv))))
          `(,name ,out))))))
 
-(define (read/eval-package-expression str)
-  "Read and evaluate STR and return the package it refers to, or exit an
-error."
-  (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)))))
-
 
 ;;;
 ;;; Command-line options.
diff --git a/guix/ui.scm b/guix/ui.scm
index 7e0c61b4f8..03d881a428 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -38,6 +38,7 @@
             show-what-to-build
             call-with-error-handling
             with-error-handling
+            read/eval-package-expression
             location->string
             call-with-temporary-output-file
             switch-symlinks
@@ -116,6 +117,26 @@ General help using GNU software: <http://www.gnu.org/gethelp/>"))
                     (nix-protocol-error-message c))))
     (thunk)))
 
+(define (read/eval-package-expression str)
+  "Read and evaluate STR and return the package it refers to, or exit an
+error."
+  (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)))))
+
 (define* (show-what-to-build store drv #:optional dry-run?)
   "Show what will or would (depending on DRY-RUN?) be built in realizing the
 derivations listed in DRV.  Return #t if there's something to build, #f