02/04: file-systems: Add helpers for parsing the options string into an alist.

[guix-commits]

apteryx pushed a commit to branch master
in repository guix.

commit fa35fb58c84d1c1741e4e63c0b37074e35ed2a61
Author: Maxim Cournoyer <address@hidden>
AuthorDate: Wed Sep 25 22:43:41 2019 +0900

    file-systems: Add helpers for parsing the options string into an alist.
    
    * gnu/system/file-systems.scm (file-system-options->alist)
    (alist->file-system-options): New procedures.
    * tests/file-systems.scm: New tests.
    * doc/guix.texi (File Systems): Add note about the newly added procedures.
---
 doc/guix.texi               | 12 ++++++++----
 gnu/system/file-systems.scm | 31 +++++++++++++++++++++++++++++++
 tests/file-systems.scm      | 19 +++++++++++++++++++
 3 files changed, 58 insertions(+), 4 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 4e02993..05f2d59 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11694,10 +11694,14 @@ update time on the in-memory version of the file 
inode), and
 Manual}, for more information on these flags.
 
 @item @code{options} (default: @code{#f})
-This is either @code{#f}, or a string denoting mount options passed to the
-file system driver.  @xref{Mount-Unmount-Remount,,, libc, The GNU C Library
-Reference Manual}, for details and run @command{man 8 mount} for options for
-various file systems.
+This is either @code{#f}, or a string denoting mount options passed to
+the file system driver.  @xref{Mount-Unmount-Remount,,, libc, The GNU C
+Library Reference Manual}, for details and run @command{man 8 mount} for
+options for various file systems.  Note that the
+@code{file-system-options->alist} and @code{alist->file-system-options}
+procedures from @code{(gnu system file-systems)} can be used to convert
+file system options given as an association list to the string
+representation, and vice-versa.
 
 @item @code{mount?} (default: @code{#t})
 This value indicates whether to automatically mount the file system when
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index b41f66e..07f272d 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès 
<address@hidden>
 ;;; Copyright © 2020 Jakub Kądziołka <address@hidden>
+;;; Copyright © 2020 Maxim Cournoyer <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -38,6 +39,9 @@
             file-system-needed-for-boot?
             file-system-flags
             file-system-options
+            file-system-options->alist
+            alist->file-system-options
+
             file-system-mount?
             file-system-check?
             file-system-create-mount-point?
@@ -251,6 +255,33 @@ UUID-TYPE, a symbol such as 'dce or 'iso9660."
     ((? string?)
      device)))
 
+(define (file-system-options->alist string)
+  "Translate the option string format of a <file-system> record into an
+association list of options or option/value pairs."
+  (if string
+      (let ((options (string-split string #\,)))
+        (map (lambda (param)
+               (let ((=index (string-index param #\=)))
+                 (if =index
+                     (cons (string-take param =index)
+                           (string-drop param (1+ =index)))
+                     param)))
+             options))
+      '()))
+
+(define (alist->file-system-options options)
+  "Return the string representation of OPTIONS, an association list.  The
+string obtained can be used as the option field of a <file-system> record."
+  (if (null? options)
+      #f
+      (string-join (map (match-lambda
+                          ((key . value)
+                           (string-append key "=" value))
+                          (key
+                           key))
+                        options)
+                   ",")))
+
 (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/tests/file-systems.scm b/tests/file-systems.scm
index 4c28d0e..41f1021 100644
--- a/tests/file-systems.scm
+++ b/tests/file-systems.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015, 2017 Ludovic Courtès <address@hidden>
+;;; Copyright © 2020 Maxim Cournoyer <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -64,4 +65,22 @@
           (_ #f))
         (source-module-closure '((gnu system file-systems)))))
 
+(test-equal "file-system-options->alist"
+  '("autodefrag" ("subvol" . "home") ("compress" . "lzo"))
+  (file-system-options->alist "autodefrag,subvol=home,compress=lzo"))
+
+(test-equal "file-system-options->alist (#f)"
+  '()
+  (file-system-options->alist #f))
+
+(test-equal "alist->file-system-options"
+  "autodefrag,subvol=root,compress=lzo"
+  (alist->file-system-options '("autodefrag"
+                                ("subvol" . "root")
+                                ("compress" . "lzo"))))
+
+(test-equal "alist->file-system-options (null)"
+  #f
+  (alist->file-system-options '()))
+
 (test-end)