19/22: installer: Ensure that all mount-points have a file system.

[John Darrington]

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

commit 325beb08ca3c36f02bab9625a62a5c78f34ba0df
Author: John Darrington <address@hidden>
Date:   Mon Dec 26 14:38:49 2016 +0100

    installer: Ensure that all mount-points have a file system.
    
    * gnu/system/installer/filesystem.scm (filesystem-task-complete?): Add the
    condition that all declared mount points must have a file system on the
    respective partitions.
---
 gnu/system/installer/filesystems.scm |   32 +++++++++++++++++++++++---------
 1 file changed, 23 insertions(+), 9 deletions(-)

diff --git a/gnu/system/installer/filesystems.scm 
b/gnu/system/installer/filesystems.scm
index f3242ab..927248b 100644
--- a/gnu/system/installer/filesystems.scm
+++ b/gnu/system/installer/filesystems.scm
@@ -27,6 +27,7 @@
   #:use-module (gurses menu)
   #:use-module (ncurses curses)
   #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
 
   #:export (minimum-store-size)
@@ -36,8 +37,14 @@
 (define minimum-store-size 7000)
 
 (define (filesystem-task-complete?)
-  (and (find-mount-device "/" mount-points)
-       (>= (sizeof-partition (find-mount-device "/gnu" mount-points)) 
minimum-store-size)))
+  (and (find-mount-device "/" mount-points)  ; A device for / must exist
+       (>= (size-of-partition (find-mount-device "/gnu" mount-points))
+           minimum-store-size)  ; /gnu must have enough space
+
+       ;; All partitions must have a filesystem
+       (fold (lambda (x prev)
+               (and (string-prefix? "ext" (partition-fs (string->partition 
(car x))))
+                    prev)) #t mount-points)))
 
 (define (make-filesystem-page parent  title)
   (make-page (page-surface parent)
@@ -70,12 +77,19 @@
     (menu-redraw menu)))
 
 
-(define (sizeof-partition device)
-  "Return the size of the partition DEVICE"
-  (partition-size
-   (car (find  (lambda (x)
-                (equal? (partition-name (car x))
-                        device)) (partition-volume-pairs)))))
+(define (size-of-partition device)
+  "Return the size of the partition whose name is DEVICE"
+  (partition-size (string->partition device)))
+
+
+(define (string->partition device)
+  (match (find  (lambda (x)
+           (equal? (partition-name (car x))
+                   device)) (partition-volume-pairs))
+    ((p . _)
+     (when (not (partition? p))
+       (error (format #f "~s is not a partition" p)))
+     p)))
 
 
 (define (filesystem-page-key-handler page ch)
@@ -139,7 +153,7 @@
          (set! page-stack (cons next page-stack))
          ((page-refresh next) next)))
 
-       ((< (sizeof-partition (find-mount-device "/gnu" mount-points)) 
minimum-store-size)
+       ((< (size-of-partition (find-mount-device "/gnu" mount-points)) 
minimum-store-size)
        (let ((next
               (make-dialog
                page