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:
parent
5d4b411f8a
commit
eb0880e71d
|
@ -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)
|
||||||
|
|
|
@ -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.
|
||||||
|
|
21
guix/ui.scm
21
guix/ui.scm
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue