discovery: Remove dependency on (guix ui).

This reduces the closure of (guix discovery) from 28 to 8 modules.

* guix/discovery.scm (scheme-files): Use 'format' instead of 'warning'.
(scheme-modules): Add #:warn parameter.  Use it instead of
'warn-about-load-error'.
(fold-modules): Add #:warn and pass it to 'scheme-modules'.
(all-modules): Likewise.
* gnu/bootloader.scm (bootloader-modules): Pass #:warn to 'all-modules'.
* gnu/packages.scm (fold-packages): Likewise.
* gnu/services.scm (all-service-modules): Likewise.
* guix/upstream.scm (importer-modules): Likewise.
This commit is contained in:
Ludovic Courtès 2018-03-26 23:42:59 +02:00
parent 2cfc8d6964
commit 3c0128b035
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
5 changed files with 28 additions and 17 deletions

View File

@ -146,7 +146,8 @@
"Return the list of bootloader modules." "Return the list of bootloader modules."
(all-modules (map (lambda (entry) (all-modules (map (lambda (entry)
`(,entry . "gnu/bootloader")) `(,entry . "gnu/bootloader"))
%load-path))) %load-path)
#:warn warn-about-load-error))
(define %bootloaders (define %bootloaders
;; The list of publically-known bootloaders. ;; The list of publically-known bootloaders.

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016, 2017 Alex Kost <alezost@gmail.com> ;;; Copyright © 2016, 2017 Alex Kost <alezost@gmail.com>
@ -159,7 +159,9 @@ for system '~a'")
(define* (fold-packages proc init (define* (fold-packages proc init
#:optional #:optional
(modules (all-modules (%package-module-path))) (modules (all-modules (%package-module-path)
#:warn
warn-about-load-error))
#:key (select? (negate hidden-package?))) #:key (select? (negate hidden-package?)))
"Call (PROC PACKAGE RESULT) for each available package defined in one of "Call (PROC PACKAGE RESULT) for each available package defined in one of
MODULES that matches SELECT?, using INIT as the initial value of RESULT. It MODULES that matches SELECT?, using INIT as the initial value of RESULT. It

View File

@ -181,7 +181,8 @@
(define (all-service-modules) (define (all-service-modules)
"Return the default set of service modules." "Return the default set of service modules."
(cons (resolve-interface '(gnu services)) (cons (resolve-interface '(gnu services))
(all-modules (%service-type-path)))) (all-modules (%service-type-path)
#:warn warn-about-load-error)))
(define* (fold-service-types proc seed (define* (fold-service-types proc seed
#:optional #:optional

View File

@ -17,7 +17,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix discovery) (define-module (guix discovery)
#:use-module (guix ui) #:use-module (guix i18n)
#:use-module (guix modules) #:use-module (guix modules)
#:use-module (guix combinators) #:use-module (guix combinators)
#:use-module (guix build syscalls) #:use-module (guix build syscalls)
@ -86,13 +86,18 @@ DIRECTORY is not accessible."
(lambda args (lambda args
(let ((errno (system-error-errno args))) (let ((errno (system-error-errno args)))
(unless (= errno ENOENT) (unless (= errno ENOENT)
(warning (G_ "cannot access `~a': ~a~%") (format (current-error-port) ;XXX
directory (strerror errno))) (G_ "cannot access `~a': ~a~%")
directory (strerror errno)))
'()))))) '())))))
(define* (scheme-modules directory #:optional sub-directory) (define* (scheme-modules directory #:optional sub-directory
#:key (warn (const #f)))
"Return the list of Scheme modules available under DIRECTORY. "Return the list of Scheme modules available under DIRECTORY.
Optionally, narrow the search to SUB-DIRECTORY." Optionally, narrow the search to SUB-DIRECTORY.
WARN is called when a module could not be loaded. It is passed the module
name and the exception key and arguments."
(define prefix-len (define prefix-len
(string-length directory)) (string-length directory))
@ -104,31 +109,32 @@ Optionally, narrow the search to SUB-DIRECTORY."
(resolve-interface module)) (resolve-interface module))
(lambda args (lambda args
;; Report the error, but keep going. ;; Report the error, but keep going.
(warn-about-load-error module args) (warn module args)
#f)))) #f))))
(scheme-files (if sub-directory (scheme-files (if sub-directory
(string-append directory "/" sub-directory) (string-append directory "/" sub-directory)
directory)))) directory))))
(define (fold-modules proc init path) (define* (fold-modules proc init path #:key (warn (const #f)))
"Fold over all the Scheme modules present in PATH, a list of directories. "Fold over all the Scheme modules present in PATH, a list of directories.
Call (PROC MODULE RESULT) for each module that is found." Call (PROC MODULE RESULT) for each module that is found."
(fold (lambda (spec result) (fold (lambda (spec result)
(match spec (match spec
((? string? directory) ((? string? directory)
(fold proc result (scheme-modules directory))) (fold proc result (scheme-modules directory #:warn warn)))
((directory . sub-directory) ((directory . sub-directory)
(fold proc result (fold proc result
(scheme-modules directory sub-directory))))) (scheme-modules directory sub-directory
#:warn warn)))))
'() '()
path)) path))
(define (all-modules path) (define* (all-modules path #:key (warn (const #f)))
"Return the list of package modules found in PATH, a list of directories to "Return the list of package modules found in PATH, a list of directories to
search. Entries in PATH can be directory names (strings) or (DIRECTORY search. Entries in PATH can be directory names (strings) or (DIRECTORY
. SUB-DIRECTORY) pairs, in which case modules are searched for beneath . SUB-DIRECTORY) pairs, in which case modules are searched for beneath
SUB-DIRECTORY." SUB-DIRECTORY."
(fold-modules cons '() path)) (fold-modules cons '() path #:warn warn))
(define (fold-module-public-variables proc init modules) (define (fold-module-public-variables proc init modules)
"Call (PROC OBJECT RESULT) for each variable exported by one of MODULES, "Call (PROC OBJECT RESULT) for each variable exported by one of MODULES,

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Alex Kost <alezost@gmail.com> ;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -153,7 +153,8 @@ correspond to the same version."
(cons (resolve-interface '(guix gnu-maintenance)) (cons (resolve-interface '(guix gnu-maintenance))
(all-modules (map (lambda (entry) (all-modules (map (lambda (entry)
`(,entry . "guix/import")) `(,entry . "guix/import"))
%load-path)))) %load-path)
#:warn warn-about-load-error)))
(define %updaters (define %updaters
;; The list of publically-known updaters. ;; The list of publically-known updaters.