From f6a7b21df7b499e8d304cc96fc949ec889e1eb10 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 28 Apr 2014 23:40:24 +0200
Subject: system: grub: Rewrite using gexps.

* gnu/system/grub.scm (grub-configuration-file): Rewrite using
  'gexp->derivation'.
* gnu/system.scm (operating-system-derivation): Adjust accordingly.
---
 gnu/system.scm      | 15 +++++++--------
 gnu/system/grub.scm | 53 ++++++++++++++++++++++++-----------------------------
 2 files changed, 31 insertions(+), 37 deletions(-)

(limited to 'gnu')

diff --git a/gnu/system.scm b/gnu/system.scm
index b52daf7917..0b2501392d 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -282,26 +282,25 @@ (define (operating-system-derivation os)
       ((profile     (operating-system-profile os))
        (etc         (operating-system-etc-directory os))
        (services    (sequence %store-monad (operating-system-services os)))
-       (boot-drv    (operating-system-boot-script os))
-       (boot    ->  (derivation->output-path boot-drv))
+       (boot        (operating-system-boot-script os))
        (kernel  ->  (operating-system-kernel os))
        (initrd      (operating-system-initrd os))
-       (initrd-file -> (string-append (derivation->output-path initrd)
-                                      "/initrd"))
+       (initrd-file -> #~(string-append #$initrd "/initrd"))
        (entries ->  (list (menu-entry
                            (label (string-append
                                    "GNU system with "
                                    (package-full-name kernel)
                                    " (technology preview)"))
                            (linux kernel)
-                           (linux-arguments `("--root=/dev/sda1"
-                                              ,(string-append "--load=" boot)))
+                           (linux-arguments
+                            (list "--root=/dev/sda1"
+                                  #~(string-append "--load=" #$boot)))
                            (initrd initrd-file))))
        (grub.cfg (grub-configuration-file entries)))
     (file-union "system"
-                `(("boot" ,#~#$boot-drv)
+                `(("boot" ,#~#$boot)
                   ("kernel" ,#~#$kernel)
-                  ("initrd" ,#~(string-append #$initrd "/initrd"))
+                  ("initrd" ,initrd-file)
                   ("profile" ,#~#$profile)
                   ("grub.cfg" ,#~#$grub.cfg)
                   ("etc" ,#~#$etc)))))
diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm
index 5dc0b85ff2..1893672a2a 100644
--- a/gnu/system/grub.scm
+++ b/gnu/system/grub.scm
@@ -22,6 +22,7 @@ (define-module (gnu system grub)
   #:use-module (guix derivations)
   #:use-module (guix records)
   #:use-module (guix monads)
+  #:use-module (guix gexp)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:export (menu-entry
@@ -40,45 +41,39 @@ (define-record-type* <menu-entry>
   (label           menu-entry-label)
   (linux           menu-entry-linux)
   (linux-arguments menu-entry-linux-arguments
-                   (default '()))
-  (initrd          menu-entry-initrd))            ; file name of the initrd
+                   (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 (prologue kernel)
-    (format #f "
-set default=~a
-set timeout=~a
-search.file ~a~%"
-            default-entry timeout kernel))
-
-  (define (bzImage)
-    (any (match-lambda
-          (($ <menu-entry> _ linux)
-           (package-file linux "bzImage"
-                         #:system system)))
-         entries))
-
-  (define entry->text
+  (define entry->gexp
     (match-lambda
      (($ <menu-entry> label linux arguments initrd)
-      (mlet %store-monad ((linux  (package-file linux "bzImage"
-                                                #:system system)))
-        (return (format #f "menuentry ~s {
-  linux ~a ~a
+      #~(format port "menuentry ~s {
+  linux ~a/bzImage ~a
   initrd ~a
 }~%"
-                        label
-                        linux (string-join arguments) initrd))))))
+                #$label
+                #$linux (string-join (list #$@arguments))
+                #$initrd))))
+
+  (define builder
+    #~(call-with-output-file #$output
+        (lambda (port)
+          (format port "
+set default=~a
+set timeout=~a
+search.file ~a/bzImage~%"
+                  #$default-entry #$timeout
+                  #$(any (match-lambda
+                          (($ <menu-entry> _ linux)
+                           linux))
+                         entries))
+          #$@(map entry->gexp entries))))
 
-  (mlet %store-monad ((kernel (bzImage))
-                      (body   (sequence %store-monad
-                                        (map entry->text entries))))
-    (text-file "grub.cfg"
-               (string-append (prologue kernel)
-                              (string-concatenate body)))))
+  (gexp->derivation "grub.cfg" builder))
 
 ;;; grub.scm ends here
-- 
cgit v1.2.3