[bug#39734] [PATCH] scripts: Emit GC hint if free space is lower than absolute and relative threshold.

[Pierre Neidhardt]

* guix/scripts.scm (%disk-space-warning-absolute): New variable.
(warn-about-disk-space): Test against %disk-space-warning-absolute.
Fix error in display-hint due to extraneous 'profile' argument.
---
 guix/scripts.scm | 24 +++++++++++++++++-------
 1 file changed, 17 insertions(+), 7 deletions(-)

diff --git a/guix/scripts.scm b/guix/scripts.scm
index 77cbf12350..f8cce3a542 100644
--- a/guix/scripts.scm
+++ b/guix/scripts.scm
@@ -188,25 +188,35 @@ Show what and how will/would be built."
                     (#f        .05)               ;5%
                     (threshold (/ threshold 100.)))))
 
+(define %disk-space-warning-absolute
+  ;; The decimal number of GiB of free disk space below which a warning is
+  ;; emitted.
+  (make-parameter (match (and=> (getenv "GUIX_DISK_SPACE_WARNING_ABSOLUTE")
+                                string->number)
+                    (#f        17.0)
+                    (threshold threshold))))
+
 (define* (warn-about-disk-space #:optional profile
                                 #:key
-                                (threshold (%disk-space-warning)))
+                                (relative-threshold (%disk-space-warning))
+                                (absolute-threshold 
(%disk-space-warning-absolute)))
   "Display a hint about 'guix gc' if less than THRESHOLD of /gnu/store is
 available."
   (let* ((stats      (statfs (%store-prefix)))
          (block-size (file-system-block-size stats))
          (available  (* block-size (file-system-blocks-available stats)))
          (total      (* block-size (file-system-block-count stats)))
-         (ratio      (/ available total 1.)))
-    (when (< ratio threshold)
-      (warning (G_ "only ~,1f% of free space available on ~a~%")
-               (* ratio 100) (%store-prefix))
+         (relative-threshold-in-bytes (* total relative-threshold))
+         (absolute-threshold-in-bytes (* 1024 1024 1024 absolute-threshold)))
+    (when (< available (min relative-threshold-in-bytes
+                            absolute-threshold-in-bytes))
+      (warning (G_ "only ~,1f GiB of free space available on ~a~%")
+               available (%store-prefix))
       (display-hint (format #f (G_ "Consider deleting old profile
 generations and collecting garbage, along these lines:
 
 @example
 guix gc --delete-generations=1m
-@end example\n")
-                            profile)))))
+@end example\n"))))))
 
 ;;; scripts.scm ends here
-- 
2.25.0