[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
11/18: installer: New convenience procedures.
From: |
John Darrington |
Subject: |
11/18: installer: New convenience procedures. |
Date: |
Thu, 2 Feb 2017 18:13:05 +0000 (UTC) |
jmd pushed a commit to branch wip-installer
in repository guix.
commit f360850c7148e00bc87c31dad8dbd37f39f72185
Author: John Darrington <address@hidden>
Date: Tue Jan 31 20:13:34 2017 +0100
installer: New convenience procedures.
* gnu/system/installer/format.scm (device-attributes): New procedure.
(device-fs-label): New procedure.
---
gnu/system/installer/format.scm | 27 +++++++++++++++++++--------
1 file changed, 19 insertions(+), 8 deletions(-)
diff --git a/gnu/system/installer/format.scm b/gnu/system/installer/format.scm
index 29b8316..f0a9aaf 100644
--- a/gnu/system/installer/format.scm
+++ b/gnu/system/installer/format.scm
@@ -35,17 +35,28 @@
(include "i18n.scm")
+(define (device-attributes dev)
+ (slurp (string-append "blkid -o export " dev)
+ (lambda (x)
+ (let ((idx (string-index x #\=)))
+ (cons (string->symbol (string-fold
+ (lambda (c acc)
+ (string-append
+ acc
+ (make-string 1 (char-downcase c))))
+ ""
+ (substring x 0 idx)))
+ (substring x (1+ idx) (string-length x)))))))
+
(define (device-fs-uuid dev)
"Retrieve the UUID of the filesystem on DEV, where DEV is the name of the
device such as /dev/sda1"
- (match (assoc-ref
- (slurp (string-append "blkid -o export " dev)
- (lambda (x)
- (string-split x #\=))) "UUID")
- (() #f)
- ((? list? l)
- (car l))
- (_ #f)))
+ (assq-ref (device-attributes dev) 'uuid))
+
+(define (device-fs-label dev)
+ "Retrieve the LABEL of the filesystem on DEV, where DEV is the name of the
+device such as /dev/sda1"
+ (assq-ref (device-attributes dev) 'label))
(define (filesystems-are-current?)
"Returns #t iff there is at least one mount point AND all mount-points' uuids
- 09/18: installer: Correct placement of gettext call., (continued)
- 09/18: installer: Correct placement of gettext call., John Darrington, 2017/02/02
- 08/18: installer: Replace 'file-browser' with 'key-map'., John Darrington, 2017/02/02
- 06/18: installer: Use _ instead of M_ for host-name-refresh., John Darrington, 2017/02/02
- 14/18: gurses: Cache the windows of buttons., John Darrington, 2017/02/02
- 16/18: installer: New procedure key-value-slurp., John Darrington, 2017/02/02
- 18/18: installer: Fix bug when changing languages., John Darrington, 2017/02/02
- 07/18: installer: New page to select language., John Darrington, 2017/02/02
- 10/18: installer: Fix i18n in dialogs., John Darrington, 2017/02/02
- 17/18: installer: Provide verbose description of locale., John Darrington, 2017/02/02
- 03/18: installer: New file i18n.scm., John Darrington, 2017/02/02
- 11/18: installer: New convenience procedures.,
John Darrington <=
- 13/18: gurses: Avoid one use of car/cdr., John Darrington, 2017/02/02
- 15/18: gurses: Use match instead of car., John Darrington, 2017/02/02
- 12/18: installer: Improve i18n in ping page., John Darrington, 2017/02/02