nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Ludovic Courtès 2018-11-15 13:32:07 +01:00
parent b297934437
commit 46c296dcc4
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
4 changed files with 56 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gnu/bootloader/extlinux.scm
View File

@ -19,12 +19,8 @@
(define-module (gnu bootloader extlinux) (define-module (gnu bootloader extlinux)
#:use-module (gnu bootloader) #:use-module (gnu bootloader)
#:use-module (gnu system)
#:use-module (gnu build bootloader)
#:use-module (gnu packages bootloaders) #:use-module (gnu packages bootloaders)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix records)
#:use-module (guix utils) #:use-module (guix utils)
#:export (extlinux-bootloader #:export (extlinux-bootloader
extlinux-bootloader-gpt)) extlinux-bootloader-gpt))
@ -78,7 +74,7 @@ TIMEOUT ~a~%"
(format port "~%")) (format port "~%"))
#~()))))) #~())))))
(gexp->derivation "extlinux.conf" builder)) (computed-file "extlinux.conf" builder))

104
gnu/bootloader/grub.scm
View File

@ -20,26 +20,18 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu bootloader grub) (define-module (gnu bootloader grub)
#:use-module (guix store)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix monads) #:use-module ((guix utils) #:select (%current-system))
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix download)
#:use-module (gnu artwork) #:use-module (gnu artwork)
#:use-module (gnu system)
#:use-module (gnu bootloader) #:use-module (gnu bootloader)
#:use-module (gnu system uuid) #:use-module (gnu system uuid)
#:use-module (gnu system file-systems) #:use-module (gnu system file-systems)
#:autoload (gnu packages bootloaders) (grub) #:autoload (gnu packages bootloaders) (grub)
#:autoload (gnu packages compression) (gzip)
#:autoload (gnu packages gtk) (guile-cairo guile-rsvg) #:autoload (gnu packages gtk) (guile-cairo guile-rsvg)
#:autoload (gnu packages guile) (guile-2.2)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (rnrs bytevectors)
#:export (grub-image #:export (grub-image
grub-image? grub-image?
grub-image-aspect-ratio grub-image-aspect-ratio
@ -121,14 +113,14 @@ otherwise."
(define* (svg->png svg #:key width height) (define* (svg->png svg #:key width height)
"Build a PNG of HEIGHT x WIDTH from SVG." "Build a PNG of HEIGHT x WIDTH from SVG."
(gexp->derivation "grub-image.png" (computed-file "grub-image.png"
(with-imported-modules '((gnu build svg)) (with-imported-modules '((gnu build svg))
(with-extensions (list guile-rsvg guile-cairo) (with-extensions (list guile-rsvg guile-cairo)
#~(begin #~(begin
(use-modules (gnu build svg)) (use-modules (gnu build svg))
(svg->png #+svg #$output (svg->png #+svg #$output
#:width #$width #:width #$width
#:height #$height)))))) #:height #$height))))))
(define* (grub-background-image config #:key (width 1024) (height 768)) (define* (grub-background-image config #:key (width 1024) (height 768))
"Return the GRUB background image defined in CONFIG with a ratio of "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-image-aspect-ratio image) ratio))
(grub-theme-images (grub-theme-images
(bootloader-theme config))))) (bootloader-theme config)))))
(if image (and image
(svg->png (grub-image-file image) (svg->png (grub-image-file image)
#:width width #:height height) #:width width #:height height))))
(with-monad %store-monad
(return #f)))))
(define* (eye-candy config store-device store-mount-point (define* (eye-candy config store-device store-mount-point
#:key system port) #: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 'grub.cfg' part concerned with graphics mode, background images, colors, and
all that. STORE-DEVICE designates the device holding the store, 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 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 (strip-mount-point store-mount-point
(file-append grub "/share/grub/unicode.pf2"))) (file-append grub "/share/grub/unicode.pf2")))
(mlet* %store-monad ((image (grub-background-image config))) (define image
(return (and image (grub-background-image config))
#~(format #$port "
(and image
#~(format #$port "
function setup_gfxterm {~a} function setup_gfxterm {~a}
# Set 'root' to the partition that contains /gnu/store. # Set 'root' to the partition that contains /gnu/store.
@ -213,14 +205,14 @@ else
set menu_color_normal=cyan/blue set menu_color_normal=cyan/blue
set menu_color_highlight=white/blue set menu_color_highlight=white/blue
fi~%" fi~%"
#$setup-gfxterm-body #$setup-gfxterm-body
#$(grub-root-search store-device font-file) #$(grub-root-search store-device font-file)
#$(setup-gfxterm config font-file) #$(setup-gfxterm config font-file)
#$(grub-setup-io config) #$(grub-setup-io config)
#$(strip-mount-point store-mount-point image) #$(strip-mount-point store-mount-point image)
#$(theme-colors grub-theme-color-normal) #$(theme-colors grub-theme-color-normal)
#$(theme-colors grub-theme-color-highlight)))))) #$(theme-colors grub-theme-color-highlight))))
;;; ;;;
@ -331,36 +323,36 @@ entries corresponding to old generations of the system."
#$(grub-root-search device kernel) #$(grub-root-search device kernel)
#$kernel (string-join (list #$@arguments)) #$kernel (string-join (list #$@arguments))
#$initrd)))) #$initrd))))
(mlet %store-monad ((sugar (eye-candy config (define sugar
(menu-entry-device (eye-candy config
(first all-entries)) (menu-entry-device (first all-entries))
(menu-entry-device-mount-point (menu-entry-device-mount-point (first all-entries))
(first all-entries)) #:system system
#:system system #:port #~port))
#:port #~port)))
(define builder (define builder
#~(call-with-output-file #$output #~(call-with-output-file #$output
(lambda (port) (lambda (port)
(format port (format port
"# This file was generated from your GuixSD configuration. Any changes "# This file was generated from your GuixSD configuration. Any changes
# will be lost upon reconfiguration. # will be lost upon reconfiguration.
") ")
#$sugar #$sugar
(format port " (format port "
set default=~a set default=~a
set timeout=~a~%" set timeout=~a~%"
#$(bootloader-configuration-default-entry config) #$(bootloader-configuration-default-entry config)
#$(bootloader-configuration-timeout config)) #$(bootloader-configuration-timeout config))
#$@(map menu-entry->gexp all-entries) #$@(map menu-entry->gexp all-entries)
#$@(if (pair? old-entries) #$@(if (pair? old-entries)
#~((format port " #~((format port "
submenu \"GNU system, old configurations...\" {~%") submenu \"GNU system, old configurations...\" {~%")
#$@(map menu-entry->gexp old-entries) #$@(map menu-entry->gexp old-entries)
(format port "}~%")) (format port "}~%"))
#~())))) #~()))))
(gexp->derivation "grub.cfg" builder))) (computed-file "grub.cfg" builder))

5
gnu/bootloader/u-boot.scm
View File

@ -20,13 +20,8 @@
(define-module (gnu bootloader u-boot) (define-module (gnu bootloader u-boot)
#:use-module (gnu bootloader extlinux) #:use-module (gnu bootloader extlinux)
#:use-module (gnu bootloader) #:use-module (gnu bootloader)
#:use-module (gnu system)
#:use-module (gnu build bootloader)
#:use-module (gnu packages bootloaders) #:use-module (gnu packages bootloaders)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix records)
#:use-module (guix utils)
#:export (u-boot-bootloader #:export (u-boot-bootloader
u-boot-a20-olinuxino-lime-bootloader u-boot-a20-olinuxino-lime-bootloader
u-boot-a20-olinuxino-lime2-bootloader u-boot-a20-olinuxino-lime2-bootloader

10
gnu/system.scm
View File

@ -948,9 +948,13 @@ listed in OS. The C library expects to find it under
(params (operating-system-boot-parameters os system root-device)) (params (operating-system-boot-parameters os system root-device))
(entry -> (boot-parameters->menu-entry params)) (entry -> (boot-parameters->menu-entry params))
(bootloader-conf -> (operating-system-bootloader os))) (bootloader-conf -> (operating-system-bootloader os)))
((bootloader-configuration-file-generator (define generate-config-file
(bootloader-configuration-bootloader bootloader-conf)) (bootloader-configuration-file-generator
bootloader-conf (list entry) #:old-entries old-entries))) (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) (define (operating-system-boot-parameters os system.drv root-device)
"Return a monadic <boot-parameters> record that describes the boot parameters "Return a monadic <boot-parameters> record that describes the boot parameters