bootloader: De-monadify configuration file generators.

* 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.
2024-12-24 21:38:07 -05:00 · 2018-11-15 13:32:07 +01:00 · 2018-11-15 13:32:07 +01:00 · 46c296dcc4
commit 46c296dcc4
parent b297934437
4 changed files with 56 additions and 69 deletions
--- 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 @@ (define builder
                      (format port "~%"))
                   #~())))))

-  (gexp->derivation "extlinux.conf" builder))
+  (computed-file "extlinux.conf" builder))



--- 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 @@ (define (bootloader-theme config)

 (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 @@ (define* (grub-background-image config #:key (width 1024) (height 768))
                        (= (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 @@ (define 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 @@ (define font-file
  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))))


 ;;;
@ -331,36 +323,36 @@ (define (menu-entry->gexp entry)
                  #$(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))



--- 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
--- a/gnu/system.scm
+++ b/gnu/system.scm
@ -948,9 +948,13 @@ (define* (operating-system-bootcfg os #:optional (old-entries '()))
       (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