diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2017-05-31 15:26:21 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2017-06-02 18:47:07 +0200 |
| commit | dcfc6f213b287778b5dc6ea4a8d34f5e1368752b (patch) | |
| tree | 63672cec1f2b2e6a56efb4eb4bc784f9b754d72b | |
| parent | 65f224dc8d9568232baa07f28474ba5c90f07428 (diff) | |
| download | patches-dcfc6f213b287778b5dc6ea4a8d34f5e1368752b.tar patches-dcfc6f213b287778b5dc6ea4a8d34f5e1368752b.tar.gz | |
ui: 'show-what-to-build' warns when we don't have enough disk space.
* guix/ui.scm (check-available-space): New procedure.
(show-what-to-build): Compute 'installed-size' and call
'check-available-space'.
| -rw-r--r-- | guix/ui.scm | 21 |
1 files changed, 19 insertions, 2 deletions
diff --git a/guix/ui.scm b/guix/ui.scm index 04700a6d20..5060fd6dc7 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -38,7 +38,8 @@ #:use-module (guix serialization) #:use-module ((guix build utils) #:select (mkdir-p)) #:use-module ((guix licenses) #:select (license? license-name)) - #:use-module ((guix build syscalls) #:select (terminal-columns)) + #:use-module ((guix build syscalls) + #:select (free-disk-space terminal-columns)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) @@ -581,6 +582,17 @@ error." (derivation->output-path derivation out-name))) (derivation-outputs derivation)))) +(define (check-available-space need) + "Make sure at least NEED bytes are available in the store. Otherwise emit a +warning." + (let ((free (catch 'system-error + (lambda () + (free-disk-space (%store-prefix))) + (const #f)))) + (when (and free (>= need free)) + (warning (G_ "at least ~,1h MB needed but only ~,1h MB available in ~a~%") + (/ need 1e6) (/ free 1e6) (%store-prefix))))) + (define* (show-what-to-build store drv #:key dry-run? (use-substitutes? #t) (mode (build-mode normal))) @@ -631,7 +643,9 @@ report what is prerequisites are available for download." substitutable-references download)))) download))) - ;; TODO: Show the installed size of DOWNLOAD. + (define installed-size + (reduce + 0 (map substitutable-nar-size download))) + (define download-size (/ (reduce + 0 (map substitutable-download-size download)) 1e6)) @@ -682,6 +696,9 @@ report what is prerequisites are available for download." (length download)) (null? download) (map substitutable-path download))))) + + (check-available-space installed-size) + (pair? build))) (define show-what-to-build* |