3 files changed, 38 insertions(+), 15 deletions(-)

M build-aux/hydra/demo-os.scm
M gnu/system.scm
M gnu/system/grub.scm

@@ 33,6 33,7 @@
              (gnu packages tor)
              (gnu packages package-management)
 
+             (gnu system grub)                    ; 'grub-configuration'
              (gnu system shadow)                  ; 'user-account'
              (gnu system linux)                   ; 'base-pam-services'
              (gnu services base)


@@ 43,6 44,8 @@
  (host-name "gnu")
  (timezone "Europe/Paris")
  (locale "en_US.UTF-8")
+ (bootloader (grub-configuration
+              (device "/dev/sda")))
  (file-systems
   ;; We provide a dummy file system for /, but that's OK because the VM build
   ;; code will automatically declare the / file system for us.

@@ 39,10 39,11 @@
   #:use-module (srfi srfi-26)
   #:export (operating-system
             operating-system?
+
+            operating-system-bootloader
             operating-system-services
             operating-system-user-services
             operating-system-packages
-            operating-system-bootloader-entries
             operating-system-host-name
             operating-system-kernel
             operating-system-initrd


@@ 83,10 84,8 @@
   operating-system?
   (kernel operating-system-kernel                 ; package
           (default linux-libre))
-  (bootloader operating-system-bootloader         ; package
-              (default grub))
-  (bootloader-entries operating-system-bootloader-entries ; list
-                      (default '()))
+  (bootloader operating-system-bootloader)        ; <grub-configuration>
+
   (initrd operating-system-initrd                 ; (list fs) -> M derivation
           (default qemu-initrd))
 


@@ 504,7 503,7 @@ we're running in the final root."
                                   #~(string-append "--load=" #$system
                                                    "/boot")))
                            (initrd #~(string-append #$system "/initrd"))))))
-    (grub-configuration-file entries)))
+    (grub-configuration-file (operating-system-bootloader os) entries)))
 
 (define (operating-system-derivation os)
   "Return a derivation that builds OS."

@@ 25,8 25,13 @@
   #:use-module (guix gexp)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
-  #:export (menu-entry
+  #:export (grub-configuration
+            grub-configuration?
+            grub-configuration-device
+
+            menu-entry
             menu-entry?
+
             grub-configuration-file))
 
 ;;; Commentary:


@@ 35,6 40,19 @@
 ;;;
 ;;; Code:
 
+(define-record-type* <grub-configuration>
+  grub-configuration make-grub-configuration
+  grub-configuration?
+  (grub            grub-configuration-grub           ; package
+                   (default (@ (gnu packages grub) grub)))
+  (device          grub-configuration-device)        ; string
+  (menu-entries    grub-configuration-menu-entries   ; list
+                   (default '()))
+  (default-entry   grub-configuration-default-entry  ; integer
+                   (default 1))
+  (timeout         grub-configuration-timeout        ; integer
+                   (default 5)))
+
 (define-record-type* <menu-entry>
   menu-entry make-menu-entry
   menu-entry?


@@ 44,11 62,13 @@
                    (default '()))          ; list of string-valued gexps
   (initrd          menu-entry-initrd))     ; file name of the initrd as a gexp
 
-(define* (grub-configuration-file entries
-                                  #:key (default-entry 1) (timeout 5)
-                                  (system (%current-system)))
-  "Return the GRUB configuration file for ENTRIES, a list of
-<menu-entry> objects, defaulting to DEFAULT-ENTRY and with the given TIMEOUT."
+(define* (grub-configuration-file config entries
+                                  #:key (system (%current-system)))
+  "Return the GRUB configuration file corresponding to CONFIG, a
+<grub-configuration> object."
+  (define all-entries
+    (append entries (grub-configuration-menu-entries config)))
+
   (define entry->gexp
     (match-lambda
      (($ <menu-entry> label linux arguments initrd)


@@ 67,12 87,13 @@
 set default=~a
 set timeout=~a
 search.file ~a/bzImage~%"
-                  #$default-entry #$timeout
+                  #$(grub-configuration-default-entry config)
+                  #$(grub-configuration-timeout config)
                   #$(any (match-lambda
                           (($ <menu-entry> _ linux)
                            linux))
-                         entries))
-          #$@(map entry->gexp entries))))
+                         all-entries))
+          #$@(map entry->gexp all-entries))))
 
   (gexp->derivation "grub.cfg" builder))