From 46c296dcc4817f15a4b4ef7e5ef622306b4db62e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 15 Nov 2018 13:32:07 +0100 Subject: [PATCH] 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. --- 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)) 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 . (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)))) ;;; @@ -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)) 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 record that describes the boot parameters