[jackhill/guix/guix.git] / gnu / installer / steps.scm

;;; 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 steps)
  #:use-module (guix records)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-34)
  #:use-module (srfi srfi-35)
  #:export (&installer-step-abort
            installer-step-abort?

            &installer-step-break
            installer-step-break?

            <installer-step>
            installer-step
            make-installer-step
            installer-step?
            installer-step-id
            installer-step-description
            installer-step-compute
            installer-step-configuration-proc

            run-installer-steps
            find-step-by-id
            result->step-ids
            result-step
            result-step-done?))

;; This condition may be raised to abort the current step.
(define-condition-type &installer-step-abort &condition
  installer-step-abort?)

;; This condition may be raised to break out from the steps execution.
(define-condition-type &installer-step-break &condition
  installer-step-break?)

;; An installer-step record is basically an id associated to a compute
;; procedure. The COMPUTE procedure takes exactly one argument, an association
;; list containing the results of previously executed installer-steps (see
;; RUN-INSTALLER-STEPS description). The value returned by the COMPUTE
;; procedure will be stored in the results list passed to the next
;; installer-step and so on.
(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)))

(define* (run-installer-steps #:key
                              steps
                              (rewind-strategy 'previous)
                              (menu-proc (const #f)))
  "Run the COMPUTE procedure of all <installer-step> records in STEPS
sequencially. If the &installer-step-abort condition is raised, fallback to a
previous install-step, accordingly to the specified REWIND-STRATEGY.

REWIND-STRATEGY possible values are 'previous, 'menu and 'start.  If 'previous
is selected, the execution will resume at the previous installer-step. If
'menu is selected, the MENU-PROC procedure will be called. Its return value
has to be an installer-step ID to jump to. The ID has to be the one of a
previously executed step. It is impossible to jump forward. Finally if 'start
is selected, the execution will resume at the first installer-step.

The result of every COMPUTE procedures is stored in an association list, under
the form:

		'((STEP-ID . COMPUTE-RESULT) ...)

where STEP-ID is the ID field of the installer-step and COMPUTE-RESULT the
result of the associated COMPUTE procedure. This result association list is
passed as argument of every COMPUTE procedure. It is finally returned when the
computation is over.

If the &installer-step-break condition is raised, stop the computation and
return the accumalated result so far."
  (define (pop-result list)
    (cdr list))

  (define (first-step? steps step)
    (match steps
      ((first-step . rest-steps)
       (equal? first-step step))))

  (define* (skip-to-step step result
                         #:key todo-steps done-steps)
    (match (list todo-steps done-steps)
      (((todo . rest-todo) (prev-done ... last-done))
       (if (eq? (installer-step-id todo)
                (installer-step-id step))
           (run result
                #:todo-steps todo-steps
                #:done-steps done-steps)
           (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)
       (guard (c ((installer-step-abort? c)
                  (case rewind-strategy
                    ((previous)
                     (match done-steps
                       (()
                        ;; We cannot go previous the first step. So re-raise
                        ;; the exception. It might be useful in the case of
                        ;; nested run-installer-steps. Abort to 'raise-above
                        ;; prompt to prevent the condition from being catched
                        ;; by one of the previously installed guard.
                        (abort-to-prompt 'raise-above c))
                       ((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
                         ;; 'raise-above prompt to re-raise the condition.
                         (abort-to-prompt 'raise-above c)
                         (run '()
                              #:todo-steps steps
                              #:done-steps '())))))
                 ((installer-step-break? c)
                  (reverse result)))
         (let* ((id (installer-step-id step))
                (compute (installer-step-compute step))
                (res (compute result)))
           (run (alist-cons id res result)
                #:todo-steps rest-steps
                #:done-steps (append done-steps (list step))))))))

  (call-with-prompt 'raise-above
    (lambda ()
      (run '()
           #:todo-steps steps
           #:done-steps '()))
    (lambda (k condition)
      (raise condition))))

(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))
Commit	Line	Data
d0f3a672 MO	1	;;; GNU Guix --- Functional package management for GNU
	2	;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
	3	;;;
	4	;;; This file is part of GNU Guix.
	5	;;;
	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.
	10	;;;
	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.
	15	;;;
	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/>.
	18
	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
	26	installer-step-abort?
	27
	28	&installer-step-break
	29	installer-step-break?
	30
	31	<installer-step>
	32	installer-step
	33	make-installer-step
	34	installer-step?
	35	installer-step-id
	36	installer-step-description
	37	installer-step-compute
	38	installer-step-configuration-proc
	39
	40	run-installer-steps
	41	find-step-by-id
	42	result->step-ids
	43	result-step
	44	result-step-done?))
	45
	46	;; This condition may be raised to abort the current step.
	47	(define-condition-type &installer-step-abort &condition
	48	installer-step-abort?)
	49
	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?)
	53
	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
	62	installer-step?
	63	(id installer-step-id) ;symbol
	64	(description installer-step-description ;string
65	(default #f))
66	(compute installer-step-compute) ;procedure
67	(configuration-format-proc installer-step-configuration-proc ;procedure
68	(default #f)))
69
70	(define* (run-installer-steps #:key
71	steps
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.
77
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.
84
85	The result of every COMPUTE procedures is stored in an association list, under
86	the form:
87
88	'((STEP-ID . COMPUTE-RESULT) ...)
89
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
93	computation is over.
94
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)
98	(cdr list))
99
100	(define (first-step? steps step)
101	(match steps
102	((first-step . rest-steps)
103	(equal? first-step step))))
104
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))
111	(run result
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)))))
117
118	(define* (run result #:key todo-steps done-steps)
119	(match todo-steps
120	(() (reverse result))
121	((step . rest-steps)
122	(guard (c ((installer-step-abort? c)
123	(case rewind-strategy
124	((previous)
125	(match done-steps
126	(()
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))))
137	((menu)
138	(let ((goto-step (menu-proc
139	(append done-steps (list step)))))
140	(if (eq? goto-step step)
141	(run result
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))))
147	((start)
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)
153	(run '()
154	#:todo-steps steps
155	#:done-steps '())))))
156	((installer-step-break? c)
157	(reverse result)))
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))))))))
164
165	(call-with-prompt 'raise-above
166	(lambda ()
167	(run '()
168	#:todo-steps steps
169	#:done-steps '()))
170	(lambda (k condition)
171	(raise condition))))
172
173	(define (find-step-by-id steps id)
174	"Find and return the step in STEPS whose id is equal to ID."
175	(find (lambda (step)
176	(eq? (installer-step-id step) id))
177	steps))
178
179	(define (result-step results step-id)
180	"Return the result of the installer-step specified by STEP-ID in
181	RESULTS."
182	(assoc-ref results step-id))
183
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))