[jackhill/guix/guix.git] / guix / scripts.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Deck Pickard <deck.r.pickard@gmail.com>
;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (guix scripts)
  #:use-module (guix grafts)
  #:use-module (guix utils)
  #:use-module (guix ui)
  #:use-module (guix store)
  #:use-module (guix monads)
  #:use-module (guix packages)
  #:use-module (guix derivations)
  #:use-module ((guix profiles) #:select (%profile-directory))
  #:autoload   (guix describe) (current-profile-date)
  #:use-module (guix build syscalls)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-19)
  #:use-module (srfi srfi-37)
  #:use-module (ice-9 match)
  #:export (synopsis
            category
            define-command
            %command-categories

            args-fold*
            parse-command-line
            maybe-build
            build-package
            build-package-source
            %distro-age-warning
            warn-about-old-distro
            %disk-space-warning
            warn-about-disk-space))

;;; Commentary:
;;;
;;; General code for Guix scripts.
;;;
;;; Code:

;; Syntactic keywords.
(define synopsis 'command-synopsis)
(define category 'command-category)

(define-syntax define-command-categories
  (syntax-rules (G_)
    "Define command categories."
    ((_ name assert-valid (identifiers (G_ synopses)) ...)
     (begin
       (define-public identifiers
         ;; Define and export syntactic keywords.
         (list 'syntactic-keyword-for-command-category))
       ...

       (define-syntax assert-valid
         ;; Validate at expansion time that we're passed a valid category.
         (syntax-rules (identifiers ...)
           ((_ identifiers) #t)
           ...))

       (define name
         ;; Alist mapping category name to synopsis.
         `((identifiers . synopses) ...))))))

;; Command categories.
(define-command-categories %command-categories
  assert-valid-command-category
  (main        (G_ "main commands"))
  (development (G_ "software development commands"))
  (packaging   (G_ "packaging commands"))
  (plumbing    (G_ "plumbing commands"))
  (internal    (G_ "internal commands")))

(define-syntax define-command
  (syntax-rules (category synopsis)
    "Define the given command as a procedure along with its synopsis and,
optionally, its category.  The synopsis becomes the docstring of the
procedure, but both the category and synopsis are meant to be read (parsed) by
'guix help'."
    ;; The (synopsis ...) form is here so that xgettext sees those strings as
    ;; translatable.
    ((_ (name . args)
        (synopsis doc) body ...)
     (define (name . args)
       doc
       body ...))
    ((_ (name . args)
        (category cat) (synopsis doc)
        body ...)
     (begin
       (assert-valid-command-category cat)
       (define (name . args)
         doc
         body ...)))))

(define (args-fold* args options unrecognized-option-proc operand-proc . seeds)
  "A wrapper on top of `args-fold' that does proper user-facing error
reporting."
  (catch 'misc-error
    (lambda ()
      (apply args-fold args options unrecognized-option-proc
             operand-proc seeds))
    (lambda (key proc msg args . rest)
      ;; XXX: MSG is not i18n'd.
      (leave (G_ "invalid argument: ~a~%")
             (apply format #f msg args)))))

(define (environment-build-options)
  "Return additional build options passed as environment variables."
  (arguments-from-environment-variable "GUIX_BUILD_OPTIONS"))

(define %default-argument-handler
  ;; The default handler for non-option command-line arguments.
  (lambda (arg result)
    (alist-cons 'argument arg result)))

(define* (parse-command-line args options seeds
                             #:key
                             (build-options? #t)
                             (argument-handler %default-argument-handler))
  "Parse the command-line arguments ARGS according to OPTIONS (a list of
SRFI-37 options) and return the result, seeded by SEEDS.  When BUILD-OPTIONS?
is true, also pass arguments passed via the 'GUIX_BUILD_OPTIONS' environment
variable.  Command-line options take precedence those passed via
'GUIX_BUILD_OPTIONS'.

ARGUMENT-HANDLER is called for non-option arguments, like the 'operand-proc'
parameter of 'args-fold'."
  (define (parse-options-from args seeds)
    ;; Actual parsing takes place here.
    (apply args-fold* args options
           (lambda (opt name arg . rest)
             (leave (G_ "~A: unrecognized option~%") name))
           argument-handler
           seeds))

  (call-with-values
      (lambda ()
        (if build-options?
            (parse-options-from (environment-build-options) seeds)
            (apply values seeds)))
    (lambda seeds
      ;; ARGS take precedence over what the environment variable specifies.
      (parse-options-from args seeds))))

(define* (maybe-build drvs
                      #:key dry-run? use-substitutes?)
  "Show what will/would be built, and actually build DRVS, unless DRY-RUN? is
true."
  (with-monad %store-monad
    (>>= (show-what-to-build* drvs
                              #:dry-run? dry-run?
                              #:use-substitutes? use-substitutes?)
         (lambda (_)
           (if dry-run?
               (return #f)
               (built-derivations drvs))))))

(define* (build-package package
                        #:key dry-run? (use-substitutes? #t)
                        #:allow-other-keys
                        #:rest build-options)
  "Build PACKAGE using BUILD-OPTIONS acceptable by 'set-build-options'.
Show what and how will/would be built."
  (mlet %store-monad ((grafting? ((lift0 %graft? %store-monad))))
    (apply set-build-options*
           #:use-substitutes? use-substitutes?
           (strip-keyword-arguments '(#:dry-run?) build-options))
    (mlet %store-monad ((derivation (package->derivation
                                     package #:graft? (and (not dry-run?)
                                                           grafting?))))
      (mbegin %store-monad
        (maybe-build (list derivation)
                     #:use-substitutes? use-substitutes?
                     #:dry-run? dry-run?)
        (return (show-derivation-outputs derivation))))))

(define* (build-package-source package
                               #:key dry-run? (use-substitutes? #t)
                               #:allow-other-keys
                               #:rest build-options)
  "Build PACKAGE source using BUILD-OPTIONS."
  (mbegin %store-monad
    (apply set-build-options*
           #:use-substitutes? use-substitutes?
           (strip-keyword-arguments '(#:dry-run?) build-options))
    (mlet %store-monad ((derivation (origin->derivation
                                     (package-source package))))
      (mbegin %store-monad
        (maybe-build (list derivation)
                     #:use-substitutes? use-substitutes?
                     #:dry-run? dry-run?)
        (return (show-derivation-outputs derivation))))))

(define %distro-age-warning
  ;; The age (in seconds) above which we warn that the distro is too old.
  (make-parameter (match (and=> (getenv "GUIX_DISTRO_AGE_WARNING")
                                string->duration)
                    (#f  (* 7 24 3600))
                    (age (time-second age)))))

(define* (warn-about-old-distro #:optional (old (%distro-age-warning))
                                #:key (suggested-command
                                       "guix package -u"))
  "Emit a warning if Guix is older than OLD seconds."
  (define (seconds->days seconds)
    (round (/ seconds (* 3600 24))))

  (define age
    (match (current-profile-date)
      (#f    #f)
      (date  (- (time-second (current-time time-utc))
                date))))

  (when (and age (>= age old))
    (warning (N_ "Your Guix installation is ~a day old.\n"
                 "Your Guix installation is ~a days old.\n"
                 (seconds->days age))
             (seconds->days age)))
  (when (and (or (not age) (>= age old))
             (not (getenv "GUIX_UNINSTALLED")))
    (warning (G_ "Consider running 'guix pull' followed by
'~a' to get up-to-date packages and security updates.\n")
             suggested-command)
    (newline (guix-warning-port))))

(define %disk-space-warning
  ;; Return a pair of absolute threshold (number of bytes) and relative
  ;; threshold (fraction between 0 and 1) for the free disk space below which
  ;; a warning is emitted.
  ;; GUIX_DISK_SPACE_WARNING can contain both thresholds.  A value in [0;100)
  ;; is a relative threshold, otherwise it's absolute.  The following
  ;; example values are valid:
  ;; - 1GiB;10%      ;1 GiB absolute, and 10% relative.
  ;; - 15G           ;15 GiB absolute, and default relative.
  ;; - 99%           ;99% relative, and default absolute.
  ;; - 99            ;Same.
  ;; - 100           ;100 absolute, and default relative.
  (let* ((default-absolute-threshold (size->number "5GiB"))
         (default-relative-threshold 0.05)
         (percentage->float (lambda (percentage)
                              (or (and=> (string->number
                                          (car (string-split percentage #\%)))
                                         (lambda (n) (/ n 100.0)))
                                  default-relative-threshold)))
         (size->number* (lambda (size)
                          (or (false-if-exception (size->number size))
                              default-absolute-threshold)))
         (absolute? (lambda (size)
                      (not (or (string-suffix? "%" size)
                               (false-if-exception (< (size->number size) 100)))))))
    (make-parameter
     (match (getenv "GUIX_DISK_SPACE_WARNING")
       (#f (list default-absolute-threshold
                 default-relative-threshold))
       (env-string (match (string-split env-string #\;)
                     ((threshold)
                      (if (absolute? threshold)
                          (list (size->number* threshold)
                                default-relative-threshold)
                          (list default-absolute-threshold
                                (percentage->float threshold))))
                     ((threshold1 threshold2)
                      (if (absolute? threshold1)
                          (list (size->number* threshold1)
                                (percentage->float threshold2))
                          (list (size->number* threshold2)
                                (percentage->float threshold1))))))))))

(define* (warn-about-disk-space #:optional profile
                                #:key
                                (thresholds (%disk-space-warning)))
  "Display a hint about 'guix gc' if less than THRESHOLD of /gnu/store is
available.
THRESHOLDS is a pair (ABSOLUTE-THRESHOLD . RELATIVE-THRESHOLD)."
  (define GiB (expt 2 30))

  (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)))
         (relative-threshold-in-bytes (* total (cadr thresholds)))
         (absolute-threshold-in-bytes (car thresholds)))
    (when (< available (min relative-threshold-in-bytes
                            absolute-threshold-in-bytes))
      (warning (G_ "only ~,1f GiB of free space available on ~a~%")
               (/ available 1. GiB) (%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"))))))

;;; scripts.scm ends here
Commit	Line	Data
88981dd3	1	;;; GNU Guix --- Functional package management for GNU
71c3c3df	2	;;; Copyright © 2013, 2014, 2015, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
88981dd3	3	;;; Copyright © 2014 Deck Pickard <deck.r.pickard@gmail.com>
a82a201a	4	;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
fdef0d85	5	;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
88981dd3 AK	6	;;;
	7	;;; This file is part of GNU Guix.
	8	;;;
	9	;;; GNU Guix is free software; you can redistribute it and/or modify it
	10	;;; under the terms of the GNU General Public License as published by
	11	;;; the Free Software Foundation; either version 3 of the License, or (at
	12	;;; your option) any later version.
	13	;;;
	14	;;; GNU Guix is distributed in the hope that it will be useful, but
	15	;;; WITHOUT ANY WARRANTY; without even the implied warranty of
	16	;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	17	;;; GNU General Public License for more details.
	18	;;;
	19	;;; You should have received a copy of the GNU General Public License
	20	;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
	21
	22	(define-module (guix scripts)
a82a201a	23	#:use-module (guix grafts)
88981dd3 AK	24	#:use-module (guix utils)
88981dd3 AK	25	#:use-module (guix ui)
430505eb AK	26	#:use-module (guix store)
	27	#:use-module (guix monads)
	28	#:use-module (guix packages)
	29	#:use-module (guix derivations)
795d430d	30	#:use-module ((guix profiles) #:select (%profile-directory))
55da450a	31	#:autoload (guix describe) (current-profile-date)
62a14bd2	32	#:use-module (guix build syscalls)
88981dd3	33	#:use-module (srfi srfi-1)
7fd952e0	34	#:use-module (srfi srfi-19)
88981dd3 AK	35	#:use-module (srfi srfi-37)
88981dd3 AK	36	#:use-module (ice-9 match)
3794ce93 LC	37	#:export (synopsis
	38	category
	39	define-command
	40	%command-categories
	41
	42	args-fold*
430505eb AK	43	parse-command-line
430505eb AK	44	maybe-build
ad8b83bd	45	build-package
7fd952e0 LC	46	build-package-source
7fd952e0 LC	47	%distro-age-warning
62a14bd2 LC	48	warn-about-old-distro
	49	%disk-space-warning
	50	warn-about-disk-space))
88981dd3 AK	51
	52	;;; Commentary:
	53	;;;
	54	;;; General code for Guix scripts.
	55	;;;
	56	;;; Code:
	57
3794ce93 LC	58	;; Syntactic keywords.
	59	(define synopsis 'command-synopsis)
	60	(define category 'command-category)
	61
	62	(define-syntax define-command-categories
	63	(syntax-rules (G_)
	64	"Define command categories."
	65	((_ name assert-valid (identifiers (G_ synopses)) ...)
	66	(begin
	67	(define-public identifiers
	68	;; Define and export syntactic keywords.
	69	(list 'syntactic-keyword-for-command-category))
	70	...
	71
	72	(define-syntax assert-valid
	73	;; Validate at expansion time that we're passed a valid category.
	74	(syntax-rules (identifiers ...)
	75	((_ identifiers) #t)
	76	...))
	77
	78	(define name
	79	;; Alist mapping category name to synopsis.
	80	`((identifiers . synopses) ...))))))
	81
	82	;; Command categories.
	83	(define-command-categories %command-categories
	84	assert-valid-command-category
	85	(main (G_ "main commands"))
	86	(development (G_ "software development commands"))
	87	(packaging (G_ "packaging commands"))
	88	(plumbing (G_ "plumbing commands"))
	89	(internal (G_ "internal commands")))
	90
	91	(define-syntax define-command
	92	(syntax-rules (category synopsis)
	93	"Define the given command as a procedure along with its synopsis and,
	94	optionally, its category. The synopsis becomes the docstring of the
	95	procedure, but both the category and synopsis are meant to be read (parsed) by
	96	'guix help'."
	97	;; The (synopsis ...) form is here so that xgettext sees those strings as
	98	;; translatable.
	99	((_ (name . args)
	100	(synopsis doc) body ...)
	101	(define (name . args)
	102	doc
	103	body ...))
	104	((_ (name . args)
	105	(category cat) (synopsis doc)
	106	body ...)
	107	(begin
	108	(assert-valid-command-category cat)
	109	(define (name . args)
	110	doc
	111	body ...)))))
	112
fdef0d85	113	(define (args-fold* args options unrecognized-option-proc operand-proc . seeds)
88981dd3 AK	114	"A wrapper on top of `args-fold' that does proper user-facing error
	115	reporting."
	116	(catch 'misc-error
	117	(lambda ()
fdef0d85	118	(apply args-fold args options unrecognized-option-proc
88981dd3 AK	119	operand-proc seeds))
	120	(lambda (key proc msg args . rest)
	121	;; XXX: MSG is not i18n'd.
69daee23	122	(leave (G_ "invalid argument: ~a~%")
88981dd3 AK	123	(apply format #f msg args)))))
	124
	125	(define (environment-build-options)
	126	"Return additional build options passed as environment variables."
	127	(arguments-from-environment-variable "GUIX_BUILD_OPTIONS"))
	128
	129	(define %default-argument-handler
	130	;; The default handler for non-option command-line arguments.
	131	(lambda (arg result)
	132	(alist-cons 'argument arg result)))
	133
	134	(define* (parse-command-line args options seeds
	135	#:key
a1ff7e1d	136	(build-options? #t)
88981dd3	137	(argument-handler %default-argument-handler))
a1ff7e1d LC	138	"Parse the command-line arguments ARGS according to OPTIONS (a list of
	139	SRFI-37 options) and return the result, seeded by SEEDS. When BUILD-OPTIONS?
	140	is true, also pass arguments passed via the 'GUIX_BUILD_OPTIONS' environment
	141	variable. Command-line options take precedence those passed via
	142	'GUIX_BUILD_OPTIONS'.
88981dd3 AK	143
	144	ARGUMENT-HANDLER is called for non-option arguments, like the 'operand-proc'
	145	parameter of 'args-fold'."
	146	(define (parse-options-from args seeds)
	147	;; Actual parsing takes place here.
	148	(apply args-fold* args options
	149	(lambda (opt name arg . rest)
69daee23	150	(leave (G_ "~A: unrecognized option~%") name))
88981dd3 AK	151	argument-handler
	152	seeds))
	153
	154	(call-with-values
	155	(lambda ()
a1ff7e1d LC	156	(if build-options?
	157	(parse-options-from (environment-build-options) seeds)
	158	(apply values seeds)))
88981dd3 AK	159	(lambda seeds
	160	;; ARGS take precedence over what the environment variable specifies.
	161	(parse-options-from args seeds))))
	162
430505eb AK	163	(define* (maybe-build drvs
	164	#:key dry-run? use-substitutes?)
	165	"Show what will/would be built, and actually build DRVS, unless DRY-RUN? is
	166	true."
	167	(with-monad %store-monad
	168	(>>= (show-what-to-build* drvs
	169	#:dry-run? dry-run?
	170	#:use-substitutes? use-substitutes?)
	171	(lambda (_)
	172	(if dry-run?
	173	(return #f)
	174	(built-derivations drvs))))))
	175
	176	(define* (build-package package
	177	#:key dry-run? (use-substitutes? #t)
	178	#:allow-other-keys
	179	#:rest build-options)
	180	"Build PACKAGE using BUILD-OPTIONS acceptable by 'set-build-options'.
	181	Show what and how will/would be built."
a82a201a	182	(mlet %store-monad ((grafting? ((lift0 %graft? %store-monad))))
430505eb AK	183	(apply set-build-options*
	184	#:use-substitutes? use-substitutes?
	185	(strip-keyword-arguments '(#:dry-run?) build-options))
a82a201a AK	186	(mlet %store-monad ((derivation (package->derivation
	187	package #:graft? (and (not dry-run?)
	188	grafting?))))
430505eb AK	189	(mbegin %store-monad
	190	(maybe-build (list derivation)
	191	#:use-substitutes? use-substitutes?
	192	#:dry-run? dry-run?)
	193	(return (show-derivation-outputs derivation))))))
	194
ad8b83bd AK	195	(define* (build-package-source package
	196	#:key dry-run? (use-substitutes? #t)
	197	#:allow-other-keys
	198	#:rest build-options)
	199	"Build PACKAGE source using BUILD-OPTIONS."
	200	(mbegin %store-monad
	201	(apply set-build-options*
	202	#:use-substitutes? use-substitutes?
	203	(strip-keyword-arguments '(#:dry-run?) build-options))
	204	(mlet %store-monad ((derivation (origin->derivation
	205	(package-source package))))
	206	(mbegin %store-monad
	207	(maybe-build (list derivation)
	208	#:use-substitutes? use-substitutes?
	209	#:dry-run? dry-run?)
	210	(return (show-derivation-outputs derivation))))))
	211
7fd952e0 LC	212	(define %distro-age-warning
	213	;; The age (in seconds) above which we warn that the distro is too old.
	214	(make-parameter (match (and=> (getenv "GUIX_DISTRO_AGE_WARNING")
	215	string->duration)
	216	(#f (* 7 24 3600))
	217	(age (time-second age)))))
	218
	219	(define* (warn-about-old-distro #:optional (old (%distro-age-warning))
	220	#:key (suggested-command
	221	"guix package -u"))
	222	"Emit a warning if Guix is older than OLD seconds."
55da450a LC	223	(define (seconds->days seconds)
	224	(round (/ seconds (* 3600 24))))
	225
	226	(define age
	227	(match (current-profile-date)
	228	(#f #f)
	229	(date (- (time-second (current-time time-utc))
	230	date))))
	231
	232	(when (and age (>= age old))
	233	(warning (N_ "Your Guix installation is ~a day old.\n"
	234	"Your Guix installation is ~a days old.\n"
	235	(seconds->days age))
	236	(seconds->days age)))
9e5f2060 LC	237	(when (and (or (not age) (>= age old))
9e5f2060 LC	238	(not (getenv "GUIX_UNINSTALLED")))
55da450a	239	(warning (G_ "Consider running 'guix pull' followed by
7fd952e0	240	'~a' to get up-to-date packages and security updates.\n")
55da450a LC	241	suggested-command)
55da450a LC	242	(newline (guix-warning-port))))
7fd952e0	243
62a14bd2	244	(define %disk-space-warning
fb7eec3a PN	245	;; Return a pair of absolute threshold (number of bytes) and relative
	246	;; threshold (fraction between 0 and 1) for the free disk space below which
	247	;; a warning is emitted.
	248	;; GUIX_DISK_SPACE_WARNING can contain both thresholds. A value in [0;100)
	249	;; is a relative threshold, otherwise it's absolute. The following
	250	;; example values are valid:
	251	;; - 1GiB;10% ;1 GiB absolute, and 10% relative.
	252	;; - 15G ;15 GiB absolute, and default relative.
	253	;; - 99% ;99% relative, and default absolute.
	254	;; - 99 ;Same.
	255	;; - 100 ;100 absolute, and default relative.
	256	(let* ((default-absolute-threshold (size->number "5GiB"))
	257	(default-relative-threshold 0.05)
	258	(percentage->float (lambda (percentage)
	259	(or (and=> (string->number
	260	(car (string-split percentage #\%)))
	261	(lambda (n) (/ n 100.0)))
	262	default-relative-threshold)))
	263	(size->number* (lambda (size)
	264	(or (false-if-exception (size->number size))
	265	default-absolute-threshold)))
	266	(absolute? (lambda (size)
	267	(not (or (string-suffix? "%" size)
	268	(false-if-exception (< (size->number size) 100)))))))
	269	(make-parameter
	270	(match (getenv "GUIX_DISK_SPACE_WARNING")
	271	(#f (list default-absolute-threshold
	272	default-relative-threshold))
	273	(env-string (match (string-split env-string #\;)
	274	((threshold)
	275	(if (absolute? threshold)
	276	(list (size->number* threshold)
	277	default-relative-threshold)
	278	(list default-absolute-threshold
	279	(percentage->float threshold))))
	280	((threshold1 threshold2)
	281	(if (absolute? threshold1)
	282	(list (size->number* threshold1)
	283	(percentage->float threshold2))
	284	(list (size->number* threshold2)
	285	(percentage->float threshold1))))))))))
62a14bd2 LC	286
	287	(define* (warn-about-disk-space #:optional profile
	288	#:key
fb7eec3a	289	(thresholds (%disk-space-warning)))
62a14bd2	290	"Display a hint about 'guix gc' if less than THRESHOLD of /gnu/store is
fb7eec3a	291	available.
71c3c3df LC	292	THRESHOLDS is a pair (ABSOLUTE-THRESHOLD . RELATIVE-THRESHOLD)."
	293	(define GiB (expt 2 30))
	294
62a14bd2 LC	295	(let* ((stats (statfs (%store-prefix)))
	296	(block-size (file-system-block-size stats))
	297	(available (* block-size (file-system-blocks-available stats)))
	298	(total (* block-size (file-system-block-count stats)))
fb7eec3a	299	(relative-threshold-in-bytes (* total (cadr thresholds)))
71c3c3df	300	(absolute-threshold-in-bytes (car thresholds)))
1d24cc6d	301	(when (< available (min relative-threshold-in-bytes
fb7eec3a PN	302	absolute-threshold-in-bytes))
fb7eec3a PN	303	(warning (G_ "only ~,1f GiB of free space available on ~a~%")
71c3c3df	304	(/ available 1. GiB) (%store-prefix))
9c074f61	305	(display-hint (format #f (G_ "Consider deleting old profile
62a14bd2 LC	306	generations and collecting garbage, along these lines:
	307
	308	@example
9c074f61	309	guix gc --delete-generations=1m
fb7eec3a	310	@end example\n"))))))
62a14bd2	311
88981dd3	312	;;; scripts.scm ends here