summaryrefslogtreecommitdiff
path: root/gnu/bootloader
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-11-15 13:32:07 +0100
committerLudovic Courtès <ludo@gnu.org>2018-11-18 23:37:44 +0100
commit46c296dcc4817f15a4b4ef7e5ef622306b4db62e (patch)
tree3d4ce8d6ff27295b1dbfd1ae267a50e8f339daaf /gnu/bootloader
parentb297934437932de730432629b361fcb422accbb7 (diff)
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.
Diffstat (limited to 'gnu/bootloader')
-rw-r--r--gnu/bootloader/extlinux.scm6
-rw-r--r--gnu/bootloader/grub.scm104
-rw-r--r--gnu/bootloader/u-boot.scm5
3 files changed, 49 insertions, 66 deletions
diff --git a/gnu/bootloader/extlinux.scm b/gnu/bootloader/extlinux.scm
index 8b7a95a6fc4..b48596c4969 100644
--- a/gnu/bootloader/extlinux.scm
+++ b/gnu/bootloader/extlinux.scm
@@ -19,12 +19,8 @@
19 19
20(define-module (gnu bootloader extlinux) 20(define-module (gnu bootloader extlinux)
21 #:use-module (gnu bootloader) 21 #:use-module (gnu bootloader)
22 #:use-module (gnu system)
23 #:use-module (gnu build bootloader)
24 #:use-module (gnu packages bootloaders) 22 #:use-module (gnu packages bootloaders)
25 #:use-module (guix gexp) 23 #:use-module (guix gexp)
26 #:use-module (guix monads)
27 #:use-module (guix records)
28 #:use-module (guix utils) 24 #:use-module (guix utils)
29 #:export (extlinux-bootloader 25 #:export (extlinux-bootloader
30 extlinux-bootloader-gpt)) 26 extlinux-bootloader-gpt))
@@ -78,7 +74,7 @@ TIMEOUT ~a~%"
78 (format port "~%")) 74 (format port "~%"))
79 #~()))))) 75 #~())))))
80 76
81 (gexp->derivation "extlinux.conf" builder)) 77 (computed-file "extlinux.conf" builder))
82 78
83 79
84 80
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 06856dd58c8..161e8b3d02b 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -20,26 +20,18 @@
20;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. 20;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
21 21
22(define-module (gnu bootloader grub) 22(define-module (gnu bootloader grub)
23 #:use-module (guix store)
24 #:use-module (guix packages)
25 #:use-module (guix derivations)
26 #:use-module (guix records) 23 #:use-module (guix records)
27 #:use-module (guix monads) 24 #:use-module ((guix utils) #:select (%current-system))
28 #:use-module (guix gexp) 25 #:use-module (guix gexp)
29 #:use-module (guix download)
30 #:use-module (gnu artwork) 26 #:use-module (gnu artwork)
31 #:use-module (gnu system)
32 #:use-module (gnu bootloader) 27 #:use-module (gnu bootloader)
33 #:use-module (gnu system uuid) 28 #:use-module (gnu system uuid)
34 #:use-module (gnu system file-systems) 29 #:use-module (gnu system file-systems)
35 #:autoload (gnu packages bootloaders) (grub) 30 #:autoload (gnu packages bootloaders) (grub)
36 #:autoload (gnu packages compression) (gzip)
37 #:autoload (gnu packages gtk) (guile-cairo guile-rsvg) 31 #:autoload (gnu packages gtk) (guile-cairo guile-rsvg)
38 #:autoload (gnu packages guile) (guile-2.2)
39 #:use-module (ice-9 match) 32 #:use-module (ice-9 match)
40 #:use-module (ice-9 regex) 33 #:use-module (ice-9 regex)
41 #:use-module (srfi srfi-1) 34 #:use-module (srfi srfi-1)
42 #:use-module (rnrs bytevectors)
43 #:export (grub-image 35 #:export (grub-image
44 grub-image? 36 grub-image?
45 grub-image-aspect-ratio 37 grub-image-aspect-ratio
@@ -121,14 +113,14 @@ otherwise."
121 113
122(define* (svg->png svg #:key width height) 114(define* (svg->png svg #:key width height)
123 "Build a PNG of HEIGHT x WIDTH from SVG." 115 "Build a PNG of HEIGHT x WIDTH from SVG."
124 (gexp->derivation "grub-image.png" 116 (computed-file "grub-image.png"
125 (with-imported-modules '((gnu build svg)) 117 (with-imported-modules '((gnu build svg))
126 (with-extensions (list guile-rsvg guile-cairo) 118 (with-extensions (list guile-rsvg guile-cairo)
127 #~(begin 119 #~(begin
128 (use-modules (gnu build svg)) 120 (use-modules (gnu build svg))
129 (svg->png #+svg #$output 121 (svg->png #+svg #$output
130 #:width #$width 122 #:width #$width
131 #:height #$height)))))) 123 #:height #$height))))))
132 124
133(define* (grub-background-image config #:key (width 1024) (height 768)) 125(define* (grub-background-image config #:key (width 1024) (height 768))
134 "Return the GRUB background image defined in CONFIG with a ratio of 126 "Return the GRUB background image defined in CONFIG with a ratio of
@@ -138,15 +130,13 @@ WIDTH/HEIGHT, or #f if none was found."
138 (= (grub-image-aspect-ratio image) ratio)) 130 (= (grub-image-aspect-ratio image) ratio))
139 (grub-theme-images 131 (grub-theme-images
140 (bootloader-theme config))))) 132 (bootloader-theme config)))))
141 (if image 133 (and image
142 (svg->png (grub-image-file image) 134 (svg->png (grub-image-file image)
143 #:width width #:height height) 135 #:width width #:height height))))
144 (with-monad %store-monad
145 (return #f)))))
146 136
147(define* (eye-candy config store-device store-mount-point 137(define* (eye-candy config store-device store-mount-point
148 #:key system port) 138 #:key system port)
149 "Return in %STORE-MONAD a gexp that writes to PORT (a port-valued gexp) the 139 "Return a gexp that writes to PORT (a port-valued gexp) the
150'grub.cfg' part concerned with graphics mode, background images, colors, and 140'grub.cfg' part concerned with graphics mode, background images, colors, and
151all that. STORE-DEVICE designates the device holding the store, and 141all that. STORE-DEVICE designates the device holding the store, and
152STORE-MOUNT-POINT is its mount point; these are used to determine where the 142STORE-MOUNT-POINT is its mount point; these are used to determine where the
@@ -194,9 +184,11 @@ fi~%" #$font-file)
194 (strip-mount-point store-mount-point 184 (strip-mount-point store-mount-point
195 (file-append grub "/share/grub/unicode.pf2"))) 185 (file-append grub "/share/grub/unicode.pf2")))
196 186
197 (mlet* %store-monad ((image (grub-background-image config))) 187 (define image
198 (return (and image 188 (grub-background-image config))
199 #~(format #$port " 189
190 (and image
191 #~(format #$port "
200function setup_gfxterm {~a} 192function setup_gfxterm {~a}
201 193
202# Set 'root' to the partition that contains /gnu/store. 194# Set 'root' to the partition that contains /gnu/store.
@@ -213,14 +205,14 @@ else
213 set menu_color_normal=cyan/blue 205 set menu_color_normal=cyan/blue
214 set menu_color_highlight=white/blue 206 set menu_color_highlight=white/blue
215fi~%" 207fi~%"
216 #$setup-gfxterm-body 208 #$setup-gfxterm-body
217 #$(grub-root-search store-device font-file) 209 #$(grub-root-search store-device font-file)
218 #$(setup-gfxterm config font-file) 210 #$(setup-gfxterm config font-file)
219 #$(grub-setup-io config) 211 #$(grub-setup-io config)
220 212
221 #$(strip-mount-point store-mount-point image) 213 #$(strip-mount-point store-mount-point image)
222 #$(theme-colors grub-theme-color-normal) 214 #$(theme-colors grub-theme-color-normal)
223 #$(theme-colors grub-theme-color-highlight)))))) 215 #$(theme-colors grub-theme-color-highlight))))
224 216
225 217
226;;; 218;;;
@@ -331,36 +323,36 @@ entries corresponding to old generations of the system."
331 #$(grub-root-search device kernel) 323 #$(grub-root-search device kernel)
332 #$kernel (string-join (list #$@arguments)) 324 #$kernel (string-join (list #$@arguments))
333 #$initrd)))) 325 #$initrd))))
334 (mlet %store-monad ((sugar (eye-candy config 326 (define sugar
335 (menu-entry-device 327 (eye-candy config
336 (first all-entries)) 328 (menu-entry-device (first all-entries))
337 (menu-entry-device-mount-point 329 (menu-entry-device-mount-point (first all-entries))
338 (first all-entries)) 330 #:system system
339 #:system system 331 #:port #~port))
340 #:port #~port))) 332
341 (define builder 333 (define builder
342 #~(call-with-output-file #$output 334 #~(call-with-output-file #$output
343 (lambda (port) 335 (lambda (port)
344 (format port 336 (format port
345 "# This file was generated from your GuixSD configuration. Any changes 337 "# This file was generated from your GuixSD configuration. Any changes
346# will be lost upon reconfiguration. 338# will be lost upon reconfiguration.
347") 339")
348 #$sugar 340 #$sugar
349 (format port " 341 (format port "
350set default=~a 342set default=~a
351set timeout=~a~%" 343set timeout=~a~%"
352 #$(bootloader-configuration-default-entry config) 344 #$(bootloader-configuration-default-entry config)
353 #$(bootloader-configuration-timeout config)) 345 #$(bootloader-configuration-timeout config))
354 #$@(map menu-entry->gexp all-entries) 346 #$@(map menu-entry->gexp all-entries)
355 347
356 #$@(if (pair? old-entries) 348 #$@(if (pair? old-entries)
357 #~((format port " 349 #~((format port "
358submenu \"GNU system, old configurations...\" {~%") 350submenu \"GNU system, old configurations...\" {~%")
359 #$@(map menu-entry->gexp old-entries) 351 #$@(map menu-entry->gexp old-entries)
360 (format port "}~%")) 352 (format port "}~%"))
361 #~())))) 353 #~()))))
362 354
363 (gexp->derivation "grub.cfg" builder))) 355 (computed-file "grub.cfg" builder))
364 356
365 357
366 358
diff --git a/gnu/bootloader/u-boot.scm b/gnu/bootloader/u-boot.scm
index 0157fde3dad..b5fab14e147 100644
--- a/gnu/bootloader/u-boot.scm
+++ b/gnu/bootloader/u-boot.scm
@@ -20,13 +20,8 @@
20(define-module (gnu bootloader u-boot) 20(define-module (gnu bootloader u-boot)
21 #:use-module (gnu bootloader extlinux) 21 #:use-module (gnu bootloader extlinux)
22 #:use-module (gnu bootloader) 22 #:use-module (gnu bootloader)
23 #:use-module (gnu system)
24 #:use-module (gnu build bootloader)
25 #:use-module (gnu packages bootloaders) 23 #:use-module (gnu packages bootloaders)
26 #:use-module (guix gexp) 24 #:use-module (guix gexp)
27 #:use-module (guix monads)
28 #:use-module (guix records)
29 #:use-module (guix utils)
30 #:export (u-boot-bootloader 25 #:export (u-boot-bootloader
31 u-boot-a20-olinuxino-lime-bootloader 26 u-boot-a20-olinuxino-lime-bootloader
32 u-boot-a20-olinuxino-lime2-bootloader 27 u-boot-a20-olinuxino-lime2-bootloader