Commit | Line | Data |
---|---|---|
cd903ef7 | 1 | ;;; GNU Guix --- Functional package management for GNU |
1d90e9d7 | 2 | ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> |
cd903ef7 LC |
3 | ;;; |
4 | ;;; This file is part of GNU Guix. | |
5 | ;;; | |
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. | |
10 | ;;; | |
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. | |
15 | ;;; | |
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/>. | |
18 | ||
19 | (define-module (guix discovery) | |
3c0128b0 | 20 | #:use-module (guix i18n) |
7a51c78c | 21 | #:use-module (guix modules) |
cd903ef7 | 22 | #:use-module (guix combinators) |
d27cc3bf | 23 | #:use-module (guix build syscalls) |
cd903ef7 LC |
24 | #:use-module (srfi srfi-1) |
25 | #:use-module (ice-9 match) | |
26 | #:use-module (ice-9 vlist) | |
27 | #:use-module (ice-9 ftw) | |
eaae07ec LC |
28 | #:export (scheme-files |
29 | scheme-modules | |
02fa1d25 | 30 | scheme-modules* |
cd903ef7 LC |
31 | fold-modules |
32 | all-modules | |
1d90e9d7 LC |
33 | fold-module-public-variables |
34 | fold-module-public-variables*)) | |
cd903ef7 LC |
35 | |
36 | ;;; Commentary: | |
37 | ;;; | |
38 | ;;; This module provides tools to discover Guile modules and the variables | |
39 | ;;; they export. | |
40 | ;;; | |
41 | ;;; Code: | |
42 | ||
43 | (define* (scheme-files directory) | |
44 | "Return the list of Scheme files found under DIRECTORY, recursively. The | |
d46c4423 LC |
45 | returned list is sorted in alphabetical order. Return the empty list if |
46 | DIRECTORY is not accessible." | |
d27cc3bf LC |
47 | (define (entry-type name properties) |
48 | (match (assoc-ref properties 'type) | |
49 | ('unknown | |
50 | (stat:type (lstat name))) | |
51 | ((? symbol? type) | |
52 | type))) | |
cd903ef7 | 53 | |
548e0af4 LC |
54 | (define (dot-prefixed? file) |
55 | (string-prefix? "." file)) | |
56 | ||
d27cc3bf LC |
57 | ;; Use 'scandir*' so we can avoid an extra 'lstat' for each entry, as |
58 | ;; opposed to Guile's 'scandir' or 'file-system-fold'. | |
59 | (fold-right (lambda (entry result) | |
60 | (match entry | |
548e0af4 LC |
61 | (((? dot-prefixed?) . _) |
62 | ;; Exclude ".", "..", and hidden files such as backups. | |
d27cc3bf LC |
63 | result) |
64 | ((name . properties) | |
65 | (let ((absolute (string-append directory "/" name))) | |
66 | (case (entry-type absolute properties) | |
67 | ((directory) | |
68 | (append (scheme-files absolute) result)) | |
960c6ce9 | 69 | ((regular) |
d27cc3bf LC |
70 | (if (string-suffix? ".scm" name) |
71 | (cons absolute result) | |
72 | result)) | |
960c6ce9 LC |
73 | ((symlink) |
74 | (cond ((string-suffix? ".scm" name) | |
75 | (cons absolute result)) | |
76 | ((stat absolute #f) | |
77 | => | |
78 | (match-lambda | |
79 | (#f result) | |
80 | ((= stat:type 'directory) | |
81 | (append (scheme-files absolute) | |
82 | result)) | |
1d0bde2e CB |
83 | (_ result))) |
84 | (else | |
85 | result))) | |
d27cc3bf LC |
86 | (else |
87 | result)))))) | |
88 | '() | |
d46c4423 LC |
89 | (catch 'system-error |
90 | (lambda () | |
91 | (scandir* directory)) | |
92 | (lambda args | |
93 | (let ((errno (system-error-errno args))) | |
94 | (unless (= errno ENOENT) | |
3c0128b0 LC |
95 | (format (current-error-port) ;XXX |
96 | (G_ "cannot access `~a': ~a~%") | |
97 | directory (strerror errno))) | |
d46c4423 | 98 | '()))))) |
cd903ef7 | 99 | |
3c0128b0 LC |
100 | (define* (scheme-modules directory #:optional sub-directory |
101 | #:key (warn (const #f))) | |
cd903ef7 | 102 | "Return the list of Scheme modules available under DIRECTORY. |
3c0128b0 LC |
103 | Optionally, narrow the search to SUB-DIRECTORY. |
104 | ||
105 | WARN is called when a module could not be loaded. It is passed the module | |
106 | name and the exception key and arguments." | |
cd903ef7 LC |
107 | (define prefix-len |
108 | (string-length directory)) | |
109 | ||
110 | (filter-map (lambda (file) | |
a2a94b6e LC |
111 | (let* ((relative (string-drop file prefix-len)) |
112 | (module (file-name->module-name relative))) | |
cd903ef7 LC |
113 | (catch #t |
114 | (lambda () | |
115 | (resolve-interface module)) | |
116 | (lambda args | |
117 | ;; Report the error, but keep going. | |
a2a94b6e | 118 | (warn file module args) |
cd903ef7 LC |
119 | #f)))) |
120 | (scheme-files (if sub-directory | |
121 | (string-append directory "/" sub-directory) | |
122 | directory)))) | |
123 | ||
02fa1d25 LC |
124 | (define* (scheme-modules* directory #:optional sub-directory) |
125 | "Return the list of module names found under SUB-DIRECTORY in DIRECTORY. | |
126 | This is a source-only variant that does not try to load files." | |
127 | (let ((prefix (string-length directory))) | |
128 | (map (lambda (file) | |
129 | (file-name->module-name (string-drop file prefix))) | |
130 | (scheme-files (if sub-directory | |
131 | (string-append directory "/" sub-directory) | |
132 | directory))))) | |
133 | ||
3c0128b0 | 134 | (define* (fold-modules proc init path #:key (warn (const #f))) |
cd903ef7 LC |
135 | "Fold over all the Scheme modules present in PATH, a list of directories. |
136 | Call (PROC MODULE RESULT) for each module that is found." | |
137 | (fold (lambda (spec result) | |
138 | (match spec | |
139 | ((? string? directory) | |
3c0128b0 | 140 | (fold proc result (scheme-modules directory #:warn warn))) |
cd903ef7 LC |
141 | ((directory . sub-directory) |
142 | (fold proc result | |
3c0128b0 LC |
143 | (scheme-modules directory sub-directory |
144 | #:warn warn))))) | |
cd903ef7 LC |
145 | '() |
146 | path)) | |
147 | ||
3c0128b0 | 148 | (define* (all-modules path #:key (warn (const #f))) |
cd903ef7 LC |
149 | "Return the list of package modules found in PATH, a list of directories to |
150 | search. Entries in PATH can be directory names (strings) or (DIRECTORY | |
151 | . SUB-DIRECTORY) pairs, in which case modules are searched for beneath | |
002d17dc RV |
152 | SUB-DIRECTORY. Modules are listed in the order they appear on the path." |
153 | (reverse (fold-modules cons '() path #:warn warn))) | |
cd903ef7 | 154 | |
1d90e9d7 LC |
155 | (define (fold-module-public-variables* proc init modules) |
156 | "Call (PROC MODULE SYMBOL VARIABLE) for each variable exported by one of MODULES, | |
157 | using INIT as the initial value of RESULT. It is guaranteed to never traverse | |
158 | the same object twice." | |
159 | ;; Here SEEN is populated by variables; if two different variables refer to | |
160 | ;; the same object, we still let them through. | |
161 | (identity ;discard second return value | |
162 | (fold2 (lambda (module result seen) | |
163 | (fold2 (lambda (sym+var result seen) | |
164 | (match sym+var | |
165 | ((sym . var) | |
166 | (if (not (vhash-assq var seen)) | |
167 | (values (proc module sym var result) | |
168 | (vhash-consq var #t seen)) | |
169 | (values result seen))))) | |
170 | result | |
171 | seen | |
172 | (module-map cons module))) | |
173 | init | |
174 | vlist-null | |
175 | modules))) | |
176 | ||
cd903ef7 LC |
177 | (define (fold-module-public-variables proc init modules) |
178 | "Call (PROC OBJECT RESULT) for each variable exported by one of MODULES, | |
179 | using INIT as the initial value of RESULT. It is guaranteed to never traverse | |
180 | the same object twice." | |
1d90e9d7 | 181 | ;; Note: here SEEN is populated by objects, not by variables. |
cd903ef7 LC |
182 | (identity ; discard second return value |
183 | (fold2 (lambda (module result seen) | |
184 | (fold2 (lambda (var result seen) | |
185 | (if (not (vhash-assq var seen)) | |
186 | (values (proc var result) | |
187 | (vhash-consq var #t seen)) | |
188 | (values result seen))) | |
189 | result | |
190 | seen | |
191 | (module-map (lambda (sym var) | |
192 | (false-if-exception (variable-ref var))) | |
193 | module))) | |
194 | init | |
195 | vlist-null | |
196 | modules))) | |
197 | ||
198 | ;;; discovery.scm ends here |