Add (guix discovery).

* guix/discovery.scm, tests/discovery.scm: New files.
* gnu/packages.scm (scheme-files, file-name->module-name)
(scheme-modules, all-package-modules): Remove.
(fold-packages): Rewrite in terms of 'fold-module-public-variables'.
* gnu/tests.scm: Use (guix discovery).
* Makefile.am (MODULES): Add guix/discovery.scm.
(SCM_TESTS): Add tests/discovery.scm.

5 files changed, 194 insertions, 86 deletions

diff --git a/Makefile.am b/Makefile.am
index 426f8327d9c..c6d8de68bc0 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -50,6 +50,7 @@ MODULES =					\
   guix/sets.scm                                 \
   guix/modules.scm                              \
   guix/download.scm                             \
+  guix/discovery.scm                            \
   guix/git-download.scm                         \
   guix/hg-download.scm                          \
   guix/monads.scm                               \
@@ -279,6 +280,7 @@ SCM_TESTS =					\
   tests/records.scm                             \
   tests/upstream.scm                            \
   tests/combinators.scm                         \
+  tests/discovery.scm                           \
   tests/utils.scm                               \
   tests/build-utils.scm                         \
   tests/packages.scm                            \
diff --git a/gnu/packages.scm b/gnu/packages.scm
index 08f1340612d..57907155fb4 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -24,12 +24,11 @@
   #:use-module (guix packages)
   #:use-module (guix ui)
   #:use-module (guix utils)
+  #:use-module (guix discovery)
   #:use-module (guix memoization)
-  #:use-module (guix combinators)
   #:use-module ((guix build utils)
                 #:select ((package-name->name+version
                            . hyphen-separated-name->name+version)))
-  #:use-module (ice-9 ftw)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
@@ -48,7 +47,6 @@
             %package-module-path
 
             fold-packages
-            scheme-modules                    ;XXX: for lack of a better place
 
             find-packages-by-name
             find-best-packages-by-name
@@ -140,92 +138,17 @@ for system '~a'")
               directory))
         %load-path)))
 
-(define* (scheme-files directory)
-  "Return the list of Scheme files found under DIRECTORY, recursively.  The
-returned list is sorted in alphabetical order."
-
-  ;; Sort entries so that 'fold-packages' works in a deterministic fashion
-  ;; regardless of details of the underlying file system.
-  (sort (file-system-fold (const #t)                   ; enter?
-                          (lambda (path stat result)   ; leaf
-                            (if (string-suffix? ".scm" path)
-                                (cons path result)
-                                result))
-                          (lambda (path stat result)   ; down
-                            result)
-                          (lambda (path stat result)   ; up
-                            result)
-                          (const #f)                   ; skip
-                          (lambda (path stat errno result)
-                            (warning (G_ "cannot access `~a': ~a~%")
-                                     path (strerror errno))
-                            result)
-                          '()
-                          directory
-                          stat)
-        string<?))
-
-(define file-name->module-name
-  (let ((not-slash (char-set-complement (char-set #\/))))
-    (lambda (file)
-      "Return the module name (a list of symbols) corresponding to FILE."
-      (map string->symbol
-           (string-tokenize (string-drop-right file 4) not-slash)))))
-
-(define* (scheme-modules directory #:optional sub-directory)
-  "Return the list of Scheme modules available under DIRECTORY.
-Optionally, narrow the search to SUB-DIRECTORY."
-  (define prefix-len
-    (string-length directory))
-
-  (filter-map (lambda (file)
-                (let* ((file   (substring file prefix-len))
-                       (module (file-name->module-name file)))
-                  (catch #t
-                    (lambda ()
-                      (resolve-interface module))
-                    (lambda args
-                      ;; Report the error, but keep going.
-                      (warn-about-load-error module args)
-                      #f))))
-              (scheme-files (if sub-directory
-                                (string-append directory "/" sub-directory)
-                                directory))))
-
-(define* (all-package-modules #:optional (path (%package-module-path)))
-  "Return the list of package modules found in PATH, a list of directories to
-search."
-  (fold-right (lambda (spec result)
-                (match spec
-                  ((? string? directory)
-                   (append (scheme-modules directory) result))
-                  ((directory . sub-directory)
-                   (append (scheme-modules directory sub-directory)
-                           result))))
-              '()
-              path))
-
 (define (fold-packages proc init)
   "Call (PROC PACKAGE RESULT) for each available package, using INIT as
 the initial value of RESULT.  It is guaranteed to never traverse the
 same package twice."
-  (identity   ; discard second return value
-   (fold2 (lambda (module result seen)
-            (fold2 (lambda (var result seen)
-                     (if (and (package? var)
-                              (not (vhash-assq var seen))
-                              (not (hidden-package? var)))
-                         (values (proc var result)
-                                 (vhash-consq var #t seen))
-                         (values result seen)))
-                   result
-                   seen
-                   (module-map (lambda (sym var)
-                                 (false-if-exception (variable-ref var)))
-                               module)))
-          init
-          vlist-null
-          (all-package-modules))))
+  (fold-module-public-variables (lambda (object result)
+                                  (if (and (package? object)
+                                           (not (hidden-package? object)))
+                                      (proc object result)
+                                      result))
+                                init
+                                (all-modules (%package-module-path))))
 
 (define find-packages-by-name
   (let ((packages (delay
diff --git a/gnu/tests.scm b/gnu/tests.scm
index e84d1ebb209..0df6e5a2ef7 100644
--- a/gnu/tests.scm
+++ b/gnu/tests.scm
@@ -27,7 +27,7 @@
   #:use-module (gnu services)
   #:use-module (gnu services base)
   #:use-module (gnu services shepherd)
-  #:use-module ((gnu packages) #:select (scheme-modules))
+  #:use-module ((guix discovery) #:select (scheme-modules))
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9 gnu)
   #:use-module (ice-9 match)
diff --git a/guix/discovery.scm b/guix/discovery.scm
new file mode 100644
index 00000000000..319ba7c872c
--- /dev/null
+++ b/guix/discovery.scm
@@ -0,0 +1,131 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix discovery)
+  #:use-module (guix ui)
+  #:use-module (guix combinators)
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 vlist)
+  #:use-module (ice-9 ftw)
+  #:export (scheme-modules
+            fold-modules
+            all-modules
+            fold-module-public-variables))
+
+;;; Commentary:
+;;;
+;;; This module provides tools to discover Guile modules and the variables
+;;; they export.
+;;;
+;;; Code:
+
+(define* (scheme-files directory)
+  "Return the list of Scheme files found under DIRECTORY, recursively.  The
+returned list is sorted in alphabetical order."
+
+  ;; Sort entries so that 'fold-packages' works in a deterministic fashion
+  ;; regardless of details of the underlying file system.
+  (sort (file-system-fold (const #t)                 ;enter?
+                          (lambda (path stat result) ;leaf
+                            (if (string-suffix? ".scm" path)
+                                (cons path result)
+                                result))
+                          (lambda (path stat result) ;down
+                            result)
+                          (lambda (path stat result) ;up
+                            result)
+                          (const #f)                 ;skip
+                          (lambda (path stat errno result)
+                            (unless (= ENOENT errno)
+                              (warning (G_ "cannot access `~a': ~a~%")
+                                       path (strerror errno)))
+                            result)
+                          '()
+                          directory
+                          stat)
+        string<?))
+
+(define file-name->module-name
+  (let ((not-slash (char-set-complement (char-set #\/))))
+    (lambda (file)
+      "Return the module name (a list of symbols) corresponding to FILE."
+      (map string->symbol
+           (string-tokenize (string-drop-right file 4) not-slash)))))
+
+(define* (scheme-modules directory #:optional sub-directory)
+  "Return the list of Scheme modules available under DIRECTORY.
+Optionally, narrow the search to SUB-DIRECTORY."
+  (define prefix-len
+    (string-length directory))
+
+  (filter-map (lambda (file)
+                (let* ((file   (substring file prefix-len))
+                       (module (file-name->module-name file)))
+                  (catch #t
+                    (lambda ()
+                      (resolve-interface module))
+                    (lambda args
+                      ;; Report the error, but keep going.
+                      (warn-about-load-error module args)
+                      #f))))
+              (scheme-files (if sub-directory
+                                (string-append directory "/" sub-directory)
+                                directory))))
+
+(define (fold-modules proc init path)
+  "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)))
+            ((directory . sub-directory)
+             (fold proc result
+                   (scheme-modules directory sub-directory)))))
+        '()
+        path))
+
+(define (all-modules path)
+  "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))
+
+(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."
+  (identity   ; discard second return value
+   (fold2 (lambda (module result seen)
+            (fold2 (lambda (var result seen)
+                     (if (not (vhash-assq var seen))
+                         (values (proc var result)
+                                 (vhash-consq var #t seen))
+                         (values result seen)))
+                   result
+                   seen
+                   (module-map (lambda (sym var)
+                                 (false-if-exception (variable-ref var)))
+                               module)))
+          init
+          vlist-null
+          modules)))
+
+;;; discovery.scm ends here
diff --git a/tests/discovery.scm b/tests/discovery.scm
new file mode 100644
index 00000000000..b838731e16f
--- /dev/null
+++ b/tests/discovery.scm
@@ -0,0 +1,52 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (test-discovery)
+  #:use-module (guix discovery)
+  #:use-module (guix build-system)
+  #:use-module (srfi srfi-64)
+  #:use-module (ice-9 match))
+
+(define %top-srcdir
+  (dirname (search-path %load-path "guix.scm")))
+
+(test-begin "discovery")
+
+(test-assert "scheme-modules"
+  (match (map module-name (scheme-modules %top-srcdir "guix/import"))
+    ((('guix 'import _ ...) ..1)
+     #t)))
+
+(test-assert "all-modules"
+  (match (map module-name
+              (all-modules `((,%top-srcdir . "guix/build-system"))))
+    ((('guix 'build-system names) ..1)
+     names)))
+
+(test-assert "fold-module-public-variables"
+  (let ((modules (all-modules `((,%top-srcdir . "guix/build-system")))))
+    (match (fold-module-public-variables (lambda (obj result)
+                                           (if (build-system? obj)
+                                               (cons obj result)
+                                               result))
+                                         '()
+                                         modules)
+      (((? build-system? bs) ..1)
+       bs))))
+
+(test-end "discovery")