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.
This commit is contained in:
Ludovic Courtès 2013-03-01 21:55:42 +01:00
parent 5d4b411f8a
commit eb0880e71d
3 changed files with 35 additions and 39 deletions

View File

@ -38,11 +38,10 @@
(define %store (define %store
(make-parameter #f)) (make-parameter #f))
(define (derivations-from-package-expressions exp system source?) (define (derivations-from-package-expressions str system source?)
"Eval EXP and return the corresponding derivation path for SYSTEM. "Read/eval STR and return the corresponding derivation path for SYSTEM.
When SOURCE? is true, return the derivations of the package sources." When SOURCE? is true, return the derivations of the package sources."
(let ((p (eval exp (current-module)))) (let ((p (read/eval-package-expression str)))
(if (package? p)
(if source? (if source?
(let ((source (package-source p)) (let ((source (package-source p))
(loc (package-location p))) (loc (package-location p)))
@ -50,9 +49,7 @@ When SOURCE? is true, return the derivations of the package sources."
(package-source-derivation (%store) source) (package-source-derivation (%store) source)
(leave (_ "~a: error: package `~a' has no source~%") (leave (_ "~a: error: package `~a' has no source~%")
(location->string loc) (package-name p)))) (location->string loc) (package-name p))))
(package-derivation (%store) p system)) (package-derivation (%store) p system))))
(leave (_ "expression `~s' does not evaluate to a package~%")
exp))))
;;; ;;;
@ -119,9 +116,7 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
(alist-cons 'derivations-only? #t result))) (alist-cons 'derivations-only? #t result)))
(option '(#\e "expression") #t #f (option '(#\e "expression") #t #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'expression (alist-cons 'expression arg result)))
(call-with-input-string arg read)
result)))
(option '(#\K "keep-failed") #f #f (option '(#\K "keep-failed") #f #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'keep-failed? #t 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?)) (let* ((src? (assoc-ref opts 'source?))
(sys (assoc-ref opts 'system)) (sys (assoc-ref opts 'system))
(drv (filter-map (match-lambda (drv (filter-map (match-lambda
(('expression . exp) (('expression . str)
(derivations-from-package-expressions exp sys (derivations-from-package-expressions str sys
src?)) src?))
(('argument . (? derivation-path? drv)) (('argument . (? derivation-path? drv))
drv) drv)

View File

@ -266,26 +266,6 @@ matching packages."
(assoc-ref (derivation-outputs drv) sub-drv)))) (assoc-ref (derivation-outputs drv) sub-drv))))
`(,name ,out)))))) `(,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. ;;; Command-line options.

View File

@ -38,6 +38,7 @@
show-what-to-build show-what-to-build
call-with-error-handling call-with-error-handling
with-error-handling with-error-handling
read/eval-package-expression
location->string location->string
call-with-temporary-output-file call-with-temporary-output-file
switch-symlinks switch-symlinks
@ -116,6 +117,26 @@ General help using GNU software: <http://www.gnu.org/gethelp/>"))
(nix-protocol-error-message c)))) (nix-protocol-error-message c))))
(thunk))) (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?) (define* (show-what-to-build store drv #:optional dry-run?)
"Show what will or would (depending on DRY-RUN?) be built in realizing the "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 derivations listed in DRV. Return #t if there's something to build, #f