[bug#33405] [PATCH 01/10] bootloader: De-monadify configuration file generators.

["Ludovic Courtès" <ludo@gnu.org>]

* gnu/bootloader/extlinux.scm: Remove unneeded imports.
(extlinux-configuration-file): Use 'computed-file' instead of
'gexp->derivation'.
* gnu/bootloader/grub.scm (svg->png): Likewise.
(grub-background-image, eye-candy): Adjust accordingly, return
non-monadically.
(grub-configuration-file): Likewise, and use 'computed-file' instead of
'gexp->derivation'.
* gnu/bootloader/u-boot.scm: Remove unneeded imports.
* gnu/system.scm: Add 'lower-object' call.
---
 gnu/bootloader/extlinux.scm |   6 +--
 gnu/bootloader/grub.scm     | 104 +++++++++++++++++-------------------
 gnu/bootloader/u-boot.scm   |   5 --
 gnu/system.scm              |  10 ++--
 4 files changed, 56 insertions(+), 69 deletions(-)

diff --git a/gnu/bootloader/extlinux.scm b/gnu/bootloader/extlinux.scm
index 8b7a95a6fc..b48596c496 100644
--- a/gnu/bootloader/extlinux.scm
+++ b/gnu/bootloader/extlinux.scm
@@ -19,12 +19,8 @@
 
 (define-module (gnu bootloader extlinux)
   #:use-module (gnu bootloader)
-  #:use-module (gnu system)
-  #:use-module (gnu build bootloader)
   #:use-module (gnu packages bootloaders)
   #:use-module (guix gexp)
-  #:use-module (guix monads)
-  #:use-module (guix records)
   #:use-module (guix utils)
   #:export (extlinux-bootloader
             extlinux-bootloader-gpt))
@@ -78,7 +74,7 @@ TIMEOUT ~a~%"
                       (format port "~%"))
                    #~())))))
 
-  (gexp->derivation "extlinux.conf" builder))
+  (computed-file "extlinux.conf" builder))
 
 
 \f
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 06856dd58c..161e8b3d02 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -20,26 +20,18 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu bootloader grub)
-  #:use-module (guix store)
-  #:use-module (guix packages)
-  #:use-module (guix derivations)
   #:use-module (guix records)
-  #:use-module (guix monads)
+  #:use-module ((guix utils) #:select (%current-system))
   #:use-module (guix gexp)
-  #:use-module (guix download)
   #:use-module (gnu artwork)
-  #:use-module (gnu system)
   #:use-module (gnu bootloader)
   #:use-module (gnu system uuid)
   #:use-module (gnu system file-systems)
   #:autoload   (gnu packages bootloaders) (grub)
-  #:autoload   (gnu packages compression) (gzip)
   #:autoload   (gnu packages gtk) (guile-cairo guile-rsvg)
-  #:autoload   (gnu packages guile) (guile-2.2)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:use-module (srfi srfi-1)
-  #:use-module (rnrs bytevectors)
   #:export (grub-image
             grub-image?
             grub-image-aspect-ratio
@@ -121,14 +113,14 @@ otherwise."
 
 (define* (svg->png svg #:key width height)
   "Build a PNG of HEIGHT x WIDTH from SVG."
-  (gexp->derivation "grub-image.png"
-                    (with-imported-modules '((gnu build svg))
-                      (with-extensions (list guile-rsvg guile-cairo)
-                        #~(begin
-                            (use-modules (gnu build svg))
-                            (svg->png #+svg #$output
-                                      #:width #$width
-                                      #:height #$height))))))
+  (computed-file "grub-image.png"
+                 (with-imported-modules '((gnu build svg))
+                   (with-extensions (list guile-rsvg guile-cairo)
+                     #~(begin
+                         (use-modules (gnu build svg))
+                         (svg->png #+svg #$output
+                                   #:width #$width
+                                   #:height #$height))))))
 
 (define* (grub-background-image config #:key (width 1024) (height 768))
   "Return the GRUB background image defined in CONFIG with a ratio of
@@ -138,15 +130,13 @@ WIDTH/HEIGHT, or #f if none was found."
                         (= (grub-image-aspect-ratio image) ratio))
                       (grub-theme-images
                        (bootloader-theme config)))))
-    (if image
-        (svg->png (grub-image-file image)
-                  #:width width #:height height)
-        (with-monad %store-monad
-          (return #f)))))
+    (and image
+         (svg->png (grub-image-file image)
+                   #:width width #:height height))))
 
 (define* (eye-candy config store-device store-mount-point
                     #:key system port)
-  "Return in %STORE-MONAD a gexp that writes to PORT (a port-valued gexp) the
+  "Return a gexp that writes to PORT (a port-valued gexp) the
 'grub.cfg' part concerned with graphics mode, background images, colors, and
 all that.  STORE-DEVICE designates the device holding the store, and
 STORE-MOUNT-POINT is its mount point; these are used to determine where the
@@ -194,9 +184,11 @@ fi~%" #$font-file)
     (strip-mount-point store-mount-point
                        (file-append grub "/share/grub/unicode.pf2")))
 
-  (mlet* %store-monad ((image (grub-background-image config)))
-    (return (and image
-                 #~(format #$port "
+  (define image
+    (grub-background-image config))
+
+  (and image
+       #~(format #$port "
 function setup_gfxterm {~a}
 
 # Set 'root' to the partition that contains /gnu/store.
@@ -213,14 +205,14 @@ else
   set menu_color_normal=cyan/blue
   set menu_color_highlight=white/blue
 fi~%"
-                           #$setup-gfxterm-body
-                           #$(grub-root-search store-device font-file)
-                           #$(setup-gfxterm config font-file)
-                           #$(grub-setup-io config)
+                 #$setup-gfxterm-body
+                 #$(grub-root-search store-device font-file)
+                 #$(setup-gfxterm config font-file)
+                 #$(grub-setup-io config)
 
-                           #$(strip-mount-point store-mount-point image)
-                           #$(theme-colors grub-theme-color-normal)
-                           #$(theme-colors grub-theme-color-highlight))))))
+                 #$(strip-mount-point store-mount-point image)
+                 #$(theme-colors grub-theme-color-normal)
+                 #$(theme-colors grub-theme-color-highlight))))
 
 \f
 ;;;
@@ -331,36 +323,36 @@ entries corresponding to old generations of the system."
                   #$(grub-root-search device kernel)
                   #$kernel (string-join (list #$@arguments))
                   #$initrd))))
-  (mlet %store-monad ((sugar (eye-candy config
-                                        (menu-entry-device
-                                         (first all-entries))
-                                        (menu-entry-device-mount-point
-                                         (first all-entries))
-                                        #:system system
-                                        #:port #~port)))
-    (define builder
-      #~(call-with-output-file #$output
-          (lambda (port)
-            (format port
-                    "# This file was generated from your GuixSD configuration.  Any changes
+  (define sugar
+    (eye-candy config
+               (menu-entry-device (first all-entries))
+               (menu-entry-device-mount-point (first all-entries))
+               #:system system
+               #:port #~port))
+
+  (define builder
+    #~(call-with-output-file #$output
+        (lambda (port)
+          (format port
+                  "# This file was generated from your GuixSD configuration.  Any changes
 # will be lost upon reconfiguration.
 ")
-            #$sugar
-            (format port "
+          #$sugar
+          (format port "
 set default=~a
 set timeout=~a~%"
-                    #$(bootloader-configuration-default-entry config)
-                    #$(bootloader-configuration-timeout config))
-            #$@(map menu-entry->gexp all-entries)
+                  #$(bootloader-configuration-default-entry config)
+                  #$(bootloader-configuration-timeout config))
+          #$@(map menu-entry->gexp all-entries)
 
-            #$@(if (pair? old-entries)
-                   #~((format port "
+          #$@(if (pair? old-entries)
+                 #~((format port "
 submenu \"GNU system, old configurations...\" {~%")
-                      #$@(map menu-entry->gexp old-entries)
-                      (format port "}~%"))
-                   #~()))))
+                    #$@(map menu-entry->gexp old-entries)
+                    (format port "}~%"))
+                 #~()))))
 
-    (gexp->derivation "grub.cfg" builder)))
+  (computed-file "grub.cfg" builder))
 
 \f
 
diff --git a/gnu/bootloader/u-boot.scm b/gnu/bootloader/u-boot.scm
index 0157fde3da..b5fab14e14 100644
--- a/gnu/bootloader/u-boot.scm
+++ b/gnu/bootloader/u-boot.scm
@@ -20,13 +20,8 @@
 (define-module (gnu bootloader u-boot)
   #:use-module (gnu bootloader extlinux)
   #:use-module (gnu bootloader)
-  #:use-module (gnu system)
-  #:use-module (gnu build bootloader)
   #:use-module (gnu packages bootloaders)
   #:use-module (guix gexp)
-  #:use-module (guix monads)
-  #:use-module (guix records)
-  #:use-module (guix utils)
   #:export (u-boot-bootloader
             u-boot-a20-olinuxino-lime-bootloader
             u-boot-a20-olinuxino-lime2-bootloader
diff --git a/gnu/system.scm b/gnu/system.scm
index 99bc09873d..93340cccd2 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -948,9 +948,13 @@ listed in OS.  The C library expects to find it under
        (params (operating-system-boot-parameters os system root-device))
        (entry -> (boot-parameters->menu-entry params))
        (bootloader-conf -> (operating-system-bootloader os)))
-    ((bootloader-configuration-file-generator
-      (bootloader-configuration-bootloader bootloader-conf))
-     bootloader-conf (list entry) #:old-entries old-entries)))
+    (define generate-config-file
+      (bootloader-configuration-file-generator
+       (bootloader-configuration-bootloader bootloader-conf)))
+
+    ;; TODO: Remove the 'lower-object' call to make it non-monadic.
+    (lower-object (generate-config-file bootloader-conf (list entry)
+                                        #:old-entries old-entries))))
 
 (define (operating-system-boot-parameters os system.drv root-device)
   "Return a monadic <boot-parameters> record that describes the boot parameters
-- 
2.19.1