~ruther/guix-local

9bb2b96aabdbb245c4a409e96b25df2954cfe385 — Ludovic Courtès 13 years ago 7730d11
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.
3 files changed, 32 insertions(+), 48 deletions(-)

M guix/scripts/build.scm
M guix/scripts/package.scm
M guix/ui.scm
M guix/scripts/build.scm => guix/scripts/build.scm +2 -21
@@ 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)

M guix/scripts/package.scm => guix/scripts/package.scm +1 -27
@@ 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)

M guix/ui.scm => guix/ui.scm +29 -0
@@ 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."