From ab6caf4f1d94a5e8f58cbdfde15d7bef77eb25c4 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 16 Nov 2018 10:12:10 +0100 Subject: guix system: Clarify 'perform-action'. * guix/scripts/system.scm (perform-action): Move non-monadic local variables outside the 'mlet' form. --- guix/scripts/system.scm | 42 ++++++++++++++++++++++-------------------- 1 file changed, 22 insertions(+), 20 deletions(-) (limited to 'guix/scripts') diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 6f00f12509..6cf3704d88 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -833,6 +833,25 @@ (define* (perform-action action os (define println (cut format #t "~a~%" <>)) + (define menu-entries + (if (eq? 'init action) + '() + (map boot-parameters->menu-entry (profile-boot-parameters)))) + + (define bootloader + (bootloader-configuration-bootloader (operating-system-bootloader os))) + + (define bootcfg + (and (not (eq? 'container action)) + (operating-system-bootcfg os menu-entries))) + + (define bootloader-script + (let ((installer (bootloader-installer bootloader)) + (target (or target "/"))) + (bootloader-installer-script installer + (bootloader-package bootloader) + bootloader-target target))) + (when (eq? action 'reconfigure) (maybe-suggest-running-guix-pull)) @@ -852,23 +871,6 @@ (define println #:image-size image-size #:full-boot? full-boot? #:mappings mappings)) - (bootloader -> (bootloader-configuration-bootloader - (operating-system-bootloader os))) - (bootcfg -> (and (not (eq? 'container action)) - (operating-system-bootcfg - os - (if (eq? 'init action) - '() - (map boot-parameters->menu-entry - (profile-boot-parameters)))))) - (bootcfg-file -> (bootloader-configuration-file bootloader)) - (bootloader-installer - -> - (let ((installer (bootloader-installer bootloader)) - (target (or target "/"))) - (bootloader-installer-script installer - (bootloader-package bootloader) - bootloader-target target))) ;; For 'init' and 'reconfigure', always build BOOTCFG, even if ;; --no-bootloader is passed, because we then use it as a GC root. @@ -876,7 +878,7 @@ (define println (drvs (mapm %store-monad lower-object (if (memq action '(init reconfigure)) (if install-bootloader? - (list sys bootcfg bootloader-installer) + (list sys bootcfg bootloader-script) (list sys bootcfg)) (list sys)))) (% (if derivations-only? @@ -887,7 +889,7 @@ (define println (if (or dry-run? derivations-only?) (return #f) - (begin + (let ((bootcfg-file (bootloader-configuration-file bootloader))) (for-each (compose println derivation->output-path) drvs) @@ -896,7 +898,7 @@ (define println (mbegin %store-monad (switch-to-system os) (mwhen install-bootloader? - (install-bootloader bootloader-installer + (install-bootloader bootloader-script #:bootcfg bootcfg #:bootcfg-file bootcfg-file #:target "/")))) -- cgit v1.2.3