summary refs log tree commit diff
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-20 23:46:57 +0100
commit9bb2b96aabdbb245c4a409e96b25df2954cfe385 (patch)
treeed08fd19242d1f481be005d655c67187eadb5dee
parent7730d112a2707522943d06940da25a22841a4568 (diff)
downloadguix-9bb2b96aabdbb245c4a409e96b25df2954cfe385.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."