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.
This commit is contained in:
		
							parent
							
								
									7730d112a2
								
							
						
					
					
						commit
						9bb2b96aab
					
				
					 3 changed files with 32 additions and 48 deletions
				
			
		|  | @ -241,31 +241,12 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) | ||||||
|                                          (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 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) | ||||||
|     (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 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) | ||||||
|           (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) | ||||||
|  |  | ||||||
							
								
								
									
										29
									
								
								guix/ui.scm
									
										
									
									
									
								
							
							
						
						
									
										29
									
								
								guix/ui.scm
									
										
									
									
									
								
							|  | @ -22,17 +22,20 @@ | ||||||
|   #: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 @@ General help using GNU software: <http://www.gnu.org/gethelp/>")) | ||||||
|                     (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." | ||||||
|  |  | ||||||
		Reference in a new issue