civodul pushed a commit to branch wip-pull-multiple-derivations
in repository guix.
commit 509b8be5670fc70f37539b43548faf985e84396d
Author: Ludovic Courtès <l...@gnu.org>
Date: Mon Mar 26 23:42:59 2018 +0200
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.
---
gnu/bootloader.scm | 3 ++-
gnu/packages.scm | 6 ++++--
gnu/services.scm | 3 ++-
guix/discovery.scm | 28 +++++++++++++++++-----------
guix/upstream.scm | 5 +++--
5 files changed, 28 insertions(+), 17 deletions(-)
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 736f119..4f2c71c 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -146,7 +146,8 @@
"Return the list of bootloader modules."
(all-modules (map (lambda (entry)
`(,entry . "gnu/bootloader"))
- %load-path)))
+ %load-path)
+ #:warn warn-about-load-error))
(define %bootloaders
;; The list of publically-known bootloaders.
diff --git a/gnu/packages.scm b/gnu/packages.scm
index 44a56df..1a37a17 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès
<l...@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès
<l...@gnu.org>
;;; Copyright © 2013 Mark H Weaver <m...@netris.org>
;;; Copyright © 2014 Eric Bavier <bav...@member.fsf.org>
;;; Copyright © 2016, 2017 Alex Kost <alez...@gmail.com>
@@ -159,7 +159,9 @@ for system '~a'")
(define* (fold-packages proc init
#:optional
- (modules (all-modules (%package-module-path)))
+ (modules (all-modules (%package-module-path)
+ #:warn
+ warn-about-load-error))
#:key (select? (negate hidden-package?)))
"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
diff --git a/gnu/services.scm b/gnu/services.scm
index 2fcacb9..81af4df 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -181,7 +181,8 @@
(define (all-service-modules)
"Return the default set of service modules."
(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
#:optional
diff --git a/guix/discovery.scm b/guix/discovery.scm
index 8ffcf7c..2b627d1 100644
--- a/guix/discovery.scm
+++ b/guix/discovery.scm
@@ -17,7 +17,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(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,
diff --git a/guix/upstream.scm b/guix/upstream.scm
index caaa0e4..9e1056f 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès
<l...@gnu.org>
+;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic
Courtès <l...@gnu.org>
;;; Copyright © 2015 Alex Kost <alez...@gmail.com>
;;;
;;; This file is part of GNU Guix.
@@ -153,7 +153,8 @@ correspond to the same version."
(cons (resolve-interface '(guix gnu-maintenance))
(all-modules (map (lambda (entry)
`(,entry . "guix/import"))
- %load-path))))
+ %load-path)
+ #:warn warn-about-load-error)))
(define %updaters
;; The list of publically-known updaters.
