bug#26339: [PATCH v3 7/9] scripts: system: Adapt "init" to new bootloader API.

[Mathieu Othacehe <m.othacehe@gmail.com>]

* guix/scripts/system.scm (install): Pass installer a new
argument. Rename other arguments.
Call install-bootloader instead of install-grub*.
(perform-action): Adapt.
---
 guix/scripts/system.scm | 46 ++++++++++++++++++++++++++++------------------
 1 file changed, 28 insertions(+), 18 deletions(-)

diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 0a066853a..b3e2d7b72 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -178,12 +178,14 @@ TARGET, and register them."
 
 (define* (install os-drv target
                   #:key (log-port (current-output-port))
-                  grub? grub.cfg device)
-  "Copy the closure of GRUB.CFG, which includes the output of OS-DRV, to
+                  installer install-bootloader?
+                  bootcfg bootcfg-location
+                  device)
+  "Copy the closure of BOOTCFG, which includes the output of OS-DRV, to
 directory TARGET.  TARGET must be an absolute directory name since that's what
 'guix-register' expects.
 
-When GRUB? is true, install GRUB on DEVICE, using GRUB.CFG."
+When INSTALL-BOOTLOADER? is true, install bootloader on DEVICE, using BOOTCFG."
   (define (maybe-copy to-copy)
     (with-monad %store-monad
       (if (string=? target "/")
@@ -212,16 +214,21 @@ the ownership of '~a' may be incorrect!~%")
         (populate (lift2 populate-root-file-system %store-monad)))
 
     (mbegin %store-monad
-      ;; Copy the closure of GRUB.CFG, which includes OS-DIR, GRUB's
-      ;; background image and so on.
-      (maybe-copy grub.cfg)
+      ;; Copy the closure of BOOTCFG, which includes OS-DIR,
+      ;; eventual background image and so on.
+      (maybe-copy
+       (derivation->output-path bootcfg))
 
       ;; Create a bunch of additional files.
       (format log-port "populating '~a'...~%" target)
       (populate os-dir target)
 
-      (mwhen grub?
-        (install-grub* grub.cfg device target)))))
+      (mwhen install-bootloader?
+        (install-bootloader installer
+                            #:bootcfg bootcfg
+                            #:bootcfg-location bootcfg-location
+                            #:device device
+                            #:target target)))))
 
 \f
 ;;;
@@ -589,12 +596,13 @@ PATTERN, a string.  When PATTERN is #f, display all the system generations."
                                            #$target))))))
 
 (define* (perform-action action os
-                         #:key bootloader? dry-run? derivations-only?
+                         #:key install-bootloader?
+                         dry-run? derivations-only?
                          use-substitutes? device target
                          image-size full-boot?
                          (mappings '())
                          (gc-root #f))
-  "Perform ACTION for OS.  BOOTLOADER? specifies whether to install
+  "Perform ACTION for OS.  INSTALL-BOOTLOADER? specifies whether to install
 bootloader; DEVICE is the target devices for bootloader; TARGET is the target
 root directory; IMAGE-SIZE is the size of the image to be built, for the
 'vm-image' and 'disk-image' actions.  FULL-BOOT? is used for the 'vm' action;
@@ -630,7 +638,7 @@ output when building a system derivation, such as a disk image."
                           (profile-boot-parameters)))))
        (bootcfg-location -> (bootloader-configuration-file-name
                              (operating-system-bootloader os)))
-       (install-proc
+       (installer
         (let ((procedure (bootloader-configuration-installer
                           (operating-system-bootloader os)))
               (target    (or target "/")))
@@ -640,8 +648,8 @@ output when building a system derivation, such as a disk image."
        ;; --no-bootloader is passed, because we then use it as a GC root.
        ;; See <http://bugs.gnu.org/21068>.
        (drvs   -> (if (memq action '(init reconfigure))
-                      (if (and bootloader? bootloader)
-                          (list sys bootcfg bootloader install-proc)
+                      (if (and install-bootloader? bootloader)
+                          (list sys bootcfg bootloader installer)
                           (list sys bootcfg))
                       (list sys)))
        (%         (if derivations-only?
@@ -660,8 +668,8 @@ output when building a system derivation, such as a disk image."
             ((reconfigure)
              (mbegin %store-monad
                (switch-to-system os)
-               (mwhen bootloader?
-                 (install-bootloader install-proc
+               (mwhen install-bootloader?
+                 (install-bootloader installer
                                      #:bootcfg bootcfg
                                      #:bootcfg-location bootcfg-location
                                      #:device device
@@ -671,8 +679,10 @@ output when building a system derivation, such as a disk image."
              (format #t (G_ "initializing operating system under '~a'...~%")
                      target)
              (install sys (canonicalize-path target)
-                      #:grub? bootloader?
-                      #:grub.cfg (derivation->output-path grub.cfg)
+                      #:install-bootloader? install-bootloader?
+                      #:bootcfg bootcfg
+                      #:bootcfg-location bootcfg-location
+                      #:installer installer
                       #:device device))
             (else
              ;; All we had to do was to build SYS and maybe register an
@@ -884,7 +894,7 @@ resulting from command-line parsing."
                                                        m)
                                                       (_ #f))
                                                     opts)
-                             #:bootloader? bootloader?
+                             #:install-bootloader? bootloader?
                              #:target target #:device device
                              #:gc-root (assoc-ref opts 'gc-root)))))
         #:system system))))
-- 
2.12.2