guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

05/07: discovery: Remove dependency on (guix ui).


From: Ludovic Courtès
Subject: 05/07: discovery: Remove dependency on (guix ui).
Date: Tue, 27 Mar 2018 16:50:24 -0400 (EDT)

civodul pushed a commit to branch wip-pull-multiple-derivations
in repository guix.

commit 11029041bde7b83e426b613756203eb3fcc4668f
Author: Ludovic Courtès <address@hidden>
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 
<address@hidden>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès 
<address@hidden>
 ;;; Copyright © 2013 Mark H Weaver <address@hidden>
 ;;; Copyright © 2014 Eric Bavier <address@hidden>
 ;;; Copyright © 2016, 2017 Alex Kost <address@hidden>
@@ -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 b020d97..ab00eea 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 
<address@hidden>
+;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic 
Courtès <address@hidden>
 ;;; Copyright © 2015 Alex Kost <address@hidden>
 ;;;
 ;;; 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.



reply via email to

[Prev in Thread] Current Thread [Next in Thread]