guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

11/11: guix system: Clarify 'perform-action'.


From: Ludovic Courtès
Subject: 11/11: guix system: Clarify 'perform-action'.
Date: Sun, 18 Nov 2018 17:40:58 -0500 (EST)

civodul pushed a commit to branch master
in repository guix.

commit ab6caf4f1d94a5e8f58cbdfde15d7bef77eb25c4
Author: Ludovic Courtès <address@hidden>
Date:   Fri Nov 16 10:12:10 2018 +0100

    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(-)

diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 6f00f12..6cf3704 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 "/"))))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]