01/09: system: Factorize operating-system-boot-parameters-file.

[Danny Milosavljevic]

dannym pushed a commit to branch master
in repository guix.

commit 40fad1c24ce60076e26f6dc8096e4716d31d90c3
Author: Danny Milosavljevic <address@hidden>
Date:   Fri Apr 21 14:37:07 2017 +0200

    system: Factorize operating-system-boot-parameters-file.
    
    * gnu/system.scm (operating-system-boot-parameters): New variable.
    (operating-system-boot-parameters-file): Modify.
---
 gnu/system.scm | 64 +++++++++++++++++++++++++++++++++++++++-------------------
 1 file changed, 43 insertions(+), 21 deletions(-)

diff --git a/gnu/system.scm b/gnu/system.scm
index a35a416..cb7c1b0 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -769,27 +769,49 @@ device in a <menu-entry>."
     ((label) (file-system-device fs))
     (else #f)))
 
-(define (operating-system-boot-parameters-file os)
-  "Return a file that describes the boot parameters of OS.  The primary use of
-this file is the reconstruction of GRUB menu entries for old configurations."
-  (mlet %store-monad ((initrd   (operating-system-initrd-file os))
-                      (root ->  (operating-system-root-file-system os))
-                      (store -> (operating-system-store-file-system os))
-                      (label -> (kernel->boot-label
-                                 (operating-system-kernel os))))
-    (gexp->file "parameters"
-                #~(boot-parameters
-                   (version 0)
-                   (label #$label)
-                   (root-device #$(file-system-device root))
-                   (kernel #$(operating-system-kernel-file os))
-                   (kernel-arguments
-                    #$(operating-system-user-kernel-arguments os))
-                   (initrd #$initrd)
-                   (store
-                    (device #$(fs->boot-device store))
-                    (mount-point #$(file-system-mount-point store))))
-                #:set-load-path? #f)))
+(define (operating-system-boot-parameters os system root-device)
+  "Return a monadic <boot-parameters> record that describes the boot 
parameters of OS.
+SYSTEM is optional.  If given, adds kernel arguments for that system to 
<boot-parameters>."
+  (mlet* %store-monad
+      ((initrd (operating-system-initrd-file os))
+       (store -> (operating-system-store-file-system os))
+       (label -> (kernel->boot-label (operating-system-kernel os))))
+    (return (boot-parameters
+             (label label)
+             (root-device root-device)
+             (kernel (operating-system-kernel-file os))
+             (kernel-arguments
+              (operating-system-user-kernel-arguments os))
+             (initrd initrd)
+             (store-device (fs->boot-device store))
+             (store-mount-point (file-system-mount-point store))))))
+
+(define* (operating-system-boot-parameters-file os #:optional (system.drv #f))
+   "Return a file that describes the boot parameters of OS.  The primary use of
+this file is the reconstruction of GRUB menu entries for old configurations.
+SYSTEM.DRV is optional.  If given, adds kernel arguments for that system to the
+returned file (since the returned file is then usually stored into the
+content-addressed \"system\" directory, it's usually not a good idea
+to give it because the content hash would change by the content hash
+being stored into the \"parameters\" file)."
+  (mlet* %store-monad ((root -> (operating-system-root-file-system os))
+                       (device -> (file-system-device root))
+                       (params (operating-system-boot-parameters os
+                                                                 system.drv
+                                                                 device)))
+     (gexp->file "parameters"
+                 #~(boot-parameters
+                    (version 0)
+                    (label #$(boot-parameters-label params))
+                    (root-device #$(boot-parameters-root-device params))
+                    (kernel #$(boot-parameters-kernel params))
+                    (kernel-arguments
+                     #$(boot-parameters-kernel-arguments params))
+                    (initrd #$(boot-parameters-initrd params))
+                    (store
+                     (device #$(boot-parameters-store-device params))
+                     (mount-point #$(boot-parameters-store-mount-point 
params))))
+                 #:set-load-path? #f)))
 
 
 ;;;