aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-02-20 23:41:24 +0100
committerLudovic Courtès <ludo@gnu.org>2013-02-27 20:55:41 +0100
commit7650e148f69832e6b89b93c549278b1bbf89946a (patch)
treef61aac63bce8d52550ddddc320023660ec7ddb15
parente51035f70a2eee6d0def046d58fdc63c1aa3899e (diff)
downloadpatches-7650e148f69832e6b89b93c549278b1bbf89946a.tar
patches-7650e148f69832e6b89b93c549278b1bbf89946a.tar.gz
ui: Factorize `show-what-to-build'.
* guix/scripts/package.scm (guix-package)[show-what-to-build]: Move to.. * guix/ui.scm (show-what-to-build): ... here. Add a `store' parameter'. Adjust callers. * guix/scripts/build.scm (guix-build): Use it. Remove `req' and `req*' variables.
-rw-r--r--guix/scripts/build.scm23
-rw-r--r--guix/scripts/package.scm28
-rw-r--r--guix/ui.scm29
3 files changed, 32 insertions, 48 deletions
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 7863fb881b..fbd22a9e29 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -241,31 +241,12 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
(package-derivation (%store) p sys))))
(_ #f))
opts))
- (req (append-map (lambda (drv-path)
- (let ((d (call-with-input-file drv-path
- read-derivation)))
- (derivation-prerequisites-to-build (%store) d)))
- drv))
- (req* (delete-duplicates
- (append (remove (compose (cut valid-path? (%store) <>)
- derivation-path->output-path)
- drv)
- (map derivation-input-path req))))
(roots (filter-map (match-lambda
(('gc-root . root) root)
(_ #f))
opts)))
- (if (assoc-ref opts 'dry-run?)
- (format (current-error-port)
- (N_ "~:[the following derivation would be built:~%~{ ~a~%~}~;~]"
- "~:[the following derivations would be built:~%~{ ~a~%~}~;~]"
- (length req*))
- (null? req*) req*)
- (format (current-error-port)
- (N_ "~:[the following derivation will be built:~%~{ ~a~%~}~;~]"
- "~:[the following derivations will be built:~%~{ ~a~%~}~;~]"
- (length req*))
- (null? req*) req*))
+
+ (show-what-to-build (%store) drv (assoc-ref opts 'dry-run?))
;; TODO: Add more options.
(set-build-options (%store)
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 38e8ae1150..1f9355ff22 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -380,32 +380,6 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
(let ((out (derivation-path->output-path (%guile-for-build))))
(not (valid-path? (%store) out))))
- (define (show-what-to-build drv dry-run?)
- ;; Show what will/would be built in realizing the derivations listed
- ;; in DRV.
- (let* ((req (append-map (lambda (drv-path)
- (let ((d (call-with-input-file drv-path
- read-derivation)))
- (derivation-prerequisites-to-build
- (%store) d)))
- drv))
- (req* (delete-duplicates
- (append (remove (compose (cute valid-path? (%store) <>)
- derivation-path->output-path)
- drv)
- (map derivation-input-path req)))))
- (if dry-run?
- (format (current-error-port)
- (N_ "~:[the following derivation would be built:~%~{ ~a~%~}~;~]"
- "~:[the following derivations would be built:~%~{ ~a~%~}~;~]"
- (length req*))
- (null? req*) req*)
- (format (current-error-port)
- (N_ "~:[the following derivation will be built:~%~{ ~a~%~}~;~]"
- "~:[the following derivations will be built:~%~{ ~a~%~}~;~]"
- (length req*))
- (null? req*) req*))))
-
(define newest-available-packages
(memoize find-newest-available-packages))
@@ -589,7 +563,7 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
(when (equal? profile %current-profile)
(ensure-default-profile))
- (show-what-to-build drv dry-run?)
+ (show-what-to-build (%store) drv dry-run?)
(or dry-run?
(and (build-derivations (%store) drv)
diff --git a/guix/ui.scm b/guix/ui.scm
index 9c27dd8b3a..2b75504573 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -22,17 +22,20 @@
#:use-module (guix store)
#:use-module (guix config)
#:use-module (guix packages)
+ #:use-module (guix derivations)
#:use-module ((guix licenses) #:select (license? license-name))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (ice-9 match)
+ #:use-module (ice-9 format)
#:export (_
N_
leave
show-version-and-exit
show-bug-report-information
+ show-what-to-build
call-with-error-handling
with-error-handling
location->string
@@ -112,6 +115,32 @@ General help using GNU software: <http://www.gnu.org/gethelp/>"))
(nix-protocol-error-message c))))
(thunk)))
+(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."
+ (let* ((req (append-map (lambda (drv-path)
+ (let ((d (call-with-input-file drv-path
+ read-derivation)))
+ (derivation-prerequisites-to-build
+ store d)))
+ drv))
+ (req* (delete-duplicates
+ (append (remove (compose (cute valid-path? store <>)
+ derivation-path->output-path)
+ drv)
+ (map derivation-input-path req)))))
+ (if dry-run?
+ (format (current-error-port)
+ (N_ "~:[the following derivation would be built:~%~{ ~a~%~}~;~]"
+ "~:[the following derivations would be built:~%~{ ~a~%~}~;~]"
+ (length req*))
+ (null? req*) req*)
+ (format (current-error-port)
+ (N_ "~:[the following derivation will be built:~%~{ ~a~%~}~;~]"
+ "~:[the following derivations will be built:~%~{ ~a~%~}~;~]"
+ (length req*))
+ (null? req*) req*))))
+
(define-syntax with-error-handling
(syntax-rules ()
"Run BODY within a user-friendly error condition handler."