diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 14488107b8..6f00f12509 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -175,12 +175,16 @@ TARGET, and register them." (return *unspecified*))) -(define* (install-bootloader installer-drv +(define* (install-bootloader installer #:key bootcfg bootcfg-file target) - "Call INSTALLER-DRV with error handling, in %STORE-MONAD." - (with-monad %store-monad + "Run INSTALLER, a bootloader installation script, with error handling, in +%STORE-MONAD." + (mlet %store-monad ((installer-drv (if installer + (lower-object installer) + (return #f))) + (bootcfg (lower-object bootcfg))) (let* ((gc-root (string-append target %gc-roots-directory "/bootcfg")) (temp-gc-root (string-append gc-root ".new")) @@ -790,19 +794,18 @@ checking this by themselves in their 'check' procedure." (warning (G_ "Consider running 'guix pull' before 'reconfigure'.~%")) (warning (G_ "Failing to do that may downgrade your system!~%")))) -(define (bootloader-installer-derivation installer - bootloader device target) +(define (bootloader-installer-script installer + bootloader device target) "Return a file calling INSTALLER gexp with given BOOTLOADER, DEVICE and TARGET arguments." - (with-monad %store-monad - (gexp->file "bootloader-installer" - (with-imported-modules '((gnu build bootloader) - (guix build utils)) - #~(begin - (use-modules (gnu build bootloader) - (guix build utils) - (ice-9 binary-ports)) - (#$installer #$bootloader #$device #$target)))))) + (scheme-file "bootloader-installer" + (with-imported-modules '((gnu build bootloader) + (guix build utils)) + #~(begin + (use-modules (gnu build bootloader) + (guix build utils) + (ice-9 binary-ports)) + (#$installer #$bootloader #$device #$target))))) (define* (perform-action action os #:key skip-safety-checks? @@ -851,31 +854,31 @@ static checks." #:mappings mappings)) (bootloader -> (bootloader-configuration-bootloader (operating-system-bootloader os))) - (bootcfg (if (eq? 'container action) - (return #f) - (lower-object - (operating-system-bootcfg - os - (if (eq? 'init action) - '() - (map boot-parameters->menu-entry - (profile-boot-parameters))))))) + (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-derivation installer - (bootloader-package bootloader) - bootloader-target 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. ;; See . - (drvs -> (if (memq action '(init reconfigure)) - (if install-bootloader? - (list sys bootcfg bootloader-installer) - (list sys bootcfg)) - (list sys))) + (drvs (mapm %store-monad lower-object + (if (memq action '(init reconfigure)) + (if install-bootloader? + (list sys bootcfg bootloader-installer) + (list sys bootcfg)) + (list sys)))) (% (if derivations-only? (return (for-each (compose println derivation-file-name) drvs))