diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2018-11-16 10:12:10 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2018-11-18 23:37:45 +0100 |
| commit | ab6caf4f1d94a5e8f58cbdfde15d7bef77eb25c4 (patch) | |
| tree | 668faf34b4b19a2ae05d350d8ece0c7596b66b0e | |
| parent | 52ee4479ef26826a53b9929cd00ca7738be687b1 (diff) | |
| download | gnu-guix-ab6caf4f1d94a5e8f58cbdfde15d7bef77eb25c4.tar gnu-guix-ab6caf4f1d94a5e8f58cbdfde15d7bef77eb25c4.tar.gz | |
guix system: Clarify 'perform-action'.
* guix/scripts/system.scm (perform-action): Move non-monadic local
variables outside the 'mlet' form.
| -rw-r--r-- | guix/scripts/system.scm | 42 |
1 files changed, 22 insertions, 20 deletions
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 @@ static checks." (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 @@ static checks." #: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 @@ static checks." (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 @@ static checks." (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 @@ static checks." (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 "/")))) |