Browse Source

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.
version-0.16.0
Ludovic Courtès 4 years ago
parent
commit
46c296dcc4
No known key found for this signature in database GPG Key ID: 90B11993D9AEBB5
  1. 6
      gnu/bootloader/extlinux.scm
  2. 104
      gnu/bootloader/grub.scm
  3. 5
      gnu/bootloader/u-boot.scm
  4. 10
      gnu/system.scm

6
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))

104
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))))
;;;
@ -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))

5
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

10
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

Loading…
Cancel
Save