1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
4 ;;; This file is part of GNU Guix.
6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
7 ;;; under the terms of the GNU General Public License as published by
8 ;;; the Free Software Foundation; either version 3 of the License, or (at
9 ;;; your option) any later version.
11 ;;; GNU Guix is distributed in the hope that it will be useful, but
12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;;; GNU General Public License for more details.
16 ;;; You should have received a copy of the GNU General Public License
17 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
19 (define-module (gnu installer steps)
20 #:use-module (guix records)
21 #:use-module (ice-9 match)
22 #:use-module (srfi srfi-1)
23 #:use-module (srfi srfi-34)
24 #:use-module (srfi srfi-35)
25 #:export (&installer-step-abort
36 installer-step-description
37 installer-step-compute
38 installer-step-configuration-proc
46 ;; This condition may be raised to abort the current step.
47 (define-condition-type &installer-step-abort &condition
48 installer-step-abort?)
50 ;; This condition may be raised to break out from the steps execution.
51 (define-condition-type &installer-step-break &condition
52 installer-step-break?)
54 ;; An installer-step record is basically an id associated to a compute
55 ;; procedure. The COMPUTE procedure takes exactly one argument, an association
56 ;; list containing the results of previously executed installer-steps (see
57 ;; RUN-INSTALLER-STEPS description). The value returned by the COMPUTE
58 ;; procedure will be stored in the results list passed to the next
59 ;; installer-step and so on.
60 (define-record-type* <installer-step>
61 installer-step make-installer-step
63 (id installer-step-id) ;symbol
64 (description installer-step-description ;string
66 (compute installer-step-compute) ;procedure
67 (configuration-format-proc installer-step-configuration-proc ;procedure
70 (define* (run-installer-steps #:key
72 (rewind-strategy 'previous)
73 (menu-proc (const #f)))
74 "Run the COMPUTE procedure of all <installer-step> records in STEPS
75 sequencially. If the &installer-step-abort condition is raised, fallback to a
76 previous install-step, accordingly to the specified REWIND-STRATEGY.
78 REWIND-STRATEGY possible values are 'previous, 'menu and 'start. If 'previous
79 is selected, the execution will resume at the previous installer-step. If
80 'menu is selected, the MENU-PROC procedure will be called. Its return value
81 has to be an installer-step ID to jump to. The ID has to be the one of a
82 previously executed step. It is impossible to jump forward. Finally if 'start
83 is selected, the execution will resume at the first installer-step.
85 The result of every COMPUTE procedures is stored in an association list, under
88 '((STEP-ID . COMPUTE-RESULT) ...)
90 where STEP-ID is the ID field of the installer-step and COMPUTE-RESULT the
91 result of the associated COMPUTE procedure. This result association list is
92 passed as argument of every COMPUTE procedure. It is finally returned when the
95 If the &installer-step-break condition is raised, stop the computation and
96 return the accumalated result so far."
97 (define (pop-result list)
100 (define (first-step? steps step)
102 ((first-step . rest-steps)
103 (equal? first-step step))))
105 (define* (skip-to-step step result
106 #:key todo-steps done-steps)
107 (match (list todo-steps done-steps)
108 (((todo . rest-todo) (prev-done ... last-done))
109 (if (eq? (installer-step-id todo)
110 (installer-step-id step))
112 #:todo-steps todo-steps
113 #:done-steps done-steps)
114 (skip-to-step step (pop-result result)
115 #:todo-steps (cons last-done todo-steps)
116 #:done-steps prev-done)))))
118 (define* (run result #:key todo-steps done-steps)
120 (() (reverse result))
122 (guard (c ((installer-step-abort? c)
123 (case rewind-strategy
127 ;; We cannot go previous the first step. So re-raise
128 ;; the exception. It might be useful in the case of
129 ;; nested run-installer-steps. Abort to 'raise-above
130 ;; prompt to prevent the condition from being catched
131 ;; by one of the previously installed guard.
132 (abort-to-prompt 'raise-above c))
133 ((prev-done ... last-done)
134 (run (pop-result result)
135 #:todo-steps (cons last-done todo-steps)
136 #:done-steps prev-done))))
138 (let ((goto-step (menu-proc
139 (append done-steps (list step)))))
140 (if (eq? goto-step step)
142 #:todo-steps todo-steps
143 #:done-steps done-steps)
144 (skip-to-step goto-step result
145 #:todo-steps todo-steps
146 #:done-steps done-steps))))
148 (if (null? done-steps)
149 ;; Same as above, it makes no sense to jump to start
150 ;; when we are at the first installer-step. Abort to
151 ;; 'raise-above prompt to re-raise the condition.
152 (abort-to-prompt 'raise-above c)
155 #:done-steps '())))))
156 ((installer-step-break? c)
158 (let* ((id (installer-step-id step))
159 (compute (installer-step-compute step))
160 (res (compute result)))
161 (run (alist-cons id res result)
162 #:todo-steps rest-steps
163 #:done-steps (append done-steps (list step))))))))
165 (call-with-prompt 'raise-above
170 (lambda (k condition)
173 (define (find-step-by-id steps id)
174 "Find and return the step in STEPS whose id is equal to ID."
176 (eq? (installer-step-id step) id))
179 (define (result-step results step-id)
180 "Return the result of the installer-step specified by STEP-ID in
182 (assoc-ref results step-id))
184 (define (result-step-done? results step-id)
185 "Return #t if the installer-step specified by STEP-ID has a COMPUTE value
186 stored in RESULTS. Return #f otherwise."
187 (and (assoc step-id results) #t))