Commit | Line | Data |
---|---|---|
233e7676 | 1 | ;;; GNU Guix --- Functional package management for GNU |
3c0128b0 | 2 | ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 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> |
6b1891b0 | 7 | ;;; |
233e7676 | 8 | ;;; This file is part of GNU Guix. |
6b1891b0 | 9 | ;;; |
233e7676 | 10 | ;;; GNU Guix is free software; you can redistribute it and/or modify it |
6b1891b0 LC |
11 | ;;; under the terms of the GNU General Public License as published by |
12 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
13 | ;;; your option) any later version. | |
14 | ;;; | |
233e7676 | 15 | ;;; GNU Guix is distributed in the hope that it will be useful, but |
6b1891b0 LC |
16 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of |
17 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;;; GNU General Public License for more details. | |
19 | ;;; | |
20 | ;;; You should have received a copy of the GNU General Public License | |
233e7676 | 21 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. |
6b1891b0 | 22 | |
59a43334 | 23 | (define-module (gnu packages) |
6b1891b0 | 24 | #:use-module (guix packages) |
98eb8cbe | 25 | #:use-module (guix ui) |
800cdeef | 26 | #:use-module (guix utils) |
cd903ef7 | 27 | #:use-module (guix discovery) |
f9704f17 | 28 | #:use-module (guix memoization) |
95cd4971 LC |
29 | #:use-module ((guix build utils) |
30 | #:select ((package-name->name+version | |
31 | . hyphen-separated-name->name+version))) | |
c08ea55e | 32 | #:autoload (guix profiles) (packages->manifest) |
fe634eaf | 33 | #:use-module (guix describe) |
c2868b1e | 34 | #:use-module (ice-9 vlist) |
dc5669cd | 35 | #:use-module (ice-9 match) |
6b1891b0 | 36 | #:use-module (srfi srfi-1) |
5e3b388b | 37 | #:use-module (srfi srfi-11) |
6b1891b0 | 38 | #:use-module (srfi srfi-26) |
dbab5150 LC |
39 | #:use-module (srfi srfi-34) |
40 | #:use-module (srfi srfi-35) | |
800cdeef LC |
41 | #:use-module (srfi srfi-39) |
42 | #:export (search-patch | |
25897079 | 43 | search-patches |
96eaa55f | 44 | search-auxiliary-file |
ac5aa288 | 45 | search-bootstrap-binary |
0492f4a2 | 46 | %patch-path |
96eaa55f | 47 | %auxiliary-files-path |
0b3651bc | 48 | %bootstrap-binaries-path |
c107b541 | 49 | %package-module-path |
fe634eaf | 50 | %default-package-module-path |
7d193ec3 | 51 | |
ba326ce4 | 52 | fold-packages |
7d193ec3 | 53 | |
dc5669cd | 54 | find-packages-by-name |
3f26bfc1 | 55 | find-best-packages-by-name |
7d193ec3 EB |
56 | find-newest-available-packages |
57 | ||
84189ebc | 58 | specification->package |
c08ea55e LC |
59 | specification->package+output |
60 | specifications->manifest)) | |
6b1891b0 LC |
61 | |
62 | ;;; Commentary: | |
63 | ;;; | |
64 | ;;; General utilities for the software distribution---i.e., the modules under | |
59a43334 | 65 | ;;; (gnu packages ...). |
6b1891b0 LC |
66 | ;;; |
67 | ;;; Code: | |
68 | ||
96eaa55f AK |
69 | ;; By default, we store patches, auxiliary files and bootstrap binaries |
70 | ;; alongside Guile modules. This is so that these extra files can be | |
71 | ;; found without requiring a special setup, such as a specific | |
72 | ;; installation directory and an extra environment variable. One | |
73 | ;; advantage of this setup is that everything just works in an | |
74 | ;; auto-compilation setting. | |
a9f60c42 | 75 | |
a9f60c42 | 76 | (define %bootstrap-binaries-path |
ac5aa288 | 77 | (make-parameter |
1ffa7090 | 78 | (map (cut string-append <> "/gnu/packages/bootstrap") |
0b3651bc | 79 | %load-path))) |
ac5aa288 | 80 | |
96eaa55f AK |
81 | (define %auxiliary-files-path |
82 | (make-parameter | |
83 | (map (cut string-append <> "/gnu/packages/aux-files") | |
84 | %load-path))) | |
85 | ||
86 | (define (search-auxiliary-file file-name) | |
87 | "Search the auxiliary FILE-NAME. Return #f if not found." | |
88 | (search-path (%auxiliary-files-path) file-name)) | |
89 | ||
800cdeef | 90 | (define (search-patch file-name) |
dbab5150 LC |
91 | "Search the patch FILE-NAME. Raise an error if not found." |
92 | (or (search-path (%patch-path) file-name) | |
93 | (raise (condition | |
69daee23 | 94 | (&message (message (format #f (G_ "~a: patch not found") |
dbab5150 | 95 | file-name))))))) |
800cdeef | 96 | |
25897079 AK |
97 | (define-syntax-rule (search-patches file-name ...) |
98 | "Return the list of absolute file names corresponding to each | |
99 | FILE-NAME found in %PATCH-PATH." | |
100 | (list (search-patch file-name) ...)) | |
101 | ||
ac5aa288 | 102 | (define (search-bootstrap-binary file-name system) |
dfba5489 LC |
103 | "Search the bootstrap binary FILE-NAME for SYSTEM. Raise an error if not |
104 | found." | |
105 | (or (search-path (%bootstrap-binaries-path) | |
106 | (string-append system "/" file-name)) | |
107 | (raise (condition | |
108 | (&message | |
109 | (message | |
69daee23 | 110 | (format #f (G_ "could not find bootstrap binary '~a' \ |
dfba5489 LC |
111 | for system '~a'") |
112 | file-name system))))))) | |
ac5aa288 | 113 | |
84836a57 | 114 | (define %distro-root-directory |
eaae07ec LC |
115 | ;; Absolute file name of the module hierarchy. Since (gnu packages …) might |
116 | ;; live in a directory different from (guix), try to get the best match. | |
117 | (letrec-syntax ((dirname* (syntax-rules () | |
118 | ((_ file) | |
119 | (dirname file)) | |
120 | ((_ file head tail ...) | |
121 | (dirname (dirname* file tail ...))))) | |
122 | (try (syntax-rules () | |
123 | ((_ (file things ...) rest ...) | |
124 | (match (search-path %load-path file) | |
125 | (#f | |
126 | (try rest ...)) | |
127 | (absolute | |
128 | (dirname* absolute things ...)))) | |
129 | ((_) | |
130 | #f)))) | |
131 | (try ("gnu/packages/base.scm" gnu/ packages/) | |
132 | ("gnu/packages.scm" gnu/) | |
133 | ("guix.scm")))) | |
6b1891b0 | 134 | |
fe634eaf LC |
135 | (define %default-package-module-path |
136 | ;; Default search path for package modules. | |
137 | `((,%distro-root-directory . "gnu/packages"))) | |
138 | ||
c107b541 LC |
139 | (define %package-module-path |
140 | ;; Search path for package modules. Each item must be either a directory | |
141 | ;; name or a pair whose car is a directory and whose cdr is a sub-directory | |
142 | ;; to narrow the search. | |
8689901f LC |
143 | (let* ((not-colon (char-set-complement (char-set #\:))) |
144 | (environment (string-tokenize (or (getenv "GUIX_PACKAGE_PATH") "") | |
fe634eaf LC |
145 | not-colon)) |
146 | (channels (package-path-entries))) | |
147 | ;; Automatically add channels and items from $GUIX_PACKAGE_PATH to Guile's | |
148 | ;; search path. For historical reasons, $GUIX_PACKAGE_PATH goes to the | |
149 | ;; front; channels go to the back so that they don't override Guix' own | |
150 | ;; modules. | |
151 | (set! %load-path | |
152 | (append environment %load-path channels)) | |
153 | (set! %load-compiled-path | |
154 | (append environment %load-compiled-path channels)) | |
8689901f LC |
155 | |
156 | (make-parameter | |
fe634eaf LC |
157 | (append environment |
158 | %default-package-module-path | |
159 | channels)))) | |
c107b541 | 160 | |
ee06af5b LC |
161 | (define %patch-path |
162 | ;; Define it after '%package-module-path' so that '%load-path' contains user | |
163 | ;; directories, allowing patches in $GUIX_PACKAGE_PATH to be found. | |
164 | (make-parameter | |
165 | (map (lambda (directory) | |
166 | (if (string=? directory %distro-root-directory) | |
167 | (string-append directory "/gnu/packages/patches") | |
168 | directory)) | |
169 | %load-path))) | |
170 | ||
5c5ae46c LC |
171 | (define* (fold-packages proc init |
172 | #:optional | |
3c0128b0 LC |
173 | (modules (all-modules (%package-module-path) |
174 | #:warn | |
175 | warn-about-load-error)) | |
96dc8f35 | 176 | #:key (select? (negate hidden-package?))) |
5c5ae46c | 177 | "Call (PROC PACKAGE RESULT) for each available package defined in one of |
96dc8f35 LC |
178 | MODULES that matches SELECT?, using INIT as the initial value of RESULT. It |
179 | is guaranteed to never traverse the same package twice." | |
cd903ef7 | 180 | (fold-module-public-variables (lambda (object result) |
96dc8f35 | 181 | (if (and (package? object) (select? object)) |
cd903ef7 LC |
182 | (proc object result) |
183 | result)) | |
184 | init | |
5c5ae46c | 185 | modules)) |
ba326ce4 | 186 | |
9ffc1c00 LC |
187 | (define find-packages-by-name |
188 | (let ((packages (delay | |
189 | (fold-packages (lambda (p r) | |
190 | (vhash-cons (package-name p) p r)) | |
724311a2 LC |
191 | vlist-null))) |
192 | (version>? (lambda (p1 p2) | |
193 | (version>? (package-version p1) (package-version p2))))) | |
9ffc1c00 LC |
194 | (lambda* (name #:optional version) |
195 | "Return the list of packages with the given NAME. If VERSION is not #f, | |
724311a2 LC |
196 | then only return packages whose version is prefixed by VERSION, sorted in |
197 | decreasing version order." | |
198 | (let ((matching (sort (vhash-fold* cons '() name (force packages)) | |
199 | version>?))) | |
9ffc1c00 LC |
200 | (if version |
201 | (filter (lambda (package) | |
348987d3 | 202 | (version-prefix? version (package-version package))) |
9ffc1c00 LC |
203 | matching) |
204 | matching))))) | |
dc5669cd | 205 | |
3f26bfc1 | 206 | (define find-newest-available-packages |
55b2d921 LC |
207 | (mlambda () |
208 | "Return a vhash keyed by package names, and with | |
dc5669cd MW |
209 | associated values of the form |
210 | ||
211 | (newest-version newest-package ...) | |
212 | ||
213 | where the preferred package is listed first." | |
214 | ||
55b2d921 LC |
215 | ;; FIXME: Currently, the preferred package is whichever one |
216 | ;; was found last by 'fold-packages'. Find a better solution. | |
217 | (fold-packages (lambda (p r) | |
218 | (let ((name (package-name p)) | |
219 | (version (package-version p))) | |
220 | (match (vhash-assoc name r) | |
221 | ((_ newest-so-far . pkgs) | |
222 | (case (version-compare version newest-so-far) | |
223 | ((>) (vhash-cons name `(,version ,p) r)) | |
224 | ((=) (vhash-cons name `(,version ,p ,@pkgs) r)) | |
225 | ((<) r))) | |
226 | (#f (vhash-cons name `(,version ,p) r))))) | |
227 | vlist-null))) | |
3f26bfc1 LC |
228 | |
229 | (define (find-best-packages-by-name name version) | |
230 | "If version is #f, return the list of packages named NAME with the highest | |
231 | version numbers; otherwise, return the list of packages named NAME and at | |
232 | VERSION." | |
233 | (if version | |
234 | (find-packages-by-name name version) | |
235 | (match (vhash-assoc name (find-newest-available-packages)) | |
236 | ((_ version pkgs ...) pkgs) | |
237 | (#f '())))) | |
7d193ec3 EB |
238 | |
239 | \f | |
4ea44419 AK |
240 | (define %sigint-prompt |
241 | ;; The prompt to jump to upon SIGINT. | |
242 | (make-prompt-tag "interruptible")) | |
243 | ||
244 | (define (call-with-sigint-handler thunk handler) | |
245 | "Call THUNK and return its value. Upon SIGINT, call HANDLER with the signal | |
246 | number in the context of the continuation of the call to this function, and | |
247 | return its return value." | |
248 | (call-with-prompt %sigint-prompt | |
249 | (lambda () | |
250 | (sigaction SIGINT | |
251 | (lambda (signum) | |
252 | (sigaction SIGINT SIG_DFL) | |
253 | (abort-to-prompt %sigint-prompt signum))) | |
254 | (dynamic-wind | |
255 | (const #t) | |
256 | thunk | |
257 | (cut sigaction SIGINT SIG_DFL))) | |
258 | (lambda (k signum) | |
259 | (handler signum)))) | |
260 | ||
fad155d4 ML |
261 | \f |
262 | ;;; | |
263 | ;;; Package specification. | |
264 | ;;; | |
265 | ||
e30c2be1 | 266 | (define* (%find-package spec name version) |
fad155d4 ML |
267 | (match (find-best-packages-by-name name version) |
268 | ((pkg . pkg*) | |
269 | (unless (null? pkg*) | |
69daee23 LC |
270 | (warning (G_ "ambiguous package specification `~a'~%") spec) |
271 | (warning (G_ "choosing ~a@~a from ~a~%") | |
d75e8f36 | 272 | (package-name pkg) (package-version pkg) |
fad155d4 | 273 | (location->string (package-location pkg)))) |
01afdab8 LC |
274 | (match (package-superseded pkg) |
275 | ((? package? new) | |
69daee23 | 276 | (info (G_ "package '~a' has been superseded by '~a'~%") |
01afdab8 LC |
277 | (package-name pkg) (package-name new)) |
278 | new) | |
279 | (#f | |
280 | pkg))) | |
e465d9e1 | 281 | (x |
fad155d4 | 282 | (if version |
69daee23 LC |
283 | (leave (G_ "~A: package not found for version ~a~%") name version) |
284 | (leave (G_ "~A: unknown package~%") name))))) | |
fad155d4 | 285 | |
5e3b388b CR |
286 | (define (specification->package spec) |
287 | "Return a package matching SPEC. SPEC may be a package name, or a package | |
1b846da8 | 288 | name followed by an at-sign and a version number. If the version number is not |
5e3b388b | 289 | present, return the preferred newest version." |
fad155d4 ML |
290 | (let-values (((name version) (package-name->name+version spec))) |
291 | (%find-package spec name version))) | |
84189ebc LC |
292 | |
293 | (define* (specification->package+output spec #:optional (output "out")) | |
294 | "Return the package and output specified by SPEC, or #f and #f; SPEC may | |
295 | optionally contain a version number and an output name, as in these examples: | |
296 | ||
297 | guile | |
1b846da8 | 298 | guile@2.0.9 |
84189ebc | 299 | guile:debug |
1b846da8 | 300 | guile@2.0.9:debug |
84189ebc LC |
301 | |
302 | If SPEC does not specify a version number, return the preferred newest | |
303 | version; if SPEC does not specify an output, return OUTPUT." | |
84189ebc LC |
304 | (let-values (((name version sub-drv) |
305 | (package-specification->name+version+output spec output))) | |
fad155d4 ML |
306 | (match (%find-package spec name version) |
307 | (#f | |
308 | (values #f #f)) | |
309 | (package | |
310 | (if (member sub-drv (package-outputs package)) | |
311 | (values package sub-drv) | |
69daee23 | 312 | (leave (G_ "package `~a' lacks output `~a'~%") |
fad155d4 ML |
313 | (package-full-name package) |
314 | sub-drv)))))) | |
c08ea55e LC |
315 | |
316 | (define (specifications->manifest specs) | |
317 | "Given SPECS, a list of specifications such as \"emacs@25.2\" or | |
318 | \"guile:debug\", return a profile manifest." | |
319 | ;; This procedure exists mostly so users of 'guix package -m' don't have to | |
320 | ;; fiddle with multiple-value returns. | |
321 | (packages->manifest | |
322 | (map (compose list specification->package+output) specs))) |