Skip to content
Snippets Groups Projects
Commit 9bb2b96a authored by Ludovic Courtès's avatar Ludovic Courtès
Browse files

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.
parent 7730d112
No related branches found
No related tags found
No related merge requests found
...@@ -241,31 +241,12 @@ (define (find-package request) ...@@ -241,31 +241,12 @@ (define (find-package request)
(package-derivation (%store) p sys)))) (package-derivation (%store) p sys))))
(_ #f)) (_ #f))
opts)) 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 (roots (filter-map (match-lambda
(('gc-root . root) root) (('gc-root . root) root)
(_ #f)) (_ #f))
opts))) opts)))
(if (assoc-ref opts 'dry-run?)
(format (current-error-port) (show-what-to-build (%store) drv (assoc-ref opts 'dry-run?))
(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*))
;; TODO: Add more options. ;; TODO: Add more options.
(set-build-options (%store) (set-build-options (%store)
......
...@@ -380,32 +380,6 @@ (define (guile-missing?) ...@@ -380,32 +380,6 @@ (define (guile-missing?)
(let ((out (derivation-path->output-path (%guile-for-build)))) (let ((out (derivation-path->output-path (%guile-for-build))))
(not (valid-path? (%store) out)))) (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 (define newest-available-packages
(memoize find-newest-available-packages)) (memoize find-newest-available-packages))
...@@ -589,7 +563,7 @@ (define (same? d1 d2) ...@@ -589,7 +563,7 @@ (define (same? d1 d2)
(when (equal? profile %current-profile) (when (equal? profile %current-profile)
(ensure-default-profile)) (ensure-default-profile))
(show-what-to-build drv dry-run?) (show-what-to-build (%store) drv dry-run?)
(or dry-run? (or dry-run?
(and (build-derivations (%store) drv) (and (build-derivations (%store) drv)
......
...@@ -22,17 +22,20 @@ (define-module (guix ui) ...@@ -22,17 +22,20 @@ (define-module (guix ui)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix config) #:use-module (guix config)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix derivations)
#:use-module ((guix licenses) #:select (license? license-name)) #:use-module ((guix licenses) #:select (license? license-name))
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-34) #:use-module (srfi srfi-34)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 format)
#:export (_ #:export (_
N_ N_
leave leave
show-version-and-exit show-version-and-exit
show-bug-report-information show-bug-report-information
show-what-to-build
call-with-error-handling call-with-error-handling
with-error-handling with-error-handling
location->string location->string
...@@ -112,6 +115,32 @@ (define (call-with-error-handling thunk) ...@@ -112,6 +115,32 @@ (define (call-with-error-handling thunk)
(nix-protocol-error-message c)))) (nix-protocol-error-message c))))
(thunk))) (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 (define-syntax with-error-handling
(syntax-rules () (syntax-rules ()
"Run BODY within a user-friendly error condition handler." "Run BODY within a user-friendly error condition handler."
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment