;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020-2022 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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 steps)
  #:use-module (guix records)
  #:use-module (guix build utils)
  #:use-module (guix i18n)
  #:use-module (guix read-print)
  #:use-module (gnu installer utils)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-1)
  #:use-module </td></tr></table>
<table class='tabs'><tr><td>
<a href='/guix/about/'>about</a><a href='/guix/'>summary</a><a href='/guix/refs/?id=f63f524053a9a8503bf98532b6b3d91b17c1d7c0'>refs</a><a href='/guix/log/gnu/tests/rsync.scm'>log</a><a href='/guix/tree/gnu/tests/rsync.scm?id=f63f524053a9a8503bf98532b6b3d91b17c1d7c0'>tree</a><a href='/guix/commit/gnu/tests/rsync.scm?id=f63f524053a9a8503bf98532b6b3d91b17c1d7c0'>commit</a><a class='active' href='/guix/diff/gnu/tests/rsync.scm?id=f63f524053a9a8503bf98532b6b3d91b17c1d7c0&amp;id2=7afdd8da581c534d8fa9d780b30e50521d653139'>diff</a></td><td class='form'><form class='right' method='get' action='/guix/log/gnu/tests/rsync.scm'>
<input type='hidden' name='id' value='f63f524053a9a8503bf98532b6b3d91b17c1d7c0'/><input type='hidden' name='id2' value='7afdd8da581c534d8fa9d780b30e50521d653139'/><select name='qt'>
<option value='grep'>log msg</option>
<option value='author'>author</option>
<option value='committer'>committer</option>
<option value='range'>range</option>
</select>
<input class='txt' type='search' size='10' name='q' value=''/>
<input type='submit' value='search'/>
</form>
</td></tr></table>
<div class='path'>path: <a href='/guix/diff/?id=f63f524053a9a8503bf98532b6b3d91b17c1d7c0&amp;id2=7afdd8da581c534d8fa9d780b30e50521d653139'>root</a>/<a href='/guix/diff/gnu?id=f63f524053a9a8503bf98532b6b3d91b17c1d7c0&amp;id2=7afdd8da581c534d8fa9d780b30e50521d653139'>gnu</a>/<a href='/guix/diff/gnu/tests?id=f63f524053a9a8503bf98532b6b3d91b17c1d7c0&amp;id2=7afdd8da581c534d8fa9d780b30e50521d653139'>tests</a>/<a href='/guix/diff/gnu/tests/rsync.scm?id=f63f524053a9a8503bf98532b6b3d91b17c1d7c0&amp;id2=7afdd8da581c534d8fa9d780b30e50521d653139'>rsync.scm</a></div><div class='content'><div class='cgit-panel'><b>diff options</b><form method='get'><input type='hidden' name='id' value='f63f524053a9a8503bf98532b6b3d91b17c1d7c0'/><input type='hidden' name='id2' value='7afdd8da581c534d8fa9d780b30e50521d653139'/><table><tr><td colspan='2'/></tr><tr><td class='label'>context:</td><td class='ctrl'><select name='context' onchange='this.form.submit();'><option value='1'>1</option><option value='2'>2</option><option value='3' selected='selected'>3</option><option value='4'>4</option><option value='5'>5</option><option value='6'>6</option><option value='7'>7</option><option value='8'>8</option><option value='9'>9</option><option value='10'>10</option><option value='15'>15</option><option value='20'>20</option><option value='25'>25</option><option value='30'>30</option><option value='35'>35</option><option value='40'>40</option></select></td></tr><tr><td class='label'>space:</td><td class='ctrl'><select name='ignorews' onchange='this.form.submit();'><option value='0' selected='selected'>include</option><option value='1'>ignore</option></select></td></tr><tr><td class='label'>mode:</td><td class='ctrl'><select name='dt' onchange='this.form.submit();'><option value='0' selected='selected'>unified</option><option value='1'>ssdiff</option><option value='2'>stat only</option></select></td></tr><tr><td/><td class='ctrl'><noscript><input type='submit' value='reload'/></noscript></td></tr></table></form></div><div class='diffstat-header'><a href='/guix/diff/?id=f63f524053a9a8503bf98532b6b3d91b17c1d7c0&amp;id2=7afdd8da581c534d8fa9d780b30e50521d653139'>Diffstat</a> (limited to 'gnu/tests/rsync.scm')</div><table summary='diffstat' class='diffstat'></table><div class='diffstat-summary'>0 files changed, 0 insertions, 0 deletions</div><table summary='diff' class='diff'><tr><td></td></tr></table></div> <!-- class=content -->
                         <div class=footer>generated by
                             <a href="https://git.zx2c4.com/cgit/about/">
                                 cgit
                             </a>
                         </div>
                        </div> <!-- id=cgit -->
</body>
</html>
#:todo-steps todo-steps
                #:done-steps done-steps))
          ((and (not found?)
                (null? done-steps))
           (error (format #f "Step ~a not found" (installer-step-id step))))
          (else
           (match done-steps
             ((prev-done ... last-done)
              (skip-to-step step (pop-result result)
                            #:todo-steps (cons last-done todo-steps)
                            #:done-steps prev-done)))))))))

  (define* (run result #:key todo-steps done-steps)
    (match todo-steps
      (() (reverse result))
      ((step . rest-steps)
       (call-with-prompt 'installer-step
         (lambda ()
           (installer-log-line "running step '~a'" (installer-step-id step))
           (let* ((id (installer-step-id step))
                  (compute (installer-step-compute step))
                  (res (compute result done-steps)))
             (hash-set! %current-result id res)
             (run (alist-cons id res result)
                  #:todo-steps rest-steps
                  #:done-steps (append done-steps (list step)))))
         (lambda (k action)
           (match action
             ('abort
              (case rewind-strategy
                ((previous)
                 (match done-steps
                   (()
                    ;; We cannot go previous the first step. Abort again to
                    ;; 'installer-step prompt. It might be useful in the case
                    ;; of nested run-installer-steps.
                    (abort-to-prompt 'installer-step action))
                   ((prev-done ... last-done)
                    (run (pop-result result)
                         #:todo-steps (cons last-done todo-steps)
                         #:done-steps prev-done))))
                ((menu)
                 (let ((goto-step (menu-proc
                                   (append done-steps (list step)))))
                   (if (eq? goto-step step)
                       (run result
                            #:todo-steps todo-steps
                            #:done-steps done-steps)
                       (skip-to-step goto-step result
                                     #:todo-steps todo-steps
                                     #:done-steps done-steps))))
                ((start)
                 (if (null? done-steps)
                     ;; Same as above, it makes no sense to jump to start
                     ;; when we are at the first installer-step. Abort to
                     ;; 'installer-step prompt again.
                     (abort-to-prompt 'installer-step action)
                     (run '()
                          #:todo-steps steps
                          #:done-steps '())))))
             ('break
              (reverse result))))))))

  ;; Ignore SIGPIPE so that we don't die if a client closes the connection
  ;; prematurely.
  (sigaction SIGPIPE SIG_IGN)

  (with-server-socket
    (run '()
         #:todo-steps steps
         #:done-steps '())))

(define (find-step-by-id steps id)
  "Find and return the step in STEPS whose id is equal to ID."
  (find (lambda (step)
          (eq? (installer-step-id step) id))
        steps))

(define (result-step results step-id)
  "Return the result of the installer-step specified by STEP-ID in
RESULTS."
  (assoc-ref results step-id))

(define (result-step-done? results step-id)
  "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 (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 `(,(vertical-space 1)
                   ,(comment (G_ "\
;; Indicate which modules to import to access the variables
;; used in this configuration.\n"))
                   (use-modules (gnu))
                   (use-service-modules cups desktop networking ssh xorg))))
    `(,@modules
      ,(vertical-space 1)
      (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)
      ;; TRANSLATORS: This is a comment within a Scheme file.  Each line must
      ;; start with ";; " (two semicolons and a space).  Please keep line
      ;; length below 60 characters.
      (display (G_ "\
;; This is an operating system configuration generated
;; by the graphical installer.
;;
;; Once installation is complete, you can learn and modify
;; this file to tweak the system configuration, and pass it
;; to the 'guix system reconfigure' command to effect your
;; changes.\n")
               port)
      (newline port)
      (pretty-print-with-comments/splice port configuration
                                         #:max-width 75
                                         #:format-comment
                                         (lambda (c indent)
                                           ;; Localize C.
                                           (comment (G_ (comment->string c))
                                                    (comment-margin? c))))

      (flush-output-port port))))

;;; Local Variables:
;;; eval: (put 'with-server-socket 'scheme-indent-function 0)
;;; End: