summaryrefslogtreecommitdiff
path: root/gnu/system
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-07-04 22:05:21 +0200
committerLudovic Courtès <ludo@gnu.org>2017-07-04 23:45:12 +0200
commit6d9a859038b33c1bde35df915f101b58774bce06 (patch)
treee53bd00823e71d259e115419a66a3bfdf11e4aa5 /gnu/system
parente208bf789c852ec2b4fed96e94cd1bada81ac503 (diff)
linux-initrd: Avoid monadic style a bit.
* gnu/system/linux-initrd.scm (expression->initrd): Use 'program-file' for 'init'. (flat-linux-module-directory): Use 'computed-file' instead of 'gexp->derivation'. (raw-initrd): Adjust accordingly.
Diffstat (limited to 'gnu/system')
-rw-r--r--gnu/system/linux-initrd.scm108
1 files changed, 55 insertions, 53 deletions
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 89caf83256..5a7aec5c87 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -68,24 +68,25 @@ the derivations referenced by EXP are automatically copied to the initrd."
;; General Linux overview in `Documentation/early-userspace/README' and
;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'.
- (mlet %store-monad ((init (gexp->script "init" exp
- #:guile guile)))
- (define builder
- (with-imported-modules (source-module-closure
- '((gnu build linux-initrd)))
- #~(begin
- (use-modules (gnu build linux-initrd))
-
- (mkdir #$output)
- (build-initrd (string-append #$output "/initrd")
- #:guile #$guile
- #:init #$init
- ;; Copy everything INIT refers to into the initrd.
- #:references-graphs '("closure")
- #:gzip (string-append #$gzip "/bin/gzip")))))
-
- (gexp->derivation name builder
- #:references-graphs `(("closure" ,init)))))
+ (define init
+ (program-file "init" exp #:guile guile))
+
+ (define builder
+ (with-imported-modules (source-module-closure
+ '((gnu build linux-initrd)))
+ #~(begin
+ (use-modules (gnu build linux-initrd))
+
+ (mkdir #$output)
+ (build-initrd (string-append #$output "/initrd")
+ #:guile #$guile
+ #:init #$init
+ ;; Copy everything INIT refers to into the initrd.
+ #:references-graphs '("closure")
+ #:gzip (string-append #$gzip "/bin/gzip")))))
+
+ (gexp->derivation name builder
+ #:references-graphs `(("closure" ,init))))
(define (flat-linux-module-directory linux modules)
"Return a flat directory containing the Linux kernel modules listed in
@@ -132,7 +133,7 @@ MODULES and taken from LINUX."
(basename module))))
(delete-duplicates modules)))))
- (gexp->derivation "linux-modules" build-exp))
+ (computed-file "linux-modules" build-exp))
(define* (raw-initrd file-systems
#:key
@@ -165,40 +166,41 @@ to it are lost."
(open source target)))
mapped-devices))
- (mlet %store-monad ((kodir (flat-linux-module-directory linux
- linux-modules)))
- (expression->initrd
- (with-imported-modules (source-module-closure
- '((gnu build linux-boot)
- (guix build utils)
- (guix build bournish)
- (gnu build file-systems)))
- #~(begin
- (use-modules (gnu build linux-boot)
- (guix build utils)
- (guix build bournish) ;add the 'bournish' meta-command
- (srfi srfi-26)
-
- ;; FIXME: The following modules are for
- ;; LUKS-DEVICE-MAPPING. We should instead propagate
- ;; this info via gexps.
- ((gnu build file-systems)
- #:select (find-partition-by-luks-uuid))
- (rnrs bytevectors))
-
- (with-output-to-port (%make-void-port "w")
- (lambda ()
- (set-path-environment-variable "PATH" '("bin" "sbin")
- '#$helper-packages)))
-
- (boot-system #:mounts '#$(map file-system->spec file-systems)
- #:pre-mount (lambda ()
- (and #$@device-mapping-commands))
- #:linux-modules '#$linux-modules
- #:linux-module-directory '#$kodir
- #:qemu-guest-networking? #$qemu-networking?
- #:volatile-root? '#$volatile-root?)))
- #:name "raw-initrd")))
+ (define kodir
+ (flat-linux-module-directory linux linux-modules))
+
+ (expression->initrd
+ (with-imported-modules (source-module-closure
+ '((gnu build linux-boot)
+ (guix build utils)
+ (guix build bournish)
+ (gnu build file-systems)))
+ #~(begin
+ (use-modules (gnu build linux-boot)
+ (guix build utils)
+ (guix build bournish) ;add the 'bournish' meta-command
+ (srfi srfi-26)
+
+ ;; FIXME: The following modules are for
+ ;; LUKS-DEVICE-MAPPING. We should instead propagate
+ ;; this info via gexps.
+ ((gnu build file-systems)
+ #:select (find-partition-by-luks-uuid))
+ (rnrs bytevectors))
+
+ (with-output-to-port (%make-void-port "w")
+ (lambda ()
+ (set-path-environment-variable "PATH" '("bin" "sbin")
+ '#$helper-packages)))
+
+ (boot-system #:mounts '#$(map file-system->spec file-systems)
+ #:pre-mount (lambda ()
+ (and #$@device-mapping-commands))
+ #:linux-modules '#$linux-modules
+ #:linux-module-directory '#$kodir
+ #:qemu-guest-networking? #$qemu-networking?
+ #:volatile-root? '#$volatile-root?)))
+ #:name "raw-initrd"))
(define* (file-system-packages file-systems #:key (volatile-root? #f))
"Return the list of statically-linked, stripped packages to check