diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2018-11-15 13:32:07 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2018-11-18 23:37:44 +0100 |
| commit | 46c296dcc4817f15a4b4ef7e5ef622306b4db62e (patch) | |
| tree | 3d4ce8d6ff27295b1dbfd1ae267a50e8f339daaf /gnu | |
| parent | b297934437932de730432629b361fcb422accbb7 (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')
| -rw-r--r-- | gnu/bootloader/extlinux.scm | 6 | ||||
| -rw-r--r-- | gnu/bootloader/grub.scm | 104 | ||||
| -rw-r--r-- | gnu/bootloader/u-boot.scm | 5 | ||||
| -rw-r--r-- | gnu/system.scm | 10 |
4 files changed, 56 insertions, 69 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 |
| 151 | all that. STORE-DEVICE designates the device holding the store, and | 141 | all that. STORE-DEVICE designates the device holding the store, and |
| 152 | STORE-MOUNT-POINT is its mount point; these are used to determine where the | 142 | STORE-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 " | ||
| 200 | function setup_gfxterm {~a} | 192 | function 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 |
| 215 | fi~%" | 207 | fi~%" |
| 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 " |
| 350 | set default=~a | 342 | set default=~a |
| 351 | set timeout=~a~%" | 343 | set 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 " |
| 358 | submenu \"GNU system, old configurations...\" {~%") | 350 | submenu \"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 |
diff --git a/gnu/system.scm b/gnu/system.scm index 99bc09873db..93340cccd2e 100644 --- a/gnu/system.scm +++ b/gnu/system.scm | |||
| @@ -948,9 +948,13 @@ listed in OS. The C library expects to find it under | |||
| 948 | (params (operating-system-boot-parameters os system root-device)) | 948 | (params (operating-system-boot-parameters os system root-device)) |
| 949 | (entry -> (boot-parameters->menu-entry params)) | 949 | (entry -> (boot-parameters->menu-entry params)) |
| 950 | (bootloader-conf -> (operating-system-bootloader os))) | 950 | (bootloader-conf -> (operating-system-bootloader os))) |
| 951 | ((bootloader-configuration-file-generator | 951 | (define generate-config-file |
| 952 | (bootloader-configuration-bootloader bootloader-conf)) | 952 | (bootloader-configuration-file-generator |
| 953 | bootloader-conf (list entry) #:old-entries old-entries))) | 953 | (bootloader-configuration-bootloader bootloader-conf))) |
| 954 | |||
| 955 | ;; TODO: Remove the 'lower-object' call to make it non-monadic. | ||
| 956 | (lower-object (generate-config-file bootloader-conf (list entry) | ||
| 957 | #:old-entries old-entries)))) | ||
| 954 | 958 | ||
| 955 | (define (operating-system-boot-parameters os system.drv root-device) | 959 | (define (operating-system-boot-parameters os system.drv root-device) |
| 956 | "Return a monadic <boot-parameters> record that describes the boot parameters | 960 | "Return a monadic <boot-parameters> record that describes the boot parameters |
