1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
4 ;;; This file is part of GNU Guix.
6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
7 ;;; under the terms of the GNU General Public License as published by
8 ;;; the Free Software Foundation; either version 3 of the License, or (at
9 ;;; your option) any later version.
11 ;;; GNU Guix is distributed in the hope that it will be useful, but
12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;;; GNU General Public License for more details.
16 ;;; You should have received a copy of the GNU General Public License
17 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
19 (define-module (guix discovery)
20 #:use-module (guix i18n)
21 #:use-module (guix modules)
22 #:use-module (guix combinators)
23 #:use-module (guix build syscalls)
24 #:use-module (srfi srfi-1)
25 #:use-module (ice-9 match)
26 #:use-module (ice-9 vlist)
27 #:use-module (ice-9 ftw)
28 #:export (scheme-files
32 fold-module-public-variables))
36 ;;; This module provides tools to discover Guile modules and the variables
41 (define* (scheme-files directory)
42 "Return the list of Scheme files found under DIRECTORY, recursively. The
43 returned list is sorted in alphabetical order. Return the empty list if
44 DIRECTORY is not accessible."
45 (define (entry-type name properties)
46 (match (assoc-ref properties 'type)
48 (stat:type (lstat name)))
52 ;; Use 'scandir*' so we can avoid an extra 'lstat' for each entry, as
53 ;; opposed to Guile's 'scandir' or 'file-system-fold'.
54 (fold-right (lambda (entry result)
61 (let ((absolute (string-append directory "/" name)))
62 (case (entry-type absolute properties)
64 (append (scheme-files absolute) result))
66 (if (string-suffix? ".scm" name)
67 (cons absolute result)
70 (cond ((string-suffix? ".scm" name)
71 (cons absolute result))
76 ((= stat:type 'directory)
77 (append (scheme-files absolute)
87 (let ((errno (system-error-errno args)))
88 (unless (= errno ENOENT)
89 (format (current-error-port) ;XXX
90 (G_ "cannot access `~a': ~a~%")
91 directory (strerror errno)))
94 (define* (scheme-modules directory #:optional sub-directory
95 #:key (warn (const #f)))
96 "Return the list of Scheme modules available under DIRECTORY.
97 Optionally, narrow the search to SUB-DIRECTORY.
99 WARN is called when a module could not be loaded. It is passed the module
100 name and the exception key and arguments."
102 (string-length directory))
104 (filter-map (lambda (file)
105 (let* ((file (substring file prefix-len))
106 (module (file-name->module-name file)))
109 (resolve-interface module))
111 ;; Report the error, but keep going.
114 (scheme-files (if sub-directory
115 (string-append directory "/" sub-directory)
118 (define* (fold-modules proc init path #:key (warn (const #f)))
119 "Fold over all the Scheme modules present in PATH, a list of directories.
120 Call (PROC MODULE RESULT) for each module that is found."
121 (fold (lambda (spec result)
123 ((? string? directory)
124 (fold proc result (scheme-modules directory #:warn warn)))
125 ((directory . sub-directory)
127 (scheme-modules directory sub-directory
132 (define* (all-modules path #:key (warn (const #f)))
133 "Return the list of package modules found in PATH, a list of directories to
134 search. Entries in PATH can be directory names (strings) or (DIRECTORY
135 . SUB-DIRECTORY) pairs, in which case modules are searched for beneath
137 (fold-modules cons '() path #:warn warn))
139 (define (fold-module-public-variables proc init modules)
140 "Call (PROC OBJECT RESULT) for each variable exported by one of MODULES,
141 using INIT as the initial value of RESULT. It is guaranteed to never traverse
142 the same object twice."
143 (identity ; discard second return value
144 (fold2 (lambda (module result seen)
145 (fold2 (lambda (var result seen)
146 (if (not (vhash-assq var seen))
147 (values (proc var result)
148 (vhash-consq var #t seen))
149 (values result seen)))
152 (module-map (lambda (sym var)
153 (false-if-exception (variable-ref var)))
159 ;;; discovery.scm ends here