95/197: installer: Add a predicate to ensure the partitions have been formatted.

[Danny Milosavljevic]

dannym pushed a commit to branch wip-installer-2
in repository guix.

commit ee412f64a5f58a5c35d8ee2b0e96eba692dd4fae
Author: John Darrington <address@hidden>
Date:   Sat Jan 14 21:46:29 2017 +0100

    installer: Add a predicate to ensure the partitions have been formatted.
    
    *  gnu/system/installer/format.scm (device-fs-uuid, 
filesystems-are-current?):
    New procedures.
    *  gnu/system/installer/guixsd-installer.scm (main-options): Update 
prerequisites
    for install.  Update predicate for format.
---
 gnu/system/installer/format.scm           | 24 +++++++++++++++++++++++-
 gnu/system/installer/guixsd-installer.scm |  4 ++--
 2 files changed, 25 insertions(+), 3 deletions(-)

diff --git a/gnu/system/installer/format.scm b/gnu/system/installer/format.scm
index 2f965cc..73ab172 100644
--- a/gnu/system/installer/format.scm
+++ b/gnu/system/installer/format.scm
@@ -25,10 +25,32 @@
    #:use-module (ice-9 match)
    #:use-module (gurses buttons)
    #:use-module (ncurses curses)
-   
+   #:use-module (srfi srfi-1)
+
+   #:export (filesystems-are-current?)
    #:export (make-format-page))
 
 
+(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"
+  (car (assoc-ref
+        (slurp (string-append "blkid -o export " dev)
+               (lambda (x)
+                 (string-split x #\=))) "UUID")))
+
+(define (filesystems-are-current?)
+  "Returns #t iff there is at least one mount point AND all mount-points' uuids
+match those uuids read from the respective partitions"
+  (and (not (null? mount-points))
+       (fold (lambda (mp prev)
+               (and prev
+                    (match mp
+                           ((dev . (? file-system-spec? fss))
+                            (equal? (device-fs-uuid dev)
+                                    (file-system-spec-uuid fss))))))
+             #t mount-points)))
+
 (define (make-format-page parent title)
   (let ((page (make-page (page-surface parent)
                          title
diff --git a/gnu/system/installer/guixsd-installer.scm 
b/gnu/system/installer/guixsd-installer.scm
index 1be2bea..8e8c70f 100644
--- a/gnu/system/installer/guixsd-installer.scm
+++ b/gnu/system/installer/guixsd-installer.scm
@@ -89,7 +89,7 @@
 
     (format . ,(make-task format-menu-title
                           '(filesystems)
-                          (lambda () #f)
+                          filesystems-are-current?
                           (lambda (page)
                             (make-format-page
                              page
@@ -144,7 +144,7 @@
                                 generate-menu-title))))
 
     (install .  ,(make-task installation-menu-title
-                            '(network generate)
+                            '(network generate format)
                             (lambda () #f)
                             (lambda (page)
                               (make-install-page