aboutsummaryrefslogtreecommitdiff
path: root/gnu/system/grub.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/system/grub.scm')
-rw-r--r--gnu/system/grub.scm51
1 files changed, 27 insertions, 24 deletions
diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm
index b2438b9c5b..abc220b532 100644
--- a/gnu/system/grub.scm
+++ b/gnu/system/grub.scm
@@ -21,6 +21,7 @@
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix records)
+ #:use-module (guix monads)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:export (menu-entry
@@ -42,43 +43,45 @@
(default '()))
(initrd menu-entry-initrd))
-(define* (grub-configuration-file store entries
+(define* (grub-configuration-file entries
#:key (default-entry 1) (timeout 5)
(system (%current-system)))
- "Return the GRUB configuration file in STORE for ENTRIES, a list of
+ "Return the GRUB configuration file for ENTRIES, a list of
<menu-entry> objects, defaulting to DEFAULT-ENTRY and with the given TIMEOUT."
- (define prologue
+ (define (prologue kernel)
(format #f "
set default=~a
set timeout=~a
search.file ~a~%"
- default-entry timeout
- (any (match-lambda
- (($ <menu-entry> _ linux)
- (let* ((drv (package-derivation store linux system))
- (out (derivation->output-path drv)))
- (string-append out "/bzImage"))))
- entries)))
+ default-entry timeout kernel))
+
+ (define (bzImage)
+ (anym %store-monad
+ (match-lambda
+ (($ <menu-entry> _ linux)
+ (package-file linux "bzImage"
+ #:system system)))
+ entries))
(define entry->text
(match-lambda
(($ <menu-entry> label linux arguments initrd)
- (let ((linux-drv (package-derivation store linux system))
- (initrd-drv (package-derivation store initrd system)))
+ (mlet %store-monad ((linux (package-file linux "bzImage"
+ #:system system))
+ (initrd (package-file initrd "initrd"
+ #:system system)))
;; XXX: Assume that INITRD is a directory containing an 'initrd' file.
- (format #f "menuentry ~s {
- linux ~a/bzImage ~a
- initrd ~a/initrd
+ (return (format #f "menuentry ~s {
+ linux ~a ~a
+ initrd ~a
}~%"
- label
- (derivation->output-path linux-drv)
- (string-join arguments)
- (derivation->output-path initrd-drv))))))
+ label
+ linux (string-join arguments) initrd))))))
- (add-text-to-store store "grub.cfg"
- (string-append prologue
- (string-concatenate
- (map entry->text entries)))
- '()))
+ (mlet %store-monad ((kernel (bzImage))
+ (body (mapm %store-monad entry->text entries)))
+ (text-file "grub.cfg"
+ (string-append (prologue kernel)
+ (string-concatenate body)))))
;;; grub.scm ends here