From eb0880e71d326753829a41b7afd66392960434cc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 1 Mar 2013 21:55:42 +0100 Subject: [PATCH] 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. --- guix/scripts/build.scm | 33 ++++++++++++++------------------- guix/scripts/package.scm | 20 -------------------- guix/ui.scm | 21 +++++++++++++++++++++ 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: ")) (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