ui: Factorize user-provided Scheme file loading.
* guix/ui.scm (make-user-module, load*): New procedures. * guix/scripts/system.scm (%user-module): Define in terms of 'make-user-module'. (read-operating-system): Define in terms of load*'.
This commit is contained in:
parent
d620ea889c
commit
7ea1432e22
|
@ -48,28 +48,14 @@
|
||||||
|
|
||||||
(define %user-module
|
(define %user-module
|
||||||
;; Module in which the machine description file is loaded.
|
;; Module in which the machine description file is loaded.
|
||||||
(let ((module (make-fresh-user-module)))
|
(make-user-module '((gnu system)
|
||||||
(for-each (lambda (iface)
|
|
||||||
(module-use! module (resolve-interface iface)))
|
|
||||||
'((gnu system)
|
|
||||||
(gnu services)
|
(gnu services)
|
||||||
(gnu system shadow)))
|
(gnu system shadow))))
|
||||||
module))
|
|
||||||
|
|
||||||
(define (read-operating-system file)
|
(define (read-operating-system file)
|
||||||
"Read the operating-system declaration from FILE and return it."
|
"Read the operating-system declaration from FILE and return it."
|
||||||
;; TODO: Factorize.
|
(load* file %user-module))
|
||||||
(catch #t
|
|
||||||
(lambda ()
|
|
||||||
;; Avoid ABI incompatibility with the <operating-system> record.
|
|
||||||
(set! %fresh-auto-compile #t)
|
|
||||||
|
|
||||||
(save-module-excursion
|
|
||||||
(lambda ()
|
|
||||||
(set-current-module %user-module)
|
|
||||||
(primitive-load file))))
|
|
||||||
(lambda args
|
|
||||||
(report-load-error file args))))
|
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
|
24
guix/ui.scm
24
guix/ui.scm
|
@ -48,6 +48,8 @@
|
||||||
P_
|
P_
|
||||||
report-error
|
report-error
|
||||||
leave
|
leave
|
||||||
|
make-user-module
|
||||||
|
load*
|
||||||
report-load-error
|
report-load-error
|
||||||
warn-about-load-error
|
warn-about-load-error
|
||||||
show-version-and-exit
|
show-version-and-exit
|
||||||
|
@ -133,6 +135,28 @@ messages."
|
||||||
(report-error args ...)
|
(report-error args ...)
|
||||||
(exit 1)))
|
(exit 1)))
|
||||||
|
|
||||||
|
(define (make-user-module modules)
|
||||||
|
"Return a new user module with the additional MODULES loaded."
|
||||||
|
;; Module in which the machine description file is loaded.
|
||||||
|
(let ((module (make-fresh-user-module)))
|
||||||
|
(for-each (lambda (iface)
|
||||||
|
(module-use! module (resolve-interface iface)))
|
||||||
|
modules)
|
||||||
|
module))
|
||||||
|
|
||||||
|
(define (load* file user-module)
|
||||||
|
"Load the user provided Scheme source code FILE."
|
||||||
|
(catch #t
|
||||||
|
(lambda ()
|
||||||
|
(set! %fresh-auto-compile #t)
|
||||||
|
|
||||||
|
(save-module-excursion
|
||||||
|
(lambda ()
|
||||||
|
(set-current-module user-module)
|
||||||
|
(primitive-load file))))
|
||||||
|
(lambda args
|
||||||
|
(report-load-error file args))))
|
||||||
|
|
||||||
(define (report-load-error file args)
|
(define (report-load-error file args)
|
||||||
"Report the failure to load FILE, a user-provided Scheme file, and exit.
|
"Report the failure to load FILE, a user-provided Scheme file, and exit.
|
||||||
ARGS is the list of arguments received by the 'throw' handler."
|
ARGS is the list of arguments received by the 'throw' handler."
|
||||||
|
|
Loading…
Reference in New Issue