From 3c0128b035ae00462f1b0a4427d9525d750e5575 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 26 Mar 2018 23:42:59 +0200 Subject: 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. --- guix/discovery.scm | 28 +++++++++++++++++----------- 1 file changed, 17 insertions(+), 11 deletions(-) (limited to 'guix/discovery.scm') diff --git a/guix/discovery.scm b/guix/discovery.scm index 8ffcf7cd9a..2b627d108e 100644 --- a/guix/discovery.scm +++ b/guix/discovery.scm @@ -17,7 +17,7 @@ ;;; along with GNU Guix. If not, see . (define-module (guix discovery) - #:use-module (guix ui) + #:use-module (guix i18n) #:use-module (guix modules) #:use-module (guix combinators) #:use-module (guix build syscalls) @@ -86,13 +86,18 @@ DIRECTORY is not accessible." (lambda args (let ((errno (system-error-errno args))) (unless (= errno ENOENT) - (warning (G_ "cannot access `~a': ~a~%") - directory (strerror errno))) + (format (current-error-port) ;XXX + (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. -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 (string-length directory)) @@ -104,31 +109,32 @@ Optionally, narrow the search to SUB-DIRECTORY." (resolve-interface module)) (lambda args ;; Report the error, but keep going. - (warn-about-load-error module args) + (warn module args) #f)))) (scheme-files (if sub-directory (string-append directory "/" sub-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. Call (PROC MODULE RESULT) for each module that is found." (fold (lambda (spec result) (match spec ((? string? directory) - (fold proc result (scheme-modules directory))) + (fold proc result (scheme-modules directory #:warn warn))) ((directory . sub-directory) (fold proc result - (scheme-modules directory sub-directory))))) + (scheme-modules directory sub-directory + #:warn warn))))) '() 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 search. Entries in PATH can be directory names (strings) or (DIRECTORY . SUB-DIRECTORY) pairs, in which case modules are searched for beneath SUB-DIRECTORY." - (fold-modules cons '() path)) + (fold-modules cons '() path #:warn warn)) (define (fold-module-public-variables proc init modules) "Call (PROC OBJECT RESULT) for each variable exported by one of MODULES, -- cgit v1.2.3