summaryrefslogtreecommitdiff
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)
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