gnu: add convmv.

[jackhill/guix/guix.git] / gnu / bootloader.scm

diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index a381f67..2eebb8e 100644 (file)
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -1,7 +1,9 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 David Craven <david@craven.ch>
-;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,6 +25,7 @@
   #:use-module (guix records)
   #:use-module (guix ui)
   #:use-module (srfi srfi-1)
+  #:use-module (ice-9 match)
   #:export (menu-entry
             menu-entry?
             menu-entry-label
@@ -31,12 +34,19 @@
             menu-entry-linux-arguments
             menu-entry-initrd
             menu-entry-device-mount-point
+            menu-entry-multiboot-kernel
+            menu-entry-multiboot-arguments
+            menu-entry-multiboot-modules
+
+            menu-entry->sexp
+            sexp->menu-entry
 
             bootloader
             bootloader?
             bootloader-name
             bootloader-package
             bootloader-installer
+            bootloader-disk-image-installer
             bootloader-configuration-file
             bootloader-configuration-file-generator
 
@@ -71,10 +81,71 @@
                    (default #f))
   (device-mount-point menu-entry-device-mount-point
                    (default #f))
-  (linux           menu-entry-linux)
+  (linux           menu-entry-linux
+                   (default #f))
   (linux-arguments menu-entry-linux-arguments
                    (default '()))          ; list of string-valued gexps
-  (initrd          menu-entry-initrd))     ; file name of the initrd as a gexp
+  (initrd          menu-entry-initrd       ; file name of the initrd as a gexp
+                   (default #f))
+  (multiboot-kernel menu-entry-multiboot-kernel
+                    (default #f))
+  (multiboot-arguments menu-entry-multiboot-arguments
+                       (default '()))      ; list of string-valued gexps
+  (multiboot-modules menu-entry-multiboot-modules
+                     (default '())))       ; list of multiboot commands, where
+                                           ; a command is a list of <string>
+
+(define (menu-entry->sexp entry)
+  "Return ENTRY serialized as an sexp."
+  (match entry
+    (($ <menu-entry> label device mount-point linux linux-arguments initrd #f
+                     ())
+     `(menu-entry (version 0)
+                  (label ,label)
+                  (device ,device)
+                  (device-mount-point ,mount-point)
+                  (linux ,linux)
+                  (linux-arguments ,linux-arguments)
+                  (initrd ,initrd)))
+    (($ <menu-entry> label device mount-point #f () #f
+                     multiboot-kernel multiboot-arguments multiboot-modules)
+     `(menu-entry (version 0)
+                  (label ,label)
+                  (device ,device)
+                  (device-mount-point ,mount-point)
+                  (multiboot-kernel ,multiboot-kernel)
+                  (multiboot-arguments ,multiboot-arguments)
+                  (multiboot-modules ,multiboot-modules)))))
+
+(define (sexp->menu-entry sexp)
+  "Turn SEXP, an sexp as returned by 'menu-entry->sexp', into a <menu-entry>
+record."
+  (match sexp
+    (('menu-entry ('version 0)
+                  ('label label) ('device device)
+                  ('device-mount-point mount-point)
+                  ('linux linux) ('linux-arguments linux-arguments)
+                  ('initrd initrd) _ ...)
+     (menu-entry
+      (label label)
+      (device device)
+      (device-mount-point mount-point)
+      (linux linux)
+      (linux-arguments linux-arguments)
+      (initrd initrd)))
+    (('menu-entry ('version 0)
+                  ('label label) ('device device)
+                  ('device-mount-point mount-point)
+                  ('multiboot-kernel multiboot-kernel)
+                  ('multiboot-arguments multiboot-arguments)
+                  ('multiboot-modules multiboot-modules) _ ...)
+     (menu-entry
+      (label label)
+      (device device)
+      (device-mount-point mount-point)
+      (multiboot-kernel multiboot-kernel)
+      (multiboot-arguments multiboot-arguments)
+      (multiboot-modules multiboot-modules)))))
 
 \f
 ;;;
@@ -91,6 +162,8 @@
   (name                            bootloader-name)
   (package                         bootloader-package)
   (installer                       bootloader-installer)
+  (disk-image-installer            bootloader-disk-image-installer
+                                   (default #f))
   (configuration-file              bootloader-configuration-file)
   (configuration-file-generator    bootloader-configuration-file-generator))
 
@@ -108,7 +181,7 @@
   (bootloader         bootloader-configuration-bootloader) ;<bootloader>
   (target             bootloader-configuration-target      ;string
                       (default #f))
-  (menu-entries       bootloader-configuration-menu-entries ;list of <boot-parameters>
+  (menu-entries       bootloader-configuration-menu-entries ;list of <menu-entry>
                       (default '()))
   (default-entry      bootloader-configuration-default-entry ;integer
                       (default 0))