07/08: ui: 'show-what-to-build' warns when we don't have enough disk space.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit dcfc6f213b287778b5dc6ea4a8d34f5e1368752b
Author: Ludovic Courtès <address@hidden>
Date:   Wed May 31 15:26:21 2017 +0200

    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'.
---
 guix/ui.scm | 21 +++++++++++++++++++--
 1 file changed, 19 insertions(+), 2 deletions(-)

diff --git a/guix/ui.scm b/guix/ui.scm
index 04700a6..5060fd6 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*