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:
parent
2cfc8d6964
commit
3c0128b035
@ -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.
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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,
|
||||||
|
@ -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.
|
||||||
|
Loading…
Reference in New Issue
Block a user