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
					
				
					 2 changed files with 28 additions and 18 deletions
				
			
		| 
						 | 
				
			
			@ -48,28 +48,14 @@
 | 
			
		|||
 | 
			
		||||
(define %user-module
 | 
			
		||||
  ;; 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)))
 | 
			
		||||
              '((gnu system)
 | 
			
		||||
  (make-user-module '((gnu system)
 | 
			
		||||
                      (gnu services)
 | 
			
		||||
                (gnu system shadow)))
 | 
			
		||||
    module))
 | 
			
		||||
                      (gnu system shadow))))
 | 
			
		||||
 | 
			
		||||
(define (read-operating-system file)
 | 
			
		||||
  "Read the operating-system declaration from FILE and return it."
 | 
			
		||||
  ;; TODO: Factorize.
 | 
			
		||||
  (catch #t
 | 
			
		||||
    (lambda ()
 | 
			
		||||
      ;; Avoid ABI incompatibility with the <operating-system> record.
 | 
			
		||||
      (set! %fresh-auto-compile #t)
 | 
			
		||||
  (load* file %user-module))
 | 
			
		||||
 | 
			
		||||
      (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_
 | 
			
		||||
            report-error
 | 
			
		||||
            leave
 | 
			
		||||
            make-user-module
 | 
			
		||||
            load*
 | 
			
		||||
            report-load-error
 | 
			
		||||
            warn-about-load-error
 | 
			
		||||
            show-version-and-exit
 | 
			
		||||
| 
						 | 
				
			
			@ -133,6 +135,28 @@ messages."
 | 
			
		|||
    (report-error args ...)
 | 
			
		||||
    (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)
 | 
			
		||||
  "Report the failure to load FILE, a user-provided Scheme file, and exit.
 | 
			
		||||
ARGS is the list of arguments received by the 'throw' handler."
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Reference in a new issue