summaryrefslogtreecommitdiff
path: root/gnu/system/grub.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-10-03 21:30:30 +0200
committerLudovic Courtès <ludo@gnu.org>2013-10-03 23:12:20 +0200
commitd9f0a23704a038640329fae6e2273e5813cdb8ab (patch)
tree149b6f0d423e8261dc59580a54b8f4f9b37f26a6 /gnu/system/grub.scm
parentb860f382447a360ea2ce8a89d3357279cc652c3a (diff)
downloadpatches-d9f0a23704a038640329fae6e2273e5813cdb8ab.tar
patches-d9f0a23704a038640329fae6e2273e5813cdb8ab.tar.gz
gnu: vm: Rewrite helper functions as monadic functions.
* gnu/system/dmd.scm (host-name-service, nscd-service, mingetty-service, syslog-service, guix-service, static-networking-service): Rewrite as monadic functions. (dmd-configuration-file): Use 'text-file' instead of 'add-text-to-store'. * gnu/system/grub.scm (grub-configuration-file): Rewrite as a monadic function. * gnu/system/linux.scm (pam-services->directory): Likewise. * gnu/system/shadow.scm (group-file, passwd-file, guix-build-accounts): Likewise. * gnu/system/vm.scm (expression->derivation-in-linux-vm, qemu-image, union, system-qemu-image): Likewise.
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