nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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'.
This commit is contained in:
Ludovic Courtès 2017-05-31 15:26:21 +02:00
parent 65f224dc8d
commit dcfc6f213b
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 19 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
guix/ui.scm
View File

@ -38,7 +38,8 @@
#:use-module (guix serialization) #:use-module (guix serialization)
#:use-module ((guix build utils) #:select (mkdir-p)) #:use-module ((guix build utils) #:select (mkdir-p))
#:use-module ((guix licenses) #:select (license? license-name)) #: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-1)
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
#:use-module (srfi srfi-19) #:use-module (srfi srfi-19)
@ -581,6 +582,17 @@ error."
(derivation->output-path derivation out-name))) (derivation->output-path derivation out-name)))
(derivation-outputs derivation)))) (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 (define* (show-what-to-build store drv
#:key dry-run? (use-substitutes? #t) #:key dry-run? (use-substitutes? #t)
(mode (build-mode normal))) (mode (build-mode normal)))
@ -631,7 +643,9 @@ report what is prerequisites are available for download."
substitutable-references substitutable-references
download)))) download))))
download))) download)))
;; TODO: Show the installed size of DOWNLOAD. (define installed-size
(reduce + 0 (map substitutable-nar-size download)))
(define download-size (define download-size
(/ (reduce + 0 (map substitutable-download-size download)) (/ (reduce + 0 (map substitutable-download-size download))
1e6)) 1e6))
@ -682,6 +696,9 @@ report what is prerequisites are available for download."
(length download)) (length download))
(null? download) (null? download)
(map substitutable-path download))))) (map substitutable-path download)))))
(check-available-space installed-size)
(pair? build))) (pair? build)))
(define show-what-to-build* (define show-what-to-build*