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

View File

@ -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.

View File

@ -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