processes: Allow 'less' to properly estimate line length.

[jackhill/guix/guix.git] / guix / discovery.scm

diff --git a/guix/discovery.scm b/guix/discovery.scm
index 3fc6e2c..b84b9ff 100644 (file)
--- a/guix/discovery.scm
+++ b/guix/discovery.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -30,7 +30,8 @@
             scheme-modules*
             fold-modules
             all-modules
-            fold-module-public-variables))
+            fold-module-public-variables
+            fold-module-public-variables*))
 
 ;;; Commentary:
 ;;;
@@ -50,13 +51,15 @@ DIRECTORY is not accessible."
       ((? symbol? type)
        type)))
 
+  (define (dot-prefixed? file)
+    (string-prefix? "." file))
+
   ;; Use 'scandir*' so we can avoid an extra 'lstat' for each entry, as
   ;; opposed to Guile's 'scandir' or 'file-system-fold'.
   (fold-right (lambda (entry result)
                 (match entry
-                  (("." . _)
-                   result)
-                  ((".." . _)
+                  (((? dot-prefixed?) . _)
+                   ;; Exclude ".", "..", and hidden files such as backups.
                    result)
                   ((name . properties)
                    (let ((absolute (string-append directory "/" name)))
@@ -77,7 +80,9 @@ DIRECTORY is not accessible."
                                  ((= stat:type 'directory)
                                   (append (scheme-files absolute)
                                           result))
-                                 (_ result)))))
+                                 (_ result)))
+                              (else
+                               result)))
                        (else
                         result))))))
               '()
@@ -103,14 +108,14 @@ name and the exception key and arguments."
     (string-length directory))
 
   (filter-map (lambda (file)
-                (let* ((file   (substring file prefix-len))
-                       (module (file-name->module-name file)))
+                (let* ((relative (string-drop file prefix-len))
+                       (module   (file-name->module-name relative)))
                   (catch #t
                     (lambda ()
                       (resolve-interface module))
                     (lambda args
                       ;; Report the error, but keep going.
-                      (warn module args)
+                      (warn file module args)
                       #f))))
               (scheme-files (if sub-directory
                                 (string-append directory "/" sub-directory)
@@ -144,13 +149,36 @@ Call (PROC MODULE RESULT) for each module that is found."
   "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 #:warn warn))
+SUB-DIRECTORY. Modules are listed in the order they appear on the path."
+  (reverse (fold-modules cons '() path #:warn warn)))
+
+(define (fold-module-public-variables* proc init modules)
+  "Call (PROC MODULE SYMBOL VARIABLE RESULT) for each variable exported by one
+of MODULES, using INIT as the initial value of RESULT.  It is guaranteed to
+never traverse the same object twice."
+  ;; Here SEEN is populated by variables; if two different variables refer to
+  ;; the same object, we still let them through.
+  (identity                                       ;discard second return value
+   (fold2 (lambda (module result seen)
+            (fold2 (lambda (sym+var result seen)
+                     (match sym+var
+                       ((sym . var)
+                        (if (not (vhash-assq var seen))
+                            (values (proc module sym var result)
+                                    (vhash-consq var #t seen))
+                            (values result seen)))))
+                   result
+                   seen
+                   (module-map cons module)))
+          init
+          vlist-null
+          modules)))
 
 (define (fold-module-public-variables proc init modules)
   "Call (PROC OBJECT RESULT) for each variable exported by one of MODULES,
 using INIT as the initial value of RESULT.  It is guaranteed to never traverse
 the same object twice."
+  ;; Note: here SEEN is populated by objects, not by variables.
   (identity   ; discard second return value
    (fold2 (lambda (module result seen)
             (fold2 (lambda (var result seen)