Commit | Line | Data |
---|---|---|
457f60fa | 1 | ;;; GNU Guix --- Functional package management for GNU |
2df17bd0 | 2 | ;;; Copyright © 2014, 2015, 2016 Alex Kost <alezost@gmail.com> |
457f60fa AK |
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 | ;;; Commentary: | |
20 | ||
21 | ;; Information about packages and generations is passed to the elisp | |
22 | ;; side in the form of alists of parameters (such as ‘name’ or | |
81b339fe | 23 | ;; ‘version’) and their values. |
457f60fa | 24 | |
81b339fe | 25 | ;; ‘entries’ procedure is the “entry point” for the elisp side to get |
457f60fa AK |
26 | ;; information about packages and generations. |
27 | ||
28 | ;; Since name/version pair is not necessarily unique, we use | |
29 | ;; `object-address' to identify a package (for ‘id’ parameter), if | |
30 | ;; possible. However for the obsolete packages (that can be found in | |
31 | ;; installed manifest but not in a package directory), ‘id’ parameter is | |
32 | ;; still "name-version" string. So ‘id’ package parameter in the code | |
33 | ;; below is either an object-address number or a full-name string. | |
457f60fa AK |
34 | |
35 | ;; To speed-up the process of getting information, the following | |
36 | ;; auxiliary variables are used: | |
37 | ;; | |
38 | ;; - `%packages' - VHash of "package address"/"package" pairs. | |
39 | ;; | |
40 | ;; - `%package-table' - Hash table of | |
41 | ;; "name+version key"/"list of packages" pairs. | |
457f60fa AK |
42 | |
43 | ;;; Code: | |
44 | ||
45 | (use-modules | |
46 | (ice-9 vlist) | |
47 | (ice-9 match) | |
8b9ceb8d | 48 | (ice-9 popen) |
457f60fa | 49 | (srfi srfi-1) |
0b0fbf0c | 50 | (srfi srfi-2) |
457f60fa AK |
51 | (srfi srfi-11) |
52 | (srfi srfi-19) | |
53 | (srfi srfi-26) | |
54 | (guix) | |
0b0fbf0c | 55 | (guix git-download) |
457f60fa AK |
56 | (guix packages) |
57 | (guix profiles) | |
58 | (guix licenses) | |
59 | (guix utils) | |
60 | (guix ui) | |
61 | (guix scripts package) | |
67cedc4b AK |
62 | (gnu packages) |
63 | (gnu system)) | |
457f60fa AK |
64 | |
65 | (define-syntax-rule (first-or-false lst) | |
66 | (and (not (null? lst)) | |
67 | (first lst))) | |
68 | ||
81b339fe AK |
69 | (define (list-maybe obj) |
70 | (if (list? obj) obj (list obj))) | |
71 | ||
ea369ee1 AK |
72 | (define (output+error thunk) |
73 | "Call THUNK and return 2 values: output and error output as strings." | |
74 | (let ((output-port (open-output-string)) | |
75 | (error-port (open-output-string))) | |
76 | (with-output-to-port output-port | |
77 | (lambda () (with-error-to-port error-port thunk))) | |
78 | (let ((strings (list (get-output-string output-port) | |
79 | (get-output-string error-port)))) | |
80 | (close-output-port output-port) | |
81 | (close-output-port error-port) | |
82 | (apply values strings)))) | |
83 | ||
00f34aaa AK |
84 | (define (full-name->name+version spec) |
85 | "Given package specification SPEC with or without output, | |
86 | return two values: name and version. For example, for SPEC | |
db0c709b | 87 | \"foo@0.9.1b:lib\", return \"foo\" and \"0.9.1b\"." |
00f34aaa AK |
88 | (let-values (((name version output) |
89 | (package-specification->name+version+output spec))) | |
90 | (values name version))) | |
91 | ||
457f60fa | 92 | (define (name+version->full-name name version) |
db0c709b | 93 | (string-append name "@" version)) |
457f60fa AK |
94 | |
95 | (define* (make-package-specification name #:optional version output) | |
96 | (let ((full-name (if version | |
97 | (name+version->full-name name version) | |
98 | name))) | |
99 | (if output | |
100 | (string-append full-name ":" output) | |
101 | full-name))) | |
102 | ||
103 | (define name+version->key cons) | |
104 | (define key->name+version car+cdr) | |
105 | ||
183f42f9 AK |
106 | (define %package-vhash |
107 | (delay | |
108 | (fold-packages (lambda (pkg res) | |
109 | (vhash-consq (object-address pkg) pkg res)) | |
110 | vlist-null))) | |
111 | ||
112 | (define (package-vhash) | |
113 | "Return vhash of 'package ID (address)'/'package' pairs." | |
114 | (force %package-vhash)) | |
457f60fa AK |
115 | |
116 | (define %package-table | |
183f42f9 AK |
117 | (delay |
118 | (let ((table (make-hash-table (vlist-length (package-vhash))))) | |
119 | (vlist-for-each | |
120 | (lambda (elem) | |
121 | (match elem | |
122 | ((address . pkg) | |
123 | (let* ((key (name+version->key (package-name pkg) | |
124 | (package-version pkg))) | |
125 | (ref (hash-ref table key))) | |
126 | (hash-set! table key | |
127 | (if ref (cons pkg ref) (list pkg))))))) | |
128 | (package-vhash)) | |
129 | table))) | |
130 | ||
131 | (define (package-table) | |
132 | "Return hash table of 'name+version key'/'list of packages' pairs." | |
133 | (force %package-table)) | |
457f60fa | 134 | |
81b339fe AK |
135 | (define (manifest-entry->name+version+output entry) |
136 | (values | |
137 | (manifest-entry-name entry) | |
138 | (manifest-entry-version entry) | |
139 | (manifest-entry-output entry))) | |
140 | ||
d38bd08c AK |
141 | (define (manifest-entry->package-specification entry) |
142 | (call-with-values | |
143 | (lambda () (manifest-entry->name+version+output entry)) | |
144 | make-package-specification)) | |
145 | ||
146 | (define (manifest-entries->package-specifications entries) | |
147 | (map manifest-entry->package-specification entries)) | |
148 | ||
54c3c284 AK |
149 | (define (profile-package-specifications profile) |
150 | "Return a list of package specifications for PROFILE." | |
151 | (let ((manifest (profile-manifest profile))) | |
d38bd08c AK |
152 | (manifest-entries->package-specifications |
153 | (manifest-entries manifest)))) | |
154 | ||
2df17bd0 AK |
155 | (define (profile->specifications+paths profile) |
156 | "Return a list of package specifications and paths for PROFILE. | |
d38bd08c | 157 | Each element of the list is a list of the package specification and its path." |
2df17bd0 | 158 | (let ((manifest (profile-manifest profile))) |
d38bd08c AK |
159 | (map (lambda (entry) |
160 | (list (manifest-entry->package-specification entry) | |
161 | (manifest-entry-item entry))) | |
162 | (manifest-entries manifest)))) | |
163 | ||
54c3c284 AK |
164 | (define (profile-difference profile1 profile2) |
165 | "Return a list of package specifications for outputs installed in PROFILE1 | |
166 | and not installed in PROFILE2." | |
167 | (let ((specs1 (profile-package-specifications profile1)) | |
168 | (specs2 (profile-package-specifications profile2))) | |
d38bd08c AK |
169 | (lset-difference string=? specs1 specs2))) |
170 | ||
81b339fe AK |
171 | (define (manifest-entries->hash-table entries) |
172 | "Return a hash table of name keys and lists of matching manifest ENTRIES." | |
173 | (let ((table (make-hash-table (length entries)))) | |
174 | (for-each (lambda (entry) | |
175 | (let* ((key (manifest-entry-name entry)) | |
176 | (ref (hash-ref table key))) | |
177 | (hash-set! table key | |
178 | (if ref (cons entry ref) (list entry))))) | |
179 | entries) | |
180 | table)) | |
457f60fa | 181 | |
81b339fe AK |
182 | (define (manifest=? m1 m2) |
183 | (or (eq? m1 m2) | |
184 | (equal? m1 m2))) | |
185 | ||
186 | (define manifest->hash-table | |
187 | (let ((current-manifest #f) | |
188 | (current-table #f)) | |
189 | (lambda (manifest) | |
190 | "Return a hash table of name keys and matching MANIFEST entries." | |
191 | (unless (manifest=? manifest current-manifest) | |
192 | (set! current-manifest manifest) | |
193 | (set! current-table (manifest-entries->hash-table | |
194 | (manifest-entries manifest)))) | |
195 | current-table))) | |
196 | ||
197 | (define* (manifest-entries-by-name manifest name #:optional version output) | |
198 | "Return a list of MANIFEST entries matching NAME, VERSION and OUTPUT." | |
199 | (let ((entries (or (hash-ref (manifest->hash-table manifest) name) | |
200 | '()))) | |
201 | (if (or version output) | |
202 | (filter (lambda (entry) | |
203 | (and (or (not version) | |
204 | (equal? version (manifest-entry-version entry))) | |
205 | (or (not output) | |
206 | (equal? output (manifest-entry-output entry))))) | |
207 | entries) | |
208 | entries))) | |
209 | ||
210 | (define (manifest-entry-by-output entries output) | |
211 | "Return a manifest entry from ENTRIES matching OUTPUT." | |
212 | (find (lambda (entry) | |
213 | (string= output (manifest-entry-output entry))) | |
214 | entries)) | |
215 | ||
216 | (define (fold-manifest-by-name manifest proc init) | |
217 | "Fold over MANIFEST entries. | |
218 | Call (PROC NAME VERSION ENTRIES RESULT), using INIT as the initial value | |
219 | of RESULT. ENTRIES is a list of manifest entries with NAME/VERSION." | |
220 | (hash-fold (lambda (name entries res) | |
221 | (proc name (manifest-entry-version (car entries)) | |
222 | entries res)) | |
457f60fa | 223 | init |
81b339fe | 224 | (manifest->hash-table manifest))) |
457f60fa AK |
225 | |
226 | (define* (object-transformer param-alist #:optional (params '())) | |
81b339fe | 227 | "Return procedure transforming objects into alist of parameter/value pairs. |
457f60fa | 228 | |
81b339fe AK |
229 | PARAM-ALIST is alist of available parameters (symbols) and procedures |
230 | returning values of these parameters. Each procedure is applied to | |
231 | objects. | |
457f60fa | 232 | |
81b339fe AK |
233 | PARAMS is list of parameters from PARAM-ALIST that should be returned by |
234 | a resulting procedure. If PARAMS is not specified or is an empty list, | |
235 | use all available parameters. | |
457f60fa AK |
236 | |
237 | Example: | |
238 | ||
81b339fe AK |
239 | (let* ((alist `((plus1 . ,1+) (minus1 . ,1-) (mul2 . ,(cut * 2 <>)))) |
240 | (number->alist (object-transformer alist '(plus1 mul2)))) | |
457f60fa AK |
241 | (number->alist 8)) |
242 | => | |
243 | ((plus1 . 9) (mul2 . 16)) | |
244 | " | |
81b339fe AK |
245 | (let* ((use-all-params (null? params)) |
246 | (alist (filter-map (match-lambda | |
247 | ((param . proc) | |
248 | (and (or use-all-params | |
249 | (memq param params)) | |
250 | (cons param proc))) | |
251 | (_ #f)) | |
252 | param-alist))) | |
253 | (lambda objects | |
457f60fa | 254 | (map (match-lambda |
81b339fe AK |
255 | ((param . proc) |
256 | (cons param (apply proc objects)))) | |
457f60fa AK |
257 | alist)))) |
258 | ||
81b339fe AK |
259 | (define %manifest-entry-param-alist |
260 | `((output . ,manifest-entry-output) | |
261 | (path . ,manifest-entry-item) | |
262 | (dependencies . ,manifest-entry-dependencies))) | |
457f60fa | 263 | |
81b339fe AK |
264 | (define manifest-entry->sexp |
265 | (object-transformer %manifest-entry-param-alist)) | |
457f60fa | 266 | |
81b339fe AK |
267 | (define (manifest-entries->sexps entries) |
268 | (map manifest-entry->sexp entries)) | |
457f60fa AK |
269 | |
270 | (define (package-inputs-names inputs) | |
81b339fe | 271 | "Return a list of full names of the packages from package INPUTS." |
457f60fa AK |
272 | (filter-map (match-lambda |
273 | ((_ (? package? package)) | |
db0c709b AK |
274 | (make-package-specification (package-name package) |
275 | (package-version package))) | |
00f34aaa AK |
276 | ((_ (? package? package) output) |
277 | (make-package-specification (package-name package) | |
278 | (package-version package) | |
279 | output)) | |
457f60fa AK |
280 | (_ #f)) |
281 | inputs)) | |
282 | ||
283 | (define (package-license-names package) | |
81b339fe AK |
284 | "Return a list of license names of the PACKAGE." |
285 | (filter-map (lambda (license) | |
286 | (and (license? license) | |
287 | (license-name license))) | |
288 | (list-maybe (package-license package)))) | |
457f60fa | 289 | |
0b0fbf0c AK |
290 | (define (package-source-names package) |
291 | "Return a list of source names (URLs) of the PACKAGE." | |
292 | (let ((source (package-source package))) | |
293 | (and (origin? source) | |
294 | (filter-map (lambda (uri) | |
295 | (cond ((string? uri) | |
296 | uri) | |
297 | ((git-reference? uri) | |
298 | (git-reference-url uri)) | |
299 | (else "Unknown source type"))) | |
300 | (list-maybe (origin-uri source)))))) | |
301 | ||
457f60fa AK |
302 | (define (package-unique? package) |
303 | "Return #t if PACKAGE is a single package with such name/version." | |
f1f09937 AK |
304 | (match (packages-by-name (package-name package) |
305 | (package-version package)) | |
306 | ((package) #t) | |
307 | (_ #f))) | |
81b339fe AK |
308 | |
309 | (define %package-param-alist | |
310 | `((id . ,object-address) | |
311 | (package-id . ,object-address) | |
312 | (name . ,package-name) | |
313 | (version . ,package-version) | |
314 | (license . ,package-license-names) | |
0b0fbf0c | 315 | (source . ,package-source-names) |
81b339fe | 316 | (synopsis . ,package-synopsis) |
1cd4027c | 317 | (description . ,package-description-string) |
81b339fe AK |
318 | (home-url . ,package-home-page) |
319 | (outputs . ,package-outputs) | |
0a5ec709 | 320 | (systems . ,package-supported-systems) |
81b339fe AK |
321 | (non-unique . ,(negate package-unique?)) |
322 | (inputs . ,(lambda (pkg) | |
323 | (package-inputs-names | |
324 | (package-inputs pkg)))) | |
325 | (native-inputs . ,(lambda (pkg) | |
326 | (package-inputs-names | |
327 | (package-native-inputs pkg)))) | |
328 | (propagated-inputs . ,(lambda (pkg) | |
329 | (package-inputs-names | |
330 | (package-propagated-inputs pkg)))) | |
331 | (location . ,(lambda (pkg) | |
332 | (location->string (package-location pkg)))))) | |
457f60fa AK |
333 | |
334 | (define (package-param package param) | |
81b339fe AK |
335 | "Return a value of a PACKAGE PARAM." |
336 | (and=> (assq-ref %package-param-alist param) | |
457f60fa AK |
337 | (cut <> package))) |
338 | ||
81b339fe AK |
339 | \f |
340 | ;;; Finding packages. | |
341 | ||
342 | (define (package-by-address address) | |
183f42f9 | 343 | (match (vhash-assq address (package-vhash)) |
f1f09937 AK |
344 | ((_ . package) package) |
345 | (_ #f))) | |
81b339fe AK |
346 | |
347 | (define (packages-by-name+version name version) | |
183f42f9 | 348 | (or (hash-ref (package-table) |
81b339fe AK |
349 | (name+version->key name version)) |
350 | '())) | |
351 | ||
352 | (define (packages-by-full-name full-name) | |
353 | (call-with-values | |
354 | (lambda () (full-name->name+version full-name)) | |
355 | packages-by-name+version)) | |
356 | ||
357 | (define (packages-by-id id) | |
358 | (if (integer? id) | |
359 | (let ((pkg (package-by-address id))) | |
360 | (if pkg (list pkg) '())) | |
361 | (packages-by-full-name id))) | |
362 | ||
363 | (define (id->name+version id) | |
364 | (if (integer? id) | |
365 | (and=> (package-by-address id) | |
366 | (lambda (pkg) | |
367 | (values (package-name pkg) | |
368 | (package-version pkg)))) | |
369 | (full-name->name+version id))) | |
370 | ||
371 | (define (package-by-id id) | |
372 | (first-or-false (packages-by-id id))) | |
373 | ||
374 | (define (newest-package-by-id id) | |
375 | (and=> (id->name+version id) | |
376 | (lambda (name) | |
377 | (first-or-false (find-best-packages-by-name name #f))))) | |
378 | ||
379 | (define (matching-packages predicate) | |
457f60fa AK |
380 | (fold-packages (lambda (pkg res) |
381 | (if (predicate pkg) | |
81b339fe | 382 | (cons pkg res) |
457f60fa AK |
383 | res)) |
384 | '())) | |
385 | ||
81b339fe AK |
386 | (define (filter-packages-by-output packages output) |
387 | (filter (lambda (package) | |
388 | (member output (package-outputs package))) | |
389 | packages)) | |
390 | ||
391 | (define* (packages-by-name name #:optional version output) | |
392 | "Return a list of packages matching NAME, VERSION and OUTPUT." | |
393 | (let ((packages (if version | |
394 | (packages-by-name+version name version) | |
395 | (matching-packages | |
396 | (lambda (pkg) (string=? name (package-name pkg))))))) | |
397 | (if output | |
398 | (filter-packages-by-output packages output) | |
399 | packages))) | |
457f60fa | 400 | |
81b339fe AK |
401 | (define (manifest-entry->packages entry) |
402 | (call-with-values | |
403 | (lambda () (manifest-entry->name+version+output entry)) | |
404 | packages-by-name)) | |
457f60fa | 405 | |
81b339fe AK |
406 | (define (packages-by-regexp regexp match-params) |
407 | "Return a list of packages matching REGEXP string. | |
457f60fa AK |
408 | MATCH-PARAMS is a list of parameters that REGEXP can match." |
409 | (define (package-match? package regexp) | |
410 | (any (lambda (param) | |
411 | (let ((val (package-param package param))) | |
412 | (and (string? val) (regexp-exec regexp val)))) | |
413 | match-params)) | |
414 | ||
457f60fa | 415 | (let ((re (make-regexp regexp regexp/icase))) |
81b339fe AK |
416 | (matching-packages (cut package-match? <> re)))) |
417 | ||
83aab70b AK |
418 | (define (packages-by-license license) |
419 | "Return a list of packages with LICENSE." | |
420 | (matching-packages | |
421 | (lambda (package) | |
422 | (memq license (list-maybe (package-license package)))))) | |
423 | ||
81b339fe AK |
424 | (define (all-available-packages) |
425 | "Return a list of all available packages." | |
426 | (matching-packages (const #t))) | |
427 | ||
428 | (define (newest-available-packages) | |
429 | "Return a list of the newest available packages." | |
457f60fa AK |
430 | (vhash-fold (lambda (name elem res) |
431 | (match elem | |
81b339fe AK |
432 | ((_ newest pkgs ...) |
433 | (cons newest res)))) | |
457f60fa AK |
434 | '() |
435 | (find-newest-available-packages))) | |
436 | ||
81b339fe AK |
437 | \f |
438 | ;;; Making package/output patterns. | |
439 | ||
440 | (define (specification->package-pattern specification) | |
441 | (call-with-values | |
442 | (lambda () | |
443 | (full-name->name+version specification)) | |
444 | list)) | |
457f60fa | 445 | |
81b339fe AK |
446 | (define (specification->output-pattern specification) |
447 | (call-with-values | |
448 | (lambda () | |
449 | (package-specification->name+version+output specification #f)) | |
450 | list)) | |
457f60fa | 451 | |
81b339fe AK |
452 | (define (id->package-pattern id) |
453 | (if (integer? id) | |
454 | (package-by-address id) | |
455 | (specification->package-pattern id))) | |
456 | ||
457 | (define (id->output-pattern id) | |
458 | "Return an output pattern by output ID. | |
459 | ID should be '<package-address>:<output>' or '<name>-<version>:<output>'." | |
460 | (let-values (((name version output) | |
461 | (package-specification->name+version+output id))) | |
462 | (if version | |
463 | (list name version output) | |
464 | (list (package-by-address (string->number name)) | |
465 | output)))) | |
466 | ||
467 | (define (specifications->package-patterns . specifications) | |
468 | (map specification->package-pattern specifications)) | |
469 | ||
470 | (define (specifications->output-patterns . specifications) | |
471 | (map specification->output-pattern specifications)) | |
472 | ||
473 | (define (ids->package-patterns . ids) | |
474 | (map id->package-pattern ids)) | |
475 | ||
476 | (define (ids->output-patterns . ids) | |
477 | (map id->output-pattern ids)) | |
478 | ||
479 | (define* (manifest-patterns-result packages res obsolete-pattern | |
480 | #:optional installed-pattern) | |
481 | "Auxiliary procedure for 'manifest-package-patterns' and | |
482 | 'manifest-output-patterns'." | |
483 | (if (null? packages) | |
484 | (cons (obsolete-pattern) res) | |
485 | (if installed-pattern | |
486 | ;; We don't need duplicates for a list of installed packages, | |
487 | ;; so just take any (car) package. | |
488 | (cons (installed-pattern (car packages)) res) | |
489 | res))) | |
490 | ||
491 | (define* (manifest-package-patterns manifest #:optional obsolete-only?) | |
492 | "Return a list of package patterns for MANIFEST entries. | |
493 | If OBSOLETE-ONLY? is #f, use all entries, otherwise make patterns only | |
494 | for obsolete packages." | |
495 | (fold-manifest-by-name | |
496 | manifest | |
457f60fa | 497 | (lambda (name version entries res) |
81b339fe AK |
498 | (manifest-patterns-result (packages-by-name name version) |
499 | res | |
500 | (lambda () (list name version entries)) | |
501 | (and (not obsolete-only?) | |
502 | (cut list <> entries)))) | |
457f60fa AK |
503 | '())) |
504 | ||
81b339fe AK |
505 | (define* (manifest-output-patterns manifest #:optional obsolete-only?) |
506 | "Return a list of output patterns for MANIFEST entries. | |
507 | If OBSOLETE-ONLY? is #f, use all entries, otherwise make patterns only | |
508 | for obsolete packages." | |
509 | (fold (lambda (entry res) | |
510 | (manifest-patterns-result (manifest-entry->packages entry) | |
511 | res | |
512 | (lambda () entry) | |
513 | (and (not obsolete-only?) | |
514 | (cut list <> entry)))) | |
515 | '() | |
516 | (manifest-entries manifest))) | |
517 | ||
518 | (define (obsolete-package-patterns manifest) | |
519 | (manifest-package-patterns manifest #t)) | |
520 | ||
521 | (define (obsolete-output-patterns manifest) | |
522 | (manifest-output-patterns manifest #t)) | |
523 | ||
457f60fa | 524 | \f |
81b339fe | 525 | ;;; Transforming package/output patterns into alists. |
457f60fa | 526 | |
81b339fe AK |
527 | (define (obsolete-package-sexp name version entries) |
528 | "Return an alist with information about obsolete package. | |
529 | ENTRIES is a list of installed manifest entries." | |
530 | `((id . ,(name+version->full-name name version)) | |
531 | (name . ,name) | |
532 | (version . ,version) | |
533 | (outputs . ,(map manifest-entry-output entries)) | |
534 | (obsolete . #t) | |
535 | (installed . ,(manifest-entries->sexps entries)))) | |
536 | ||
537 | (define (package-pattern-transformer manifest params) | |
538 | "Return 'package-pattern->package-sexps' procedure." | |
539 | (define package->sexp | |
540 | (object-transformer %package-param-alist params)) | |
541 | ||
542 | (define* (sexp-by-package package #:optional | |
543 | (entries (manifest-entries-by-name | |
544 | manifest | |
545 | (package-name package) | |
546 | (package-version package)))) | |
547 | (cons (cons 'installed (manifest-entries->sexps entries)) | |
548 | (package->sexp package))) | |
549 | ||
550 | (define (->sexps pattern) | |
551 | (match pattern | |
552 | ((? package? package) | |
553 | (list (sexp-by-package package))) | |
554 | (((? package? package) entries) | |
555 | (list (sexp-by-package package entries))) | |
556 | ((name version entries) | |
557 | (list (obsolete-package-sexp | |
558 | name version entries))) | |
559 | ((name version) | |
560 | (let ((packages (packages-by-name name version))) | |
561 | (if (null? packages) | |
562 | (let ((entries (manifest-entries-by-name | |
563 | manifest name version))) | |
564 | (if (null? entries) | |
565 | '() | |
566 | (list (obsolete-package-sexp | |
567 | name version entries)))) | |
ce8b2953 AK |
568 | (map sexp-by-package packages)))) |
569 | (_ '()))) | |
81b339fe AK |
570 | |
571 | ->sexps) | |
572 | ||
573 | (define (output-pattern-transformer manifest params) | |
574 | "Return 'output-pattern->output-sexps' procedure." | |
575 | (define package->sexp | |
576 | (object-transformer (alist-delete 'id %package-param-alist) | |
577 | params)) | |
578 | ||
579 | (define manifest-entry->sexp | |
580 | (object-transformer (alist-delete 'output %manifest-entry-param-alist) | |
581 | params)) | |
582 | ||
583 | (define* (output-sexp pkg-alist pkg-address output | |
584 | #:optional entry) | |
585 | (let ((entry-alist (if entry | |
586 | (manifest-entry->sexp entry) | |
587 | '())) | |
588 | (base `((id . ,(string-append | |
589 | (number->string pkg-address) | |
590 | ":" output)) | |
591 | (output . ,output) | |
592 | (installed . ,(->bool entry))))) | |
593 | (append entry-alist base pkg-alist))) | |
594 | ||
595 | (define (obsolete-output-sexp entry) | |
596 | (let-values (((name version output) | |
597 | (manifest-entry->name+version+output entry))) | |
598 | (let ((base `((id . ,(make-package-specification | |
599 | name version output)) | |
600 | (package-id . ,(name+version->full-name name version)) | |
601 | (name . ,name) | |
602 | (version . ,version) | |
603 | (output . ,output) | |
604 | (obsolete . #t) | |
605 | (installed . #t)))) | |
606 | (append (manifest-entry->sexp entry) base)))) | |
607 | ||
608 | (define* (sexps-by-package package #:optional output | |
609 | (entries (manifest-entries-by-name | |
610 | manifest | |
611 | (package-name package) | |
612 | (package-version package)))) | |
613 | ;; Assuming that PACKAGE has this OUTPUT. | |
614 | (let ((pkg-alist (package->sexp package)) | |
615 | (address (object-address package)) | |
616 | (outputs (if output | |
617 | (list output) | |
618 | (package-outputs package)))) | |
619 | (map (lambda (output) | |
620 | (output-sexp pkg-alist address output | |
621 | (manifest-entry-by-output entries output))) | |
622 | outputs))) | |
623 | ||
624 | (define* (sexps-by-manifest-entry entry #:optional | |
625 | (packages (manifest-entry->packages | |
626 | entry))) | |
627 | (if (null? packages) | |
628 | (list (obsolete-output-sexp entry)) | |
629 | (map (lambda (package) | |
630 | (output-sexp (package->sexp package) | |
631 | (object-address package) | |
632 | (manifest-entry-output entry) | |
633 | entry)) | |
634 | packages))) | |
635 | ||
636 | (define (->sexps pattern) | |
637 | (match pattern | |
638 | ((? package? package) | |
639 | (sexps-by-package package)) | |
640 | ((package (? string? output)) | |
641 | (sexps-by-package package output)) | |
642 | ((? manifest-entry? entry) | |
643 | (list (obsolete-output-sexp entry))) | |
644 | ((package entry) | |
645 | (sexps-by-manifest-entry entry (list package))) | |
646 | ((name version output) | |
647 | (let ((packages (packages-by-name name version output))) | |
648 | (if (null? packages) | |
649 | (let ((entries (manifest-entries-by-name | |
650 | manifest name version output))) | |
651 | (append-map (cut sexps-by-manifest-entry <>) | |
652 | entries)) | |
653 | (append-map (cut sexps-by-package <> output) | |
ce8b2953 AK |
654 | packages)))) |
655 | (_ '()))) | |
81b339fe AK |
656 | |
657 | ->sexps) | |
658 | ||
659 | (define (entry-type-error entry-type) | |
660 | (error (format #f "Wrong entry-type '~a'" entry-type))) | |
661 | ||
662 | (define (search-type-error entry-type search-type) | |
663 | (error (format #f "Wrong search type '~a' for entry-type '~a'" | |
664 | search-type entry-type))) | |
665 | ||
666 | (define %pattern-transformers | |
667 | `((package . ,package-pattern-transformer) | |
668 | (output . ,output-pattern-transformer))) | |
669 | ||
670 | (define (pattern-transformer entry-type) | |
671 | (assq-ref %pattern-transformers entry-type)) | |
672 | ||
673 | ;; All procedures from inner alists are called with (MANIFEST . SEARCH-VALS) | |
674 | ;; as arguments; see `package/output-sexps'. | |
675 | (define %patterns-makers | |
676 | (let* ((apply-to-rest (lambda (proc) | |
677 | (lambda (_ . rest) (apply proc rest)))) | |
678 | (apply-to-first (lambda (proc) | |
679 | (lambda (first . _) (proc first)))) | |
680 | (manifest-package-proc (apply-to-first manifest-package-patterns)) | |
681 | (manifest-output-proc (apply-to-first manifest-output-patterns)) | |
682 | (regexp-proc (lambda (_ regexp params . __) | |
683 | (packages-by-regexp regexp params))) | |
83aab70b AK |
684 | (license-proc (lambda (_ license-name) |
685 | (packages-by-license | |
686 | (lookup-license license-name)))) | |
81b339fe AK |
687 | (all-proc (lambda _ (all-available-packages))) |
688 | (newest-proc (lambda _ (newest-available-packages)))) | |
689 | `((package | |
690 | (id . ,(apply-to-rest ids->package-patterns)) | |
691 | (name . ,(apply-to-rest specifications->package-patterns)) | |
692 | (installed . ,manifest-package-proc) | |
81b339fe AK |
693 | (obsolete . ,(apply-to-first obsolete-package-patterns)) |
694 | (regexp . ,regexp-proc) | |
83aab70b | 695 | (license . ,license-proc) |
81b339fe AK |
696 | (all-available . ,all-proc) |
697 | (newest-available . ,newest-proc)) | |
698 | (output | |
699 | (id . ,(apply-to-rest ids->output-patterns)) | |
700 | (name . ,(apply-to-rest specifications->output-patterns)) | |
701 | (installed . ,manifest-output-proc) | |
81b339fe AK |
702 | (obsolete . ,(apply-to-first obsolete-output-patterns)) |
703 | (regexp . ,regexp-proc) | |
83aab70b | 704 | (license . ,license-proc) |
81b339fe AK |
705 | (all-available . ,all-proc) |
706 | (newest-available . ,newest-proc))))) | |
707 | ||
708 | (define (patterns-maker entry-type search-type) | |
709 | (or (and=> (assq-ref %patterns-makers entry-type) | |
710 | (cut assq-ref <> search-type)) | |
711 | (search-type-error entry-type search-type))) | |
712 | ||
713 | (define (package/output-sexps profile params entry-type | |
714 | search-type search-vals) | |
715 | "Return information about packages or package outputs. | |
716 | See 'entry-sexps' for details." | |
56728668 | 717 | (let* ((manifest (profile-manifest profile)) |
d38bd08c | 718 | (patterns (if (and (eq? entry-type 'output) |
54c3c284 | 719 | (eq? search-type 'profile-diff)) |
d38bd08c | 720 | (match search-vals |
54c3c284 | 721 | ((p1 p2) |
d38bd08c | 722 | (map specification->output-pattern |
54c3c284 | 723 | (profile-difference p1 p2))) |
d38bd08c AK |
724 | (_ '())) |
725 | (apply (patterns-maker entry-type search-type) | |
726 | manifest search-vals))) | |
81b339fe AK |
727 | (->sexps ((pattern-transformer entry-type) manifest params))) |
728 | (append-map ->sexps patterns))) | |
729 | ||
730 | \f | |
731 | ;;; Getting information about generations. | |
457f60fa AK |
732 | |
733 | (define (generation-param-alist profile) | |
81b339fe | 734 | "Return an alist of generation parameters and procedures for PROFILE." |
c2379b3c AK |
735 | (let ((current (generation-number profile))) |
736 | `((id . ,identity) | |
737 | (number . ,identity) | |
738 | (prev-number . ,(cut previous-generation-number profile <>)) | |
739 | (current . ,(cut = current <>)) | |
740 | (path . ,(cut generation-file-name profile <>)) | |
741 | (time . ,(lambda (gen) | |
742 | (time-second (generation-time profile gen))))))) | |
457f60fa | 743 | |
81b339fe AK |
744 | (define (matching-generations profile predicate) |
745 | "Return a list of PROFILE generations matching PREDICATE." | |
746 | (filter predicate (profile-generations profile))) | |
457f60fa | 747 | |
81b339fe AK |
748 | (define (last-generations profile number) |
749 | "Return a list of last NUMBER generations. | |
750 | If NUMBER is 0 or less, return all generations." | |
457f60fa AK |
751 | (let ((generations (profile-generations profile)) |
752 | (number (if (<= number 0) +inf.0 number))) | |
81b339fe AK |
753 | (if (> (length generations) number) |
754 | (list-head (reverse generations) number) | |
755 | generations))) | |
457f60fa | 756 | |
81b339fe AK |
757 | (define (find-generations profile search-type search-vals) |
758 | "Find PROFILE's generations matching SEARCH-TYPE and SEARCH-VALS." | |
759 | (case search-type | |
760 | ((id) | |
ce8b2953 | 761 | (matching-generations profile (cut memq <> search-vals))) |
81b339fe AK |
762 | ((last) |
763 | (last-generations profile (car search-vals))) | |
764 | ((all) | |
765 | (last-generations profile +inf.0)) | |
189cea27 AK |
766 | ((time) |
767 | (match search-vals | |
768 | ((from to) | |
769 | (matching-generations | |
770 | profile | |
771 | (lambda (gen) | |
772 | (let ((time (time-second (generation-time profile gen)))) | |
773 | (< from time to))))) | |
774 | (_ '()))) | |
81b339fe AK |
775 | (else (search-type-error "generation" search-type)))) |
776 | ||
777 | (define (generation-sexps profile params search-type search-vals) | |
778 | "Return information about generations. | |
779 | See 'entry-sexps' for details." | |
780 | (let ((generations (find-generations profile search-type search-vals)) | |
781 | (->sexp (object-transformer (generation-param-alist profile) | |
782 | params))) | |
783 | (map ->sexp generations))) | |
457f60fa | 784 | |
67cedc4b AK |
785 | (define system-generation-boot-parameters |
786 | (memoize | |
787 | (lambda (profile generation) | |
788 | "Return boot parameters for PROFILE's system GENERATION." | |
789 | (let* ((gen-file (generation-file-name profile generation)) | |
790 | (param-file (string-append gen-file "/parameters"))) | |
791 | (call-with-input-file param-file read-boot-parameters))))) | |
792 | ||
793 | (define (system-generation-param-alist profile) | |
794 | "Return an alist of system generation parameters and procedures for | |
795 | PROFILE." | |
796 | (append (generation-param-alist profile) | |
797 | `((label . ,(lambda (gen) | |
798 | (boot-parameters-label | |
799 | (system-generation-boot-parameters | |
800 | profile gen)))) | |
801 | (root-device . ,(lambda (gen) | |
802 | (boot-parameters-root-device | |
803 | (system-generation-boot-parameters | |
804 | profile gen)))) | |
805 | (kernel . ,(lambda (gen) | |
806 | (boot-parameters-kernel | |
807 | (system-generation-boot-parameters | |
808 | profile gen))))))) | |
809 | ||
810 | (define (system-generation-sexps profile params search-type search-vals) | |
811 | "Return an alist with information about system generations." | |
812 | (let ((generations (find-generations profile search-type search-vals)) | |
813 | (->sexp (object-transformer (system-generation-param-alist profile) | |
814 | params))) | |
815 | (map ->sexp generations))) | |
816 | ||
457f60fa | 817 | \f |
81b339fe AK |
818 | ;;; Getting package/output/generation entries (alists). |
819 | ||
820 | (define (entries profile params entry-type search-type search-vals) | |
821 | "Return information about entries. | |
822 | ||
823 | ENTRY-TYPE is a symbol defining a type of returning information. Should | |
824 | be: 'package', 'output' or 'generation'. | |
825 | ||
826 | SEARCH-TYPE and SEARCH-VALS define how to get the information. | |
827 | SEARCH-TYPE should be one of the following symbols: | |
828 | ||
829 | - If ENTRY-TYPE is 'package' or 'output': | |
830 | 'id', 'name', 'regexp', 'all-available', 'newest-available', | |
831 | 'installed', 'obsolete', 'generation'. | |
832 | ||
833 | - If ENTRY-TYPE is 'generation': | |
189cea27 | 834 | 'id', 'last', 'all', 'time'. |
81b339fe AK |
835 | |
836 | PARAMS is a list of parameters for receiving. If it is an empty list, | |
837 | get information with all available parameters, which are: | |
838 | ||
839 | - If ENTRY-TYPE is 'package': | |
840 | 'id', 'name', 'version', 'outputs', 'license', 'synopsis', | |
841 | 'description', 'home-url', 'inputs', 'native-inputs', | |
842 | 'propagated-inputs', 'location', 'installed'. | |
843 | ||
844 | - If ENTRY-TYPE is 'output': | |
845 | 'id', 'package-id', 'name', 'version', 'output', 'license', | |
846 | 'synopsis', 'description', 'home-url', 'inputs', 'native-inputs', | |
847 | 'propagated-inputs', 'location', 'installed', 'path', 'dependencies'. | |
848 | ||
849 | - If ENTRY-TYPE is 'generation': | |
850 | 'id', 'number', 'prev-number', 'path', 'time'. | |
851 | ||
852 | Returning value is a list of alists. Each alist consists of | |
853 | parameter/value pairs." | |
854 | (case entry-type | |
855 | ((package output) | |
856 | (package/output-sexps profile params entry-type | |
857 | search-type search-vals)) | |
858 | ((generation) | |
859 | (generation-sexps profile params | |
860 | search-type search-vals)) | |
67cedc4b AK |
861 | ((system-generation) |
862 | (system-generation-sexps profile params | |
863 | search-type search-vals)) | |
81b339fe | 864 | (else (entry-type-error entry-type)))) |
457f60fa AK |
865 | |
866 | \f | |
81b339fe | 867 | ;;; Package actions. |
457f60fa AK |
868 | |
869 | (define* (package->manifest-entry* package #:optional output) | |
870 | (and package | |
6caa4dfa | 871 | (package->manifest-entry package output))) |
457f60fa AK |
872 | |
873 | (define* (make-install-manifest-entries id #:optional output) | |
874 | (package->manifest-entry* (package-by-id id) output)) | |
875 | ||
876 | (define* (make-upgrade-manifest-entries id #:optional output) | |
877 | (package->manifest-entry* (newest-package-by-id id) output)) | |
878 | ||
879 | (define* (make-manifest-pattern id #:optional output) | |
880 | "Make manifest pattern from a package ID and OUTPUT." | |
881 | (let-values (((name version) | |
882 | (id->name+version id))) | |
883 | (and name version | |
884 | (manifest-pattern | |
885 | (name name) | |
886 | (version version) | |
887 | (output output))))) | |
888 | ||
889 | (define (convert-action-pattern pattern proc) | |
890 | "Convert action PATTERN into a list of objects returned by PROC. | |
891 | PROC is called: (PROC ID) or (PROC ID OUTPUT)." | |
892 | (match pattern | |
893 | ((id . outputs) | |
894 | (if (null? outputs) | |
895 | (let ((obj (proc id))) | |
896 | (if obj (list obj) '())) | |
897 | (filter-map (cut proc id <>) | |
898 | outputs))) | |
899 | (_ '()))) | |
900 | ||
901 | (define (convert-action-patterns patterns proc) | |
902 | (append-map (cut convert-action-pattern <> proc) | |
903 | patterns)) | |
904 | ||
905 | (define* (process-package-actions | |
906 | profile #:key (install '()) (upgrade '()) (remove '()) | |
907 | (use-substitutes? #t) dry-run?) | |
908 | "Perform package actions. | |
909 | ||
910 | INSTALL, UPGRADE, REMOVE are lists of 'package action patterns'. | |
911 | Each pattern should have the following form: | |
912 | ||
913 | (ID . OUTPUTS) | |
914 | ||
915 | ID is an object address or a full-name of a package. | |
916 | OUTPUTS is a list of package outputs (may be an empty list)." | |
917 | (format #t "The process begins ...~%") | |
918 | (let* ((install (append | |
919 | (convert-action-patterns | |
920 | install make-install-manifest-entries) | |
921 | (convert-action-patterns | |
922 | upgrade make-upgrade-manifest-entries))) | |
923 | (remove (convert-action-patterns remove make-manifest-pattern)) | |
924 | (transaction (manifest-transaction (install install) | |
925 | (remove remove))) | |
926 | (manifest (profile-manifest profile)) | |
927 | (new-manifest (manifest-perform-transaction | |
928 | manifest transaction))) | |
929 | (unless (and (null? install) (null? remove)) | |
1f06b288 | 930 | (with-store store |
5f292845 AK |
931 | (set-build-options store |
932 | #:print-build-trace #f | |
933 | #:use-substitutes? use-substitutes?) | |
934 | (show-manifest-transaction store manifest transaction | |
935 | #:dry-run? dry-run?) | |
936 | (build-and-use-profile store profile new-manifest | |
937 | #:use-substitutes? use-substitutes? | |
938 | #:dry-run? dry-run?))))) | |
cb6a5c71 AK |
939 | |
940 | (define (delete-generations* profile generations) | |
941 | "Delete GENERATIONS from PROFILE. | |
942 | GENERATIONS is a list of generation numbers." | |
943 | (with-store store | |
944 | (delete-generations store profile generations))) | |
0b0fbf0c | 945 | |
eb097f36 AK |
946 | (define (package-location-string id-or-name) |
947 | "Return a location string of a package with ID-OR-NAME." | |
16f4acbd LC |
948 | (and=> (or (package-by-id id-or-name) |
949 | (match (packages-by-name id-or-name) | |
950 | (() #f) | |
951 | ((package _ ...) package))) | |
952 | (compose location->string package-location))) | |
6248e326 | 953 | |
0b0fbf0c AK |
954 | (define (package-source-derivation->store-path derivation) |
955 | "Return a store path of the package source DERIVATION." | |
956 | (match (derivation-outputs derivation) | |
957 | ;; Source derivation is always (("out" . derivation)). | |
958 | (((_ . output-drv)) | |
959 | (derivation-output-path output-drv)) | |
960 | (_ #f))) | |
961 | ||
962 | (define (package-source-path package-id) | |
963 | "Return a store file path to a source of a package PACKAGE-ID." | |
964 | (and-let* ((package (package-by-id package-id)) | |
965 | (source (package-source package))) | |
966 | (with-store store | |
967 | (package-source-derivation->store-path | |
968 | (package-source-derivation store source))))) | |
969 | ||
970 | (define* (package-source-build-derivation package-id #:key dry-run? | |
971 | (use-substitutes? #t)) | |
972 | "Build source derivation of a package PACKAGE-ID." | |
973 | (and-let* ((package (package-by-id package-id)) | |
974 | (source (package-source package))) | |
975 | (with-store store | |
976 | (let* ((derivation (package-source-derivation store source)) | |
977 | (derivations (list derivation))) | |
978 | (set-build-options store | |
90fad288 | 979 | #:print-build-trace #f |
0b0fbf0c AK |
980 | #:use-substitutes? use-substitutes?) |
981 | (show-what-to-build store derivations | |
982 | #:use-substitutes? use-substitutes? | |
983 | #:dry-run? dry-run?) | |
984 | (unless dry-run? | |
985 | (build-derivations store derivations)) | |
986 | (format #t "The source store path: ~a~%" | |
987 | (package-source-derivation->store-path derivation)))))) | |
056b5cef AK |
988 | |
989 | \f | |
5e53b0c5 AK |
990 | ;;; Executing guix commands |
991 | ||
992 | (define (guix-command . args) | |
993 | "Run 'guix ARGS ...' command." | |
994 | (catch 'quit | |
995 | (lambda () (apply run-guix args)) | |
996 | (const #t))) | |
997 | ||
998 | (define (guix-command-output . args) | |
ea369ee1 AK |
999 | "Return 2 strings with 'guix ARGS ...' output and error output." |
1000 | (output+error | |
1001 | (lambda () | |
1002 | (parameterize ((guix-warning-port (current-error-port))) | |
1003 | (apply guix-command args))))) | |
5e53b0c5 AK |
1004 | |
1005 | (define (help-string . commands) | |
1006 | "Return string with 'guix COMMANDS ... --help' output." | |
1007 | (apply guix-command-output `(,@commands "--help"))) | |
1008 | ||
8b9ceb8d AK |
1009 | (define (pipe-guix-output guix-args command-args) |
1010 | "Run 'guix GUIX-ARGS ...' command and pipe its output to a shell command | |
1011 | defined by COMMAND-ARGS. | |
1012 | Return #t if the shell command was executed successfully." | |
1013 | (let ((pipe (apply open-pipe* OPEN_WRITE command-args))) | |
1014 | (with-output-to-port pipe | |
1015 | (lambda () (apply guix-command guix-args))) | |
1016 | (zero? (status:exit-val (close-pipe pipe))))) | |
1017 | ||
5e53b0c5 | 1018 | \f |
056b5cef AK |
1019 | ;;; Lists of packages, lint checkers, etc. |
1020 | ||
43b40c4b AK |
1021 | (define (graph-type-names) |
1022 | "Return a list of names of available graph node types." | |
7ccb3ad3 AK |
1023 | (map (@ (guix graph) node-type-name) |
1024 | (@ (guix scripts graph) %node-types))) | |
43b40c4b | 1025 | |
6407ce8e AK |
1026 | (define (refresh-updater-names) |
1027 | "Return a list of names of available refresh updater types." | |
1028 | (map (@ (guix upstream) upstream-updater-name) | |
1029 | (@ (guix scripts refresh) %updaters))) | |
1030 | ||
056b5cef AK |
1031 | (define (lint-checker-names) |
1032 | "Return a list of names of available lint checkers." | |
1033 | (map (lambda (checker) | |
619ff906 AK |
1034 | (symbol->string ((@ (guix scripts lint) lint-checker-name) |
1035 | checker))) | |
1036 | (@ (guix scripts lint) %checkers))) | |
25a2839c AK |
1037 | |
1038 | (define (package-names) | |
1039 | "Return a list of names of available packages." | |
1040 | (delete-duplicates | |
1041 | (fold-packages (lambda (pkg res) | |
1042 | (cons (package-name pkg) res)) | |
1043 | '()))) | |
1044 | ||
1045 | ;; See the comment to 'guix-package-names' function in "guix-popup.el". | |
1046 | (define (package-names-lists) | |
1047 | (map list (package-names))) | |
71310ccc AK |
1048 | |
1049 | \f | |
1050 | ;;; Licenses | |
1051 | ||
1052 | (define %licenses | |
1053 | (delay | |
1054 | (filter license? | |
1055 | (module-map (lambda (_ var) | |
1056 | (variable-ref var)) | |
1057 | (resolve-interface '(guix licenses)))))) | |
1058 | ||
1059 | (define (licenses) | |
1060 | (force %licenses)) | |
1061 | ||
1062 | (define (license-names) | |
1063 | "Return a list of names of available licenses." | |
1064 | (map license-name (licenses))) | |
1065 | ||
1066 | (define lookup-license | |
1067 | (memoize | |
1068 | (lambda (name) | |
1069 | "Return a license by its name." | |
1070 | (find (lambda (l) | |
1071 | (string=? name (license-name l))) | |
1072 | (licenses))))) | |
1073 | ||
1074 | (define (lookup-license-uri name) | |
1075 | "Return a license URI by its name." | |
1076 | (and=> (lookup-license name) | |
1077 | license-uri)) | |
687c9bc0 AK |
1078 | |
1079 | (define %license-param-alist | |
1080 | `((id . ,license-name) | |
1081 | (name . ,license-name) | |
1082 | (url . ,license-uri) | |
1083 | (comment . ,license-comment))) | |
1084 | ||
1085 | (define license->sexp | |
1086 | (object-transformer %license-param-alist)) | |
1087 | ||
1088 | (define (find-licenses search-type . search-values) | |
1089 | "Return a list of licenses depending on SEARCH-TYPE and SEARCH-VALUES." | |
1090 | (case search-type | |
1091 | ((id name) | |
1092 | (let ((names search-values)) | |
1093 | (filter-map lookup-license names))) | |
1094 | ((all) | |
1095 | (licenses)))) | |
1096 | ||
1097 | (define (license-entries search-type . search-values) | |
1098 | (map license->sexp | |
1099 | (apply find-licenses search-type search-values))) |