Commit | Line | Data |
---|---|---|
233e7676 | 1 | ;;; GNU Guix --- Functional package management for GNU |
0552dcb2 | 2 | ;;; Copyright © 2012-2020, 2022 Ludovic Courtès <ludo@gnu.org> |
c2868b1e | 3 | ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org> |
7d193ec3 | 4 | ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> |
96eaa55f | 5 | ;;; Copyright © 2016, 2017 Alex Kost <alezost@gmail.com> |
fad155d4 | 6 | ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org> |
7041fe06 | 7 | ;;; Copyright © 2022 Antero Mejr <antero@mailbox.org> |
6b1891b0 | 8 | ;;; |
233e7676 | 9 | ;;; This file is part of GNU Guix. |
6b1891b0 | 10 | ;;; |
233e7676 | 11 | ;;; GNU Guix is free software; you can redistribute it and/or modify it |
6b1891b0 LC |
12 | ;;; under the terms of the GNU General Public License as published by |
13 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
14 | ;;; your option) any later version. | |
15 | ;;; | |
233e7676 | 16 | ;;; GNU Guix is distributed in the hope that it will be useful, but |
6b1891b0 LC |
17 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of |
18 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;;; GNU General Public License for more details. | |
20 | ;;; | |
21 | ;;; You should have received a copy of the GNU General Public License | |
233e7676 | 22 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. |
6b1891b0 | 23 | |
59a43334 | 24 | (define-module (gnu packages) |
6b1891b0 | 25 | #:use-module (guix packages) |
98eb8cbe | 26 | #:use-module (guix ui) |
800cdeef | 27 | #:use-module (guix utils) |
d51bfe24 | 28 | #:use-module (guix diagnostics) |
cd903ef7 | 29 | #:use-module (guix discovery) |
f9704f17 | 30 | #:use-module (guix memoization) |
95cd4971 LC |
31 | #:use-module ((guix build utils) |
32 | #:select ((package-name->name+version | |
5fbdc9a5 LC |
33 | . hyphen-separated-name->name+version) |
34 | mkdir-p)) | |
6a7c4636 | 35 | #:use-module (guix profiles) |
fe634eaf | 36 | #:use-module (guix describe) |
f2bf0407 | 37 | #:use-module (guix deprecation) |
c2868b1e | 38 | #:use-module (ice-9 vlist) |
dc5669cd | 39 | #:use-module (ice-9 match) |
6a7c4636 | 40 | #:use-module (ice-9 binary-ports) |
5fbdc9a5 | 41 | #:autoload (system base compile) (compile) |
6b1891b0 LC |
42 | #:use-module (srfi srfi-1) |
43 | #:use-module (srfi srfi-26) | |
dbab5150 LC |
44 | #:use-module (srfi srfi-34) |
45 | #:use-module (srfi srfi-35) | |
800cdeef | 46 | #:use-module (srfi srfi-39) |
635d49f9 | 47 | #:use-module (srfi srfi-71) |
800cdeef | 48 | #:export (search-patch |
25897079 | 49 | search-patches |
96eaa55f | 50 | search-auxiliary-file |
0492f4a2 | 51 | %patch-path |
96eaa55f | 52 | %auxiliary-files-path |
c107b541 | 53 | %package-module-path |
fe634eaf | 54 | %default-package-module-path |
0552dcb2 | 55 | cache-is-authoritative? |
7d193ec3 | 56 | |
ba326ce4 | 57 | fold-packages |
0ea939fb | 58 | fold-available-packages |
7d193ec3 | 59 | |
f2bf0407 | 60 | find-newest-available-packages |
dc5669cd | 61 | find-packages-by-name |
ee8099f5 | 62 | find-package-locations |
3f26bfc1 | 63 | find-best-packages-by-name |
7d193ec3 | 64 | |
84189ebc | 65 | specification->package |
c08ea55e | 66 | specification->package+output |
ee8099f5 | 67 | specification->location |
5fbdc9a5 | 68 | specifications->manifest |
7041fe06 | 69 | specifications->packages |
5fbdc9a5 | 70 | |
f54f2aa9 LC |
71 | package-unique-version-prefix |
72 | ||
5fbdc9a5 | 73 | generate-package-cache)) |
6b1891b0 LC |
74 | |
75 | ;;; Commentary: | |
76 | ;;; | |
77 | ;;; General utilities for the software distribution---i.e., the modules under | |
59a43334 | 78 | ;;; (gnu packages ...). |
6b1891b0 LC |
79 | ;;; |
80 | ;;; Code: | |
81 | ||
1ba0b1e6 | 82 | ;; By default, we store patches and auxiliary files |
96eaa55f AK |
83 | ;; alongside Guile modules. This is so that these extra files can be |
84 | ;; found without requiring a special setup, such as a specific | |
85 | ;; installation directory and an extra environment variable. One | |
86 | ;; advantage of this setup is that everything just works in an | |
87 | ;; auto-compilation setting. | |
a9f60c42 | 88 | |
96eaa55f AK |
89 | (define %auxiliary-files-path |
90 | (make-parameter | |
91 | (map (cut string-append <> "/gnu/packages/aux-files") | |
92 | %load-path))) | |
93 | ||
94 | (define (search-auxiliary-file file-name) | |
95 | "Search the auxiliary FILE-NAME. Return #f if not found." | |
96 | (search-path (%auxiliary-files-path) file-name)) | |
97 | ||
800cdeef | 98 | (define (search-patch file-name) |
dbab5150 LC |
99 | "Search the patch FILE-NAME. Raise an error if not found." |
100 | (or (search-path (%patch-path) file-name) | |
d51bfe24 LC |
101 | (raise (formatted-message (G_ "~a: patch not found") |
102 | file-name)))) | |
800cdeef | 103 | |
25897079 AK |
104 | (define-syntax-rule (search-patches file-name ...) |
105 | "Return the list of absolute file names corresponding to each | |
106 | FILE-NAME found in %PATCH-PATH." | |
107 | (list (search-patch file-name) ...)) | |
108 | ||
84836a57 | 109 | (define %distro-root-directory |
eaae07ec LC |
110 | ;; Absolute file name of the module hierarchy. Since (gnu packages …) might |
111 | ;; live in a directory different from (guix), try to get the best match. | |
112 | (letrec-syntax ((dirname* (syntax-rules () | |
113 | ((_ file) | |
114 | (dirname file)) | |
115 | ((_ file head tail ...) | |
116 | (dirname (dirname* file tail ...))))) | |
117 | (try (syntax-rules () | |
118 | ((_ (file things ...) rest ...) | |
119 | (match (search-path %load-path file) | |
120 | (#f | |
121 | (try rest ...)) | |
122 | (absolute | |
123 | (dirname* absolute things ...)))) | |
124 | ((_) | |
125 | #f)))) | |
126 | (try ("gnu/packages/base.scm" gnu/ packages/) | |
127 | ("gnu/packages.scm" gnu/) | |
128 | ("guix.scm")))) | |
6b1891b0 | 129 | |
fe634eaf LC |
130 | (define %default-package-module-path |
131 | ;; Default search path for package modules. | |
132 | `((,%distro-root-directory . "gnu/packages"))) | |
133 | ||
5fbdc9a5 LC |
134 | (define (cache-is-authoritative?) |
135 | "Return true if the pre-computed package cache is authoritative. It is not | |
136 | authoritative when entries have been added via GUIX_PACKAGE_PATH or '-L' | |
137 | flags." | |
138 | (equal? (%package-module-path) | |
139 | (append %default-package-module-path | |
140 | (package-path-entries)))) | |
141 | ||
c107b541 LC |
142 | (define %package-module-path |
143 | ;; Search path for package modules. Each item must be either a directory | |
144 | ;; name or a pair whose car is a directory and whose cdr is a sub-directory | |
145 | ;; to narrow the search. | |
635d49f9 LC |
146 | (let* ((not-colon (char-set-complement (char-set #\:))) |
147 | (environment (string-tokenize (or (getenv "GUIX_PACKAGE_PATH") "") | |
148 | not-colon)) | |
149 | (channels-scm channels-go (package-path-entries))) | |
fe634eaf LC |
150 | ;; Automatically add channels and items from $GUIX_PACKAGE_PATH to Guile's |
151 | ;; search path. For historical reasons, $GUIX_PACKAGE_PATH goes to the | |
152 | ;; front; channels go to the back so that they don't override Guix' own | |
153 | ;; modules. | |
154 | (set! %load-path | |
bfc9c339 | 155 | (append environment %load-path channels-scm)) |
fe634eaf | 156 | (set! %load-compiled-path |
bfc9c339 | 157 | (append environment %load-compiled-path channels-go)) |
8689901f LC |
158 | |
159 | (make-parameter | |
fe634eaf LC |
160 | (append environment |
161 | %default-package-module-path | |
bfc9c339 | 162 | channels-scm)))) |
c107b541 | 163 | |
ee06af5b LC |
164 | (define %patch-path |
165 | ;; Define it after '%package-module-path' so that '%load-path' contains user | |
166 | ;; directories, allowing patches in $GUIX_PACKAGE_PATH to be found. | |
167 | (make-parameter | |
168 | (map (lambda (directory) | |
169 | (if (string=? directory %distro-root-directory) | |
170 | (string-append directory "/gnu/packages/patches") | |
171 | directory)) | |
172 | %load-path))) | |
173 | ||
f2bf0407 LC |
174 | ;; This procedure is used by Emacs-Guix up to 0.5.1.1, so keep it for now. |
175 | ;; See <https://github.com/alezost/guix.el/issues/30>. | |
176 | (define-deprecated find-newest-available-packages | |
177 | find-packages-by-name | |
178 | (mlambda () | |
179 | "Return a vhash keyed by package names, and with | |
180 | associated values of the form | |
181 | ||
182 | (newest-version newest-package ...) | |
183 | ||
184 | where the preferred package is listed first." | |
185 | (fold-packages (lambda (p r) | |
186 | (let ((name (package-name p)) | |
187 | (version (package-version p))) | |
188 | (match (vhash-assoc name r) | |
189 | ((_ newest-so-far . pkgs) | |
190 | (case (version-compare version newest-so-far) | |
191 | ((>) (vhash-cons name `(,version ,p) r)) | |
192 | ((=) (vhash-cons name `(,version ,p ,@pkgs) r)) | |
193 | ((<) r))) | |
194 | (#f (vhash-cons name `(,version ,p) r))))) | |
195 | vlist-null))) | |
196 | ||
0ea939fb LC |
197 | (define (fold-available-packages proc init) |
198 | "Fold PROC over the list of available packages. For each available package, | |
199 | PROC is called along these lines: | |
200 | ||
201 | (PROC NAME VERSION RESULT | |
202 | #:outputs OUTPUTS | |
203 | #:location LOCATION | |
204 | …) | |
205 | ||
206 | PROC can use #:allow-other-keys to ignore the bits it's not interested in. | |
207 | When a package cache is available, this procedure does not actually load any | |
208 | package module." | |
209 | (define cache | |
210 | (load-package-cache (current-profile))) | |
211 | ||
212 | (if (and cache (cache-is-authoritative?)) | |
213 | (vhash-fold (lambda (name vector result) | |
214 | (match vector | |
215 | (#(name version module symbol outputs | |
216 | supported? deprecated? | |
217 | file line column) | |
218 | (proc name version result | |
219 | #:outputs outputs | |
220 | #:location (and file | |
221 | (location file line column)) | |
222 | #:supported? supported? | |
223 | #:deprecated? deprecated?)))) | |
224 | init | |
225 | cache) | |
226 | (fold-packages (lambda (package result) | |
227 | (proc (package-name package) | |
228 | (package-version package) | |
229 | result | |
230 | #:outputs (package-outputs package) | |
231 | #:location (package-location package) | |
232 | #:supported? | |
88da0115 | 233 | (->bool (supported-package? package)) |
0ea939fb LC |
234 | #:deprecated? |
235 | (->bool | |
236 | (package-superseded package)))) | |
237 | init))) | |
238 | ||
5c5ae46c LC |
239 | (define* (fold-packages proc init |
240 | #:optional | |
3c0128b0 LC |
241 | (modules (all-modules (%package-module-path) |
242 | #:warn | |
243 | warn-about-load-error)) | |
96dc8f35 | 244 | #:key (select? (negate hidden-package?))) |
5c5ae46c | 245 | "Call (PROC PACKAGE RESULT) for each available package defined in one of |
96dc8f35 LC |
246 | MODULES that matches SELECT?, using INIT as the initial value of RESULT. It |
247 | is guaranteed to never traverse the same package twice." | |
cd903ef7 | 248 | (fold-module-public-variables (lambda (object result) |
96dc8f35 | 249 | (if (and (package? object) (select? object)) |
cd903ef7 LC |
250 | (proc object result) |
251 | result)) | |
252 | init | |
5c5ae46c | 253 | modules)) |
ba326ce4 | 254 | |
5fbdc9a5 LC |
255 | (define %package-cache-file |
256 | ;; Location of the package cache. | |
257 | "/lib/guix/package.cache") | |
258 | ||
259 | (define load-package-cache | |
260 | (mlambda (profile) | |
261 | "Attempt to load the package cache. On success return a vhash keyed by | |
262 | package names. Return #f on failure." | |
263 | (match profile | |
264 | (#f #f) | |
265 | (profile | |
266 | (catch 'system-error | |
267 | (lambda () | |
268 | (define lst | |
269 | (load-compiled (string-append profile %package-cache-file))) | |
270 | (fold (lambda (item vhash) | |
271 | (match item | |
272 | (#(name version module symbol outputs | |
273 | supported? deprecated? | |
274 | file line column) | |
275 | (vhash-cons name item vhash)))) | |
276 | vlist-null | |
277 | lst)) | |
278 | (lambda args | |
279 | (if (= ENOENT (system-error-errno args)) | |
280 | #f | |
281 | (apply throw args)))))))) | |
282 | ||
283 | (define find-packages-by-name/direct ;bypass the cache | |
9ffc1c00 LC |
284 | (let ((packages (delay |
285 | (fold-packages (lambda (p r) | |
286 | (vhash-cons (package-name p) p r)) | |
724311a2 LC |
287 | vlist-null))) |
288 | (version>? (lambda (p1 p2) | |
289 | (version>? (package-version p1) (package-version p2))))) | |
9ffc1c00 LC |
290 | (lambda* (name #:optional version) |
291 | "Return the list of packages with the given NAME. If VERSION is not #f, | |
724311a2 LC |
292 | then only return packages whose version is prefixed by VERSION, sorted in |
293 | decreasing version order." | |
294 | (let ((matching (sort (vhash-fold* cons '() name (force packages)) | |
295 | version>?))) | |
9ffc1c00 LC |
296 | (if version |
297 | (filter (lambda (package) | |
348987d3 | 298 | (version-prefix? version (package-version package))) |
9ffc1c00 LC |
299 | matching) |
300 | matching))))) | |
dc5669cd | 301 | |
5fbdc9a5 LC |
302 | (define (cache-lookup cache name) |
303 | "Lookup package NAME in CACHE. Return a list sorted in increasing version | |
304 | order." | |
305 | (define (package-version<? v1 v2) | |
306 | (version>? (vector-ref v2 1) (vector-ref v1 1))) | |
307 | ||
308 | (sort (vhash-fold* cons '() name cache) | |
309 | package-version<?)) | |
310 | ||
311 | (define* (find-packages-by-name name #:optional version) | |
312 | "Return the list of packages with the given NAME. If VERSION is not #f, | |
313 | then only return packages whose version is prefixed by VERSION, sorted in | |
314 | decreasing version order." | |
315 | (define cache | |
316 | (load-package-cache (current-profile))) | |
317 | ||
318 | (if (and (cache-is-authoritative?) cache) | |
319 | (match (cache-lookup cache name) | |
320 | (#f #f) | |
321 | ((#(_ versions modules symbols _ _ _ _ _ _) ...) | |
322 | (fold (lambda (version* module symbol result) | |
323 | (if (or (not version) | |
324 | (version-prefix? version version*)) | |
325 | (cons (module-ref (resolve-interface module) | |
326 | symbol) | |
327 | result) | |
328 | result)) | |
329 | '() | |
330 | versions modules symbols))) | |
331 | (find-packages-by-name/direct name version))) | |
332 | ||
ee8099f5 LC |
333 | (define* (find-package-locations name #:optional version) |
334 | "Return a list of version/location pairs corresponding to each package | |
335 | matching NAME and VERSION." | |
336 | (define cache | |
337 | (load-package-cache (current-profile))) | |
338 | ||
339 | (if (and cache (cache-is-authoritative?)) | |
340 | (match (cache-lookup cache name) | |
341 | (#f '()) | |
342 | ((#(name versions modules symbols outputs | |
343 | supported? deprecated? | |
344 | files lines columns) ...) | |
345 | (fold (lambda (version* file line column result) | |
346 | (if (and file | |
347 | (or (not version) | |
348 | (version-prefix? version version*))) | |
349 | (alist-cons version* (location file line column) | |
350 | result) | |
351 | result)) | |
352 | '() | |
353 | versions files lines columns))) | |
354 | (map (lambda (package) | |
355 | (cons (package-version package) (package-location package))) | |
356 | (find-packages-by-name/direct name version)))) | |
3f26bfc1 LC |
357 | |
358 | (define (find-best-packages-by-name name version) | |
359 | "If version is #f, return the list of packages named NAME with the highest | |
360 | version numbers; otherwise, return the list of packages named NAME and at | |
361 | VERSION." | |
362 | (if version | |
363 | (find-packages-by-name name version) | |
e2a903c8 LC |
364 | (match (find-packages-by-name name) |
365 | (() | |
366 | '()) | |
367 | ((matches ...) | |
368 | ;; Return the subset of MATCHES with the higher version number. | |
369 | (let ((highest (package-version (first matches)))) | |
370 | (take-while (lambda (p) | |
371 | (string=? (package-version p) highest)) | |
372 | matches)))))) | |
7d193ec3 | 373 | |
886a7607 LC |
374 | ;; Prevent Guile 3 from inlining this procedure so we can mock it in tests. |
375 | (set! find-best-packages-by-name find-best-packages-by-name) | |
376 | ||
5fbdc9a5 LC |
377 | (define (generate-package-cache directory) |
378 | "Generate under DIRECTORY a cache of all the available packages. | |
379 | ||
380 | The primary purpose of the cache is to speed up package lookup by name such | |
381 | that we don't have to traverse and load all the package modules, thereby also | |
382 | reducing the memory footprint." | |
383 | (define cache-file | |
384 | (string-append directory %package-cache-file)) | |
385 | ||
a127e52f LC |
386 | (define expand-cache |
387 | (match-lambda* | |
388 | (((module symbol variable) (result . seen)) | |
389 | (let ((package (variable-ref variable))) | |
390 | (if (or (vhash-assq package seen) | |
391 | (hidden-package? package)) | |
392 | (cons result seen) | |
393 | (cons (cons `#(,(package-name package) | |
394 | ,(package-version package) | |
395 | ,(module-name module) | |
396 | ,symbol | |
397 | ,(package-outputs package) | |
398 | ,(->bool (supported-package? package)) | |
399 | ,(->bool (package-superseded package)) | |
400 | ,@(let ((loc (package-location package))) | |
401 | (if loc | |
402 | `(,(location-file loc) | |
403 | ,(location-line loc) | |
404 | ,(location-column loc)) | |
405 | '(#f #f #f)))) | |
406 | result) | |
407 | (vhash-consq package #t seen))))))) | |
408 | ||
409 | (define entry-key | |
410 | (match-lambda | |
411 | ((module symbol variable) | |
412 | (let ((value (variable-ref variable))) | |
413 | (string-append (package-name value) (package-version value) | |
414 | (object->string module) | |
415 | (symbol->string symbol)))))) | |
416 | ||
417 | (define (entry<? a b) | |
418 | (string<? (entry-key a) (entry-key b))) | |
419 | ||
420 | (define variables | |
421 | ;; First sort variables so that 'expand-cache' later dismisses | |
422 | ;; already-seen package objects in a deterministic fashion. | |
423 | (sort | |
424 | (fold-module-public-variables* (lambda (module symbol variable lst) | |
425 | (let ((value (false-if-exception | |
426 | (variable-ref variable)))) | |
427 | (if (package? value) | |
428 | (cons (list module symbol variable) | |
429 | lst) | |
430 | lst))) | |
431 | '() | |
36754eee LC |
432 | (all-modules (%package-module-path) |
433 | #:warn | |
a127e52f LC |
434 | warn-about-load-error)) |
435 | entry<?)) | |
436 | ||
437 | (define exp | |
438 | (first (fold expand-cache (cons '() vlist-null) variables))) | |
5fbdc9a5 LC |
439 | |
440 | (mkdir-p (dirname cache-file)) | |
441 | (call-with-output-file cache-file | |
442 | (lambda (port) | |
443 | ;; Store the cache as a '.go' file. This makes loading fast and reduces | |
444 | ;; heap usage since some of the static data is directly mmapped. | |
445 | (put-bytevector port | |
446 | (compile `'(,@exp) | |
447 | #:to 'bytecode | |
448 | #:opts '(#:to-file? #t))))) | |
449 | cache-file) | |
7d193ec3 EB |
450 | |
451 | \f | |
4ea44419 AK |
452 | (define %sigint-prompt |
453 | ;; The prompt to jump to upon SIGINT. | |
454 | (make-prompt-tag "interruptible")) | |
455 | ||
456 | (define (call-with-sigint-handler thunk handler) | |
457 | "Call THUNK and return its value. Upon SIGINT, call HANDLER with the signal | |
458 | number in the context of the continuation of the call to this function, and | |
459 | return its return value." | |
460 | (call-with-prompt %sigint-prompt | |
461 | (lambda () | |
462 | (sigaction SIGINT | |
463 | (lambda (signum) | |
464 | (sigaction SIGINT SIG_DFL) | |
465 | (abort-to-prompt %sigint-prompt signum))) | |
466 | (dynamic-wind | |
467 | (const #t) | |
468 | thunk | |
469 | (cut sigaction SIGINT SIG_DFL))) | |
470 | (lambda (k signum) | |
471 | (handler signum)))) | |
472 | ||
fad155d4 ML |
473 | \f |
474 | ;;; | |
475 | ;;; Package specification. | |
476 | ;;; | |
477 | ||
e30c2be1 | 478 | (define* (%find-package spec name version) |
fad155d4 ML |
479 | (match (find-best-packages-by-name name version) |
480 | ((pkg . pkg*) | |
481 | (unless (null? pkg*) | |
69daee23 LC |
482 | (warning (G_ "ambiguous package specification `~a'~%") spec) |
483 | (warning (G_ "choosing ~a@~a from ~a~%") | |
d75e8f36 | 484 | (package-name pkg) (package-version pkg) |
fad155d4 | 485 | (location->string (package-location pkg)))) |
01afdab8 LC |
486 | (match (package-superseded pkg) |
487 | ((? package? new) | |
69daee23 | 488 | (info (G_ "package '~a' has been superseded by '~a'~%") |
01afdab8 LC |
489 | (package-name pkg) (package-name new)) |
490 | new) | |
491 | (#f | |
492 | pkg))) | |
e465d9e1 | 493 | (x |
fad155d4 | 494 | (if version |
69daee23 LC |
495 | (leave (G_ "~A: package not found for version ~a~%") name version) |
496 | (leave (G_ "~A: unknown package~%") name))))) | |
fad155d4 | 497 | |
5e3b388b CR |
498 | (define (specification->package spec) |
499 | "Return a package matching SPEC. SPEC may be a package name, or a package | |
1b846da8 | 500 | name followed by an at-sign and a version number. If the version number is not |
5e3b388b | 501 | present, return the preferred newest version." |
635d49f9 | 502 | (let ((name version (package-name->name+version spec))) |
fad155d4 | 503 | (%find-package spec name version))) |
84189ebc | 504 | |
ee8099f5 LC |
505 | (define (specification->location spec) |
506 | "Return the location of the highest-numbered package matching SPEC, a | |
507 | specification such as \"guile@2\" or \"emacs\"." | |
635d49f9 | 508 | (let ((name version (package-name->name+version spec))) |
ee8099f5 LC |
509 | (match (find-package-locations name version) |
510 | (() | |
511 | (if version | |
512 | (leave (G_ "~A: package not found for version ~a~%") name version) | |
513 | (leave (G_ "~A: unknown package~%") name))) | |
514 | (lst | |
515 | (let* ((highest (match lst (((version . _) _ ...) version))) | |
516 | (locations (take-while (match-lambda | |
517 | ((version . location) | |
518 | (string=? version highest))) | |
519 | lst))) | |
520 | (match locations | |
521 | (((version . location) . rest) | |
522 | (unless (null? rest) | |
523 | (warning (G_ "ambiguous package specification `~a'~%") spec) | |
524 | (warning (G_ "choosing ~a@~a from ~a~%") | |
525 | name version | |
526 | (location->string location))) | |
527 | location))))))) | |
528 | ||
84189ebc LC |
529 | (define* (specification->package+output spec #:optional (output "out")) |
530 | "Return the package and output specified by SPEC, or #f and #f; SPEC may | |
531 | optionally contain a version number and an output name, as in these examples: | |
532 | ||
533 | guile | |
1b846da8 | 534 | guile@2.0.9 |
84189ebc | 535 | guile:debug |
1b846da8 | 536 | guile@2.0.9:debug |
84189ebc LC |
537 | |
538 | If SPEC does not specify a version number, return the preferred newest | |
066eeae1 LC |
539 | version; if SPEC does not specify an output, return OUTPUT. |
540 | ||
541 | When OUTPUT is false and SPEC does not specify any output, return #f as the | |
542 | output." | |
635d49f9 LC |
543 | (let ((name version sub-drv |
544 | (package-specification->name+version+output spec output))) | |
fad155d4 ML |
545 | (match (%find-package spec name version) |
546 | (#f | |
547 | (values #f #f)) | |
548 | (package | |
066eeae1 LC |
549 | (if (or (and (not output) (not sub-drv)) |
550 | (member sub-drv (package-outputs package))) | |
fad155d4 | 551 | (values package sub-drv) |
69daee23 | 552 | (leave (G_ "package `~a' lacks output `~a'~%") |
fad155d4 ML |
553 | (package-full-name package) |
554 | sub-drv)))))) | |
c08ea55e | 555 | |
7041fe06 AM |
556 | (define (specifications->packages specs) |
557 | "Given SPECS, a list of specifications such as \"emacs@25.2\" or | |
558 | \"guile:debug\", return a list of package/output tuples." | |
559 | ;; This procedure exists so users of 'guix home' don't have to write out the | |
560 | ;; (map (compose list specification->package+output)... boilerplate. | |
561 | (map (compose list specification->package+output) specs)) | |
562 | ||
c08ea55e LC |
563 | (define (specifications->manifest specs) |
564 | "Given SPECS, a list of specifications such as \"emacs@25.2\" or | |
565 | \"guile:debug\", return a profile manifest." | |
566 | ;; This procedure exists mostly so users of 'guix package -m' don't have to | |
567 | ;; fiddle with multiple-value returns. | |
568 | (packages->manifest | |
7041fe06 | 569 | (specifications->packages specs))) |
f54f2aa9 LC |
570 | |
571 | (define (package-unique-version-prefix name version) | |
572 | "Search among all the versions of package NAME that are available, and | |
573 | return the shortest unambiguous version prefix to designate VERSION. If only | |
574 | one version of the package is available, return the empty string." | |
575 | (match (map package-version (find-packages-by-name name)) | |
576 | ((_) | |
577 | ;; A single version of NAME is available, so do not specify the version | |
578 | ;; number, even if the available version doesn't match VERSION. | |
579 | "") | |
580 | (versions | |
581 | ;; If VERSION is the latest version, don't specify any version. | |
582 | ;; Otherwise return the shortest unique version prefix. Note that this | |
583 | ;; is based on the currently available packages so the result may vary | |
584 | ;; over time. | |
585 | (if (every (cut version>? version <>) | |
586 | (delete version versions)) | |
587 | "" | |
588 | (version-unique-prefix version versions))))) |