01/03: linux-initrd: Avoid monadic style a bit.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 6d9a859038b33c1bde35df915f101b58774bce06
Author: Ludovic Courtès <address@hidden>
Date:   Tue Jul 4 22:05:21 2017 +0200

    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.
---
 gnu/system/linux-initrd.scm | 108 ++++++++++++++++++++++----------------------
 1 file changed, 55 insertions(+), 53 deletions(-)

diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 89caf83..5a7aec5 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 address@hidden))
-                        #: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 address@hidden))
+                      #: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