02/02: file-systems: Add a 'file-system-device->string' procedure.

[guix-commits]

apteryx pushed a commit to branch master
in repository guix.

commit 99e676db43389af3a9e4c21734987c086fcaa8ed
Author: Maxim Cournoyer <address@hidden>
AuthorDate: Tue Feb 11 23:56:45 2020 -0500

    file-systems: Add a 'file-system-device->string' procedure.
    
    * gnu/system/file-systems.scm (file-system-device->string): New procedure.
    * gnu/system.scm (bootable-kernel-arguments): Use it.
    * gnu/system/vm.scm (operating-system-uuid): Likewise.
    * guix/scripts/system.scm (display-system-generation): Likewise.
---
 gnu/system.scm              | 15 +++++----------
 gnu/system/file-systems.scm | 15 +++++++++++++++
 gnu/system/vm.scm           |  8 +-------
 guix/scripts/system.scm     |  7 +------
 4 files changed, 22 insertions(+), 23 deletions(-)

diff --git a/gnu/system.scm b/gnu/system.scm
index 01baa24..2e6d032 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -142,16 +142,11 @@
 (define (bootable-kernel-arguments system root-device)
   "Return a list of kernel arguments (gexps) to boot SYSTEM from ROOT-DEVICE."
   (list (string-append "--root="
-                       (cond ((uuid? root-device)
-
-                              ;; Note: Always use the DCE format because that's
-                              ;; what (gnu build linux-boot) expects for the
-                              ;; '--root' kernel command-line option.
-                              (uuid->string (uuid-bytevector root-device)
-                                            'dce))
-                             ((file-system-label? root-device)
-                              (file-system-label->string root-device))
-                             (else root-device)))
+                       ;; Note: Always use the DCE format because that's what
+                       ;; (gnu build linux-boot) expects for the '--root'
+                       ;; kernel command-line option.
+                       (file-system-device->string root-device
+                                                   #:uuid-type 'dce))
         #~(string-append "--system=" #$system)
         #~(string-append "--load=" #$system "/boot")))
 
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index d47a514..3b599ef 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -30,6 +30,7 @@
   #:export (file-system
             file-system?
             file-system-device
+            file-system-device->string
             file-system-title                     ;deprecated
             file-system-mount-point
             file-system-type
@@ -235,6 +236,20 @@ where both FILE1 and FILE2 are absolute file name.  For 
example:
               (()
                #f)))))))
 
+(define* (file-system-device->string device #:key uuid-type)
+  "Return the string representations of the DEVICE field of a <file-system>
+record.  When the device is a UUID, its representation is chosen depending on
+UUID-TYPE, a symbol such as 'dce or 'iso9660."
+  (match device
+    ((? file-system-label?)
+     (file-system-label->string device))
+    ((? uuid?)
+     (if uuid-type
+         (uuid->string (uuid-bytevector device) uuid-type)
+         (uuid->string device)))
+    ((? string?)
+     device)))
+
 (define (file-system-needed-for-boot? fs)
   "Return true if FS has the 'needed-for-boot?' flag set, or if it holds the
 store--e.g., if FS is the root file system."
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 81b2e06..03a511c 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -609,13 +609,7 @@ TYPE (one of 'iso9660 or 'dce).  Return a UUID object."
     (let ((device (file-system-device fs)))
       (list (file-system-mount-point fs)
             (file-system-type fs)
-            (cond ((file-system-label? device)
-                   (file-system-label->string device))
-                  ((uuid? device)
-                   (uuid->string device))
-                  ((string? device)
-                   device)
-                  (else #f))
+            (file-system-device->string device)
             (file-system-options fs))))
 
   (if (eq? type 'iso9660)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index b5e3a56..ac2475c 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -517,12 +517,7 @@ list of services."
               (cond ((uuid? root-device) 0)
                     ((file-system-label? root-device) 1)
                     (else 2))
-              (cond ((uuid? root-device)
-                     (uuid->string root-device))
-                    ((file-system-label? root-device)
-                     (file-system-label->string root-device))
-                    (else
-                     root-device)))
+              (file-system-device->string root-device))
 
       (format #t (G_ "  kernel: ~a~%") kernel)