installer: Add configuration formatter.

* gnu/installer.scm (installer-steps): Add configuration-formatter procedures.
* gnu/installer/final.scm: New file.
* gnu/installer/locale.scm (locale->configuration): New exported procedure.
* gnu/installer/newt.scm (newt-installer): Add final page.
* gnu/installer/newt/final.scm: New file.
* gnu/installer/record.scm (installer): Add final-page field.
* gnu/installer/timezone.scm (posix-tz->configuration): New exported
procedure.
* gnu/installer/steps.scm (installer-step): Rename configuration-proc field to
configuration-formatter.
(%installer-configuration-file): New exported parameter,
(%installer-target-dir): ditto,
(%configuration-file-width): ditto,
(format-configuration): new exported procedure,
(configuration->file): new exported procedure.

7 files changed, 210 insertions, 11 deletions

diff --git a/gnu/installer/final.scm b/gnu/installer/final.scm
new file mode 100644
index 0000000000..e1c62f5ce0
--- /dev/null
+++ b/gnu/installer/final.scm
@@ -0,0 +1,36 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu installer final)
+  #:use-module (gnu installer newt page)
+  #:use-module (gnu installer steps)
+  #:use-module (gnu installer utils)
+  #:use-module (gnu services herd)
+  #:use-module (guix build utils)
+  #:export (install-system))
+
+(define (install-system)
+  "Start COW-STORE service on target directory and launch guix install command
+in a subshell."
+  (let ((install-command
+         (format #f "guix system init ~a ~a"
+                 (%installer-configuration-file)
+                 (%installer-target-dir))))
+    (mkdir-p (%installer-target-dir))
+    (start-service 'cow-store (list (%installer-target-dir)))
+    (false-if-exception (run-shell-command install-command))))
diff --git a/gnu/installer/locale.scm b/gnu/installer/locale.scm
index 504070d41d..2b45b2200a 100644
--- a/gnu/installer/locale.scm
+++ b/gnu/installer/locale.scm
@@ -35,7 +35,9 @@
             language-code->language-name
 
             iso3166->iso3166-territories
-            territory-code->territory-name))
+            territory-code->territory-name
+
+            locale->configuration))
 
 
 ;;;
@@ -197,3 +199,12 @@ territory name corresponding to the given TERRITORY-CODE."
                             territory-code)))
                territories)))
     (iso3166-territory-name iso3166-territory)))
+
+
+;;;
+;;; Configuration formatter.
+;;;
+
+(define (locale->configuration locale)
+  "Return the configuration field for LOCALE."
+  `((locale ,locale)))
diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm
index db57c732d1..77a7e6dca2 100644
--- a/gnu/installer/newt.scm
+++ b/gnu/installer/newt.scm
@@ -19,6 +19,7 @@
 (define-module (gnu installer newt)
   #:use-module (gnu installer record)
   #:use-module (gnu installer newt ethernet)
+  #:use-module (gnu installer newt final)
   #:use-module (gnu installer newt hostname)
   #:use-module (gnu installer newt keymap)
   #:use-module (gnu installer newt locale)
@@ -46,6 +47,9 @@
 (define (exit-error key . args)
   (newt-finish))
 
+(define (final-page result prev-steps)
+  (run-final-page result prev-steps))
+
 (define* (locale-page #:key
                       supported-locales
                       iso639-languages
@@ -83,6 +87,7 @@
    (init init)
    (exit exit)
    (exit-error exit-error)
+   (final-page final-page)
    (keymap-page keymap-page)
    (locale-page locale-page)
    (menu-page menu-page)
diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm
new file mode 100644
index 0000000000..023777cc0a
--- /dev/null
+++ b/gnu/installer/newt/final.scm
@@ -0,0 +1,84 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu installer newt final)
+  #:use-module (gnu installer final)
+  #:use-module (gnu installer parted)
+  #:use-module (gnu installer steps)
+  #:use-module (gnu installer utils)
+  #:use-module (gnu installer newt page)
+  #:use-module (gnu installer newt utils)
+  #:use-module (guix i18n)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (newt)
+  #:export (run-final-page))
+
+(define (run-config-display-page)
+  (let ((width (%configuration-file-width))
+        (height (nearest-exact-integer
+                 (/ (screen-rows) 2))))
+    (run-file-textbox-page
+     #:info-text (G_ "Congratulations, the installation is almost over! A \
+system configuration file has been generated, it is displayed just below. The \
+new system will be created from this file when pression the Ok button.")
+     #:title (G_ "Configuration file")
+     #:file (%installer-configuration-file)
+     #:info-textbox-width width
+     #:file-textbox-width width
+     #:file-textbox-height height
+     #:cancel-button-callback-procedure
+     (lambda ()
+       (raise
+        (condition
+         (&installer-step-abort)))))))
+
+(define (run-install-success-page)
+  (message-window
+   (G_ "Installation complete")
+   (G_ "Reboot")
+   (G_ "The installation finished with success. You may now remove the device \
+with the installation image and press the button to reboot.")))
+
+(define (run-install-failed-page)
+  (choice-window
+   (G_ "Installation failed")
+   (G_ "Restart installer")
+   (G_ "Retry system install")
+   (G_ "The final system installation step failed. You can retry the \
+last step, or restart the installer.")))
+
+(define (run-install-shell)
+  (clear-screen)
+  (newt-suspend)
+  (let ((install-ok? (install-system)))
+    (newt-resume)
+    install-ok?))
+
+(define (run-final-page result prev-steps)
+  (let* ((configuration (format-configuration prev-steps result))
+         (user-partitions (result-step result 'partition))
+         (install-ok?
+          (with-mounted-partitions
+           user-partitions
+           (configuration->file configuration)
+           (run-config-display-page)
+           (run-install-shell))))
+    (if install-ok?
+        (run-install-success-page)
+        (run-install-failed-page))))
diff --git a/gnu/installer/record.scm b/gnu/installer/record.scm
index 9c10c65758..bf74040699 100644
--- a/gnu/installer/record.scm
+++ b/gnu/installer/record.scm
@@ -27,6 +27,7 @@
             installer-init
             installer-exit
             installer-exit-error
+            installer-final-page
             installer-keymap-page
             installer-locale-page
             installer-menu-page
@@ -57,6 +58,8 @@
   ;; procedure (key arguments) -> void
   (exit-error installer-exit-error)
   ;; procedure (#:key models layouts) -> (list model layout variant)
+  ;; procedure void -> void
+  (final-page installer-final-page)
   (keymap-page installer-keymap-page)
   ;; procedure: (#:key supported-locales iso639-languages iso3166-territories)
   ;; -> glibc-locale
diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm
index 5fd54356dd..3f0bdad4f7 100644
--- a/gnu/installer/steps.scm
+++ b/gnu/installer/steps.scm
@@ -18,10 +18,13 @@
 
 (define-module (gnu installer steps)
   #:use-module (guix records)
+  #:use-module (guix build utils)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 pretty-print)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
+  #:use-module (rnrs io ports)
   #:export (&installer-step-abort
             installer-step-abort?
 
@@ -35,13 +38,19 @@
             installer-step-id
             installer-step-description
             installer-step-compute
-            installer-step-configuration-proc
+            installer-step-configuration-formatter
 
             run-installer-steps
             find-step-by-id
             result->step-ids
             result-step
-            result-step-done?))
+            result-step-done?
+
+            %installer-configuration-file
+            %installer-target-dir
+            %configuration-file-width
+            format-configuration
+            configuration->file))
 
 ;; This condition may be raised to abort the current step.
 (define-condition-type &installer-step-abort &condition
@@ -60,12 +69,12 @@
 (define-record-type* <installer-step>
   installer-step make-installer-step
   installer-step?
-  (id                           installer-step-id) ;symbol
-  (description                  installer-step-description ;string
-                                (default #f))
-  (compute                      installer-step-compute) ;procedure
-  (configuration-format-proc    installer-step-configuration-proc ;procedure
-                                (default #f)))
+  (id                         installer-step-id) ;symbol
+  (description                installer-step-description ;string
+                              (default #f))
+  (compute                    installer-step-compute) ;procedure
+  (configuration-formatter    installer-step-configuration-formatter ;procedure
+                              (default #f)))
 
 (define* (run-installer-steps #:key
                               steps
@@ -157,7 +166,7 @@ return the accumalated result so far."
                   (reverse result)))
          (let* ((id (installer-step-id step))
                 (compute (installer-step-compute step))
-                (res (compute result)))
+                (res (compute result done-steps)))
            (run (alist-cons id res result)
                 #:todo-steps rest-steps
                 #:done-steps (append done-steps (list step))))))))
@@ -185,3 +194,44 @@ RESULTS."
   "Return #t if the installer-step specified by STEP-ID has a COMPUTE value
 stored in RESULTS. Return #f otherwise."
   (and (assoc step-id results) #t))
+
+(define %installer-configuration-file (make-parameter "/mnt/etc/config.scm"))
+(define %installer-target-dir (make-parameter "/mnt"))
+(define %configuration-file-width (make-parameter 79))
+
+(define (format-configuration steps results)
+  "Return the list resulting from the application of the procedure defined in
+CONFIGURATION-FORMATTER field of <installer-step> on the associated result
+found in RESULTS."
+  (let ((configuration
+         (append-map
+          (lambda (step)
+            (let* ((step-id (installer-step-id step))
+                   (conf-formatter
+                    (installer-step-configuration-formatter step))
+                   (result-step (result-step results step-id)))
+              (if (and result-step conf-formatter)
+                  (conf-formatter result-step)
+                  '())))
+          steps))
+        (modules '((use-modules (gnu))
+                   (use-service-modules desktop))))
+    `(,@modules
+      ()
+      (operating-system ,@configuration))))
+
+(define* (configuration->file configuration
+                              #:key (filename (%installer-configuration-file)))
+  "Write the given CONFIGURATION to FILENAME."
+  (mkdir-p (dirname filename))
+  (call-with-output-file filename
+    (lambda (port)
+      (format port ";; This is an operating system configuration generated~%")
+      (format port ";; by the graphical installer.~%")
+      (newline port)
+      (for-each (lambda (part)
+                  (if (null? part)
+                      (newline port)
+                      (pretty-print part port)))
+                configuration)
+      (flush-output-port port))))
diff --git a/gnu/installer/timezone.scm b/gnu/installer/timezone.scm
index 061e8c2e48..32bc2ed6bb 100644
--- a/gnu/installer/timezone.scm
+++ b/gnu/installer/timezone.scm
@@ -28,7 +28,8 @@
   #:export (locate-childrens
             timezone->posix-tz
             timezone-has-child?
-            zonetab->timezone-tree))
+            zonetab->timezone-tree
+            posix-tz->configuration))
 
 (define %not-blank
   (char-set-complement char-set:blank))
@@ -115,3 +116,12 @@ TREE. Raise a condition if the PATH could not be found."
 (define* (zonetab->timezone-tree zonetab)
   "Return the timezone tree corresponding to the given ZONETAB file."
   (timezones->timezone-tree (zonetab->timezones zonetab)))
+
+
+;;;
+;;; Configuration formatter.
+;;;
+
+(define (posix-tz->configuration timezone)
+  "Return the configuration field for TIMEZONE."
+  `((timezone ,timezone)))