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-module (guix scripts build)
(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 @@ (define (derivations-from-package-expressions exp system source?)
(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 @@ (define %options
(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 @@ (define (find-package request)
(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 @@ (define (input->name+path input)
(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 @@ (define-module (guix ui)
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 @@ (define (call-with-error-handling thunk)
(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