utils: Fix column number returned by `source-properties->location'.
[jackhill/guix/guix.git] / guix / packages.scm
CommitLineData
233e7676 1;;; GNU Guix --- Functional package management for GNU
aba326f7 2;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
e3ce5d70 3;;;
233e7676 4;;; This file is part of GNU Guix.
e3ce5d70 5;;;
233e7676 6;;; GNU Guix is free software; you can redistribute it and/or modify it
e3ce5d70
LC
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;;;
233e7676 11;;; GNU Guix is distributed in the hope that it will be useful, but
e3ce5d70
LC
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
233e7676 17;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
e3ce5d70
LC
18
19(define-module (guix packages)
20 #:use-module (guix utils)
21 #:use-module (guix store)
ddc29a78 22 #:use-module (guix base32)
d510ab46 23 #:use-module (guix derivations)
e3ce5d70
LC
24 #:use-module (guix build-system)
25 #:use-module (ice-9 match)
062c6927 26 #:use-module (srfi srfi-1)
946b72c9 27 #:use-module (srfi srfi-9 gnu)
d510ab46 28 #:use-module (srfi srfi-11)
d36622dc
LC
29 #:use-module (srfi srfi-34)
30 #:use-module (srfi srfi-35)
d66c7096
LC
31 #:use-module ((ice-9 rdelim) #:select (read-line))
32 #:use-module (ice-9 regex)
cab24961 33 #:re-export (%current-system)
ff352cfb 34 #:export (origin
90c68be8
LC
35 origin?
36 origin-uri
37 origin-method
38 origin-sha256
39 origin-file-name
e4c245f8 40 base32
e3ce5d70
LC
41
42 package
43 package?
44 package-name
45 package-version
2847050a 46 package-full-name
e3ce5d70
LC
47 package-source
48 package-build-system
49 package-arguments
50 package-inputs
51 package-native-inputs
062c6927 52 package-propagated-inputs
e3ce5d70
LC
53 package-outputs
54 package-search-paths
d45122f5 55 package-synopsis
e3ce5d70 56 package-description
e3ce5d70 57 package-license
52bda18a 58 package-home-page
e3ce5d70
LC
59 package-platforms
60 package-maintainers
062c6927 61 package-properties
35f3c5f5 62 package-location
d66c7096 63 package-field-location
e3ce5d70 64
a3d73f59 65 package-transitive-inputs
113aef68 66 package-transitive-propagated-inputs
e3ce5d70
LC
67 package-source-derivation
68 package-derivation
d36622dc 69 package-cross-derivation
d510ab46 70 package-output
d36622dc
LC
71
72 &package-error
07783858 73 package-error?
d36622dc
LC
74 package-error-package
75 &package-input-error
07783858 76 package-input-error?
d36622dc 77 package-error-invalid-input))
e3ce5d70
LC
78
79;;; Commentary:
80;;;
81;;; This module provides a high-level mechanism to define packages in a
82;;; Guix-based distribution.
83;;;
84;;; Code:
85
90c68be8
LC
86;; The source of a package, such as a tarball URL and fetcher---called
87;; "origin" to avoid name clash with `package-source', `source', etc.
88(define-record-type* <origin>
89 origin make-origin
90 origin?
91 (uri origin-uri) ; string
92 (method origin-method) ; symbol
93 (sha256 origin-sha256) ; bytevector
94 (file-name origin-file-name (default #f))) ; optional file name
e3ce5d70 95
e4c245f8
LC
96(define-syntax base32
97 (lambda (s)
98 "Return the bytevector corresponding to the given Nix-base32
99representation."
100 (syntax-case s ()
101 ((_ str)
102 (string? (syntax->datum #'str))
aba326f7 103 ;; A literal string: do the conversion at expansion time.
e4c245f8
LC
104 (with-syntax ((bv (nix-base32-string->bytevector
105 (syntax->datum #'str))))
aba326f7
LC
106 #''bv))
107 ((_ str)
108 #'(nix-base32-string->bytevector str)))))
e4c245f8 109
35f3c5f5 110;; A package.
d36622dc 111
e3ce5d70
LC
112(define-record-type* <package>
113 package make-package
114 package?
115 (name package-name) ; string
116 (version package-version) ; string
90c68be8 117 (source package-source) ; <origin> instance
e3ce5d70 118 (build-system package-build-system) ; build system
64fddd74 119 (arguments package-arguments ; arguments for the build method
21c203a5 120 (default '()) (thunked))
062c6927 121
e3ce5d70 122 (inputs package-inputs ; input packages or derivations
dd6b9a37 123 (default '()) (thunked))
062c6927
LC
124 (propagated-inputs package-propagated-inputs ; same, but propagated
125 (default '()))
e3ce5d70
LC
126 (native-inputs package-native-inputs ; native input packages/derivations
127 (default '()))
c9d01150
LC
128 (self-native-input? package-self-native-input? ; whether to use itself as
129 ; a native input when cross-
130 (default #f)) ; compiling
062c6927 131
e3ce5d70
LC
132 (outputs package-outputs ; list of strings
133 (default '("out")))
134 (search-paths package-search-paths ; list of (ENV-VAR (DIRS ...))
135 (default '())) ; tuples; see
136 ; `set-path-environment-variable'
137 ; (aka. "setup-hook")
138
d45122f5
LC
139 (synopsis package-synopsis) ; one-line description
140 (description package-description) ; one or two paragraphs
1fb78cb2 141 (license package-license)
45753b65 142 (home-page package-home-page)
e3ce5d70 143 (platforms package-platforms (default '()))
35f3c5f5 144 (maintainers package-maintainers (default '()))
45753b65 145
062c6927
LC
146 (properties package-properties (default '())) ; alist for anything else
147
35f3c5f5
LC
148 (location package-location
149 (default (and=> (current-source-location)
150 source-properties->location))))
e3ce5d70 151
946b72c9
LC
152(set-record-type-printer! <package>
153 (lambda (package port)
154 (let ((loc (package-location package))
155 (format simple-format))
156 (format port "#<package ~a-~a ~a:~a ~a>"
157 (package-name package)
158 (package-version package)
159 (location-file loc)
160 (location-line loc)
161 (number->string (object-address
162 package)
163 16)))))
164
d66c7096
LC
165(define (package-field-location package field)
166 "Return an estimate of the source code location of the definition of FIELD
167for PACKAGE."
168 (define field-rx
169 (make-regexp (string-append "\\("
170 (regexp-quote (symbol->string field))
171 "[[:blank:]]*")))
172 (define (seek-to-line port line)
173 (let ((line (- line 1)))
174 (let loop ()
175 (when (< (port-line port) line)
176 (unless (eof-object? (read-line port))
177 (loop))))))
178
179 (define (find-line port)
180 (let loop ((line (read-line port)))
181 (cond ((eof-object? line)
182 (values #f #f))
183 ((regexp-exec field-rx line)
184 =>
185 (lambda (match)
186 ;; At this point `port-line' points to the next line, so need
187 ;; need to add one.
188 (values (port-line port)
189 (match:end match))))
190 (else
191 (loop (read-line port))))))
192
193 (match (package-location package)
194 (($ <location> file line column)
195 (catch 'system
196 (lambda ()
197 (call-with-input-file (search-path %load-path file)
198 (lambda (port)
199 (seek-to-line port line)
200 (let-values (((line column)
201 (find-line port)))
202 (if (and line column)
203 (location file line column)
204 (package-location package))))))
205 (lambda _
206 (package-location package))))
207 (_ #f)))
208
d36622dc
LC
209
210;; Error conditions.
211
212(define-condition-type &package-error &error
213 package-error?
214 (package package-error-package))
215
216(define-condition-type &package-input-error &package-error
217 package-input-error?
218 (input package-error-invalid-input))
219
220
2847050a
LC
221(define (package-full-name package)
222 "Return the full name of PACKAGE--i.e., `NAME-VERSION'."
223 (string-append (package-name package) "-" (package-version package)))
224
b642e4b8
LC
225(define* (package-source-derivation store source
226 #:optional (system (%current-system)))
227 "Return the derivation path for SOURCE, a package source, for SYSTEM."
e3ce5d70 228 (match source
90c68be8 229 (($ <origin> uri method sha256 name)
b642e4b8
LC
230 (method store uri 'sha256 sha256 name
231 #:system system))))
e3ce5d70 232
113aef68
LC
233(define (transitive-inputs inputs)
234 (let loop ((inputs inputs)
a3d73f59
LC
235 (result '()))
236 (match inputs
237 (()
238 (delete-duplicates (reverse result))) ; XXX: efficiency
239 (((and i (name (? package? p) sub ...)) rest ...)
240 (let ((t (map (match-lambda
241 ((dep-name derivation ...)
242 (cons (string-append name "/" dep-name)
243 derivation)))
244 (package-propagated-inputs p))))
245 (loop (append t rest)
246 (append t (cons i result)))))
247 ((input rest ...)
248 (loop rest (cons input result))))))
249
113aef68
LC
250(define (package-transitive-inputs package)
251 "Return the transitive inputs of PACKAGE---i.e., its direct inputs along
252with their propagated inputs, recursively."
253 (transitive-inputs (append (package-native-inputs package)
254 (package-inputs package)
255 (package-propagated-inputs package))))
256
257(define (package-transitive-propagated-inputs package)
258 "Return the propagated inputs of PACKAGE, and their propagated inputs,
259recursively."
260 (transitive-inputs (package-propagated-inputs package)))
261
a2ebaddd
LC
262\f
263;;;
264;;; Package derivations.
265;;;
266
267(define %derivation-cache
268 ;; Package to derivation-path mapping.
e4588af9 269 (make-weak-key-hash-table 100))
a2ebaddd 270
e509d152
LC
271(define (cache package system thunk)
272 "Memoize the return values of THUNK as the derivation of PACKAGE on
273SYSTEM."
274 (let ((vals (call-with-values thunk list)))
275 ;; Use `hashq-set!' instead of `hash-set!' because `hash' returns the
276 ;; same value for all structs (as of Guile 2.0.6), and because pointer
277 ;; equality is sufficient in practice.
278 (hashq-set! %derivation-cache package `((,system ,@vals)))
279 (apply values vals)))
280
281(define-syntax-rule (cached package system body ...)
282 "Memoize the result of BODY for the arguments PACKAGE and SYSTEM.
283Return the cached result when available."
284 (let ((thunk (lambda () body ...)))
285 (match (hashq-ref %derivation-cache package)
286 ((alist (... ...))
287 (match (assoc-ref alist system)
288 ((vals (... ...))
289 (apply values vals))
290 (#f
291 (cache package system thunk))))
292 (#f
293 (cache package system thunk)))))
a2ebaddd 294
e3ce5d70
LC
295(define* (package-derivation store package
296 #:optional (system (%current-system)))
e509d152
LC
297 "Return the derivation path and corresponding <derivation> object of
298PACKAGE for SYSTEM."
592ef6c8
LC
299 (define (intern file)
300 ;; Add FILE to the store. Set the `recursive?' bit to #t, so that
301 ;; file permissions are preserved.
a9ebd9ef 302 (add-to-store store (basename file) #t "sha256" file))
592ef6c8
LC
303
304 (define expand-input
305 ;; Expand the given input tuple such that it contains only
306 ;; references to derivation paths or store paths.
307 (match-lambda
308 (((? string? name) (? package? package))
b642e4b8 309 (list name (package-derivation store package system)))
592ef6c8
LC
310 (((? string? name) (? package? package)
311 (? string? sub-drv))
b642e4b8 312 (list name (package-derivation store package system)
592ef6c8
LC
313 sub-drv))
314 (((? string? name)
315 (and (? string?) (? derivation-path?) drv))
316 (list name drv))
317 (((? string? name)
318 (and (? string?) (? file-exists? file)))
319 ;; Add FILE to the store. When FILE is in the sub-directory of a
320 ;; store path, it needs to be added anyway, so it can be used as a
321 ;; source.
322 (list name (intern file)))
323 (((? string? name) (? origin? source))
b642e4b8 324 (list name (package-source-derivation store source system)))
592ef6c8
LC
325 (x
326 (raise (condition (&package-input-error
327 (package package)
328 (input x)))))))
329
e509d152
LC
330 ;; Compute the derivation and cache the result. Caching is important
331 ;; because some derivations, such as the implicit inputs of the GNU build
332 ;; system, will be queried many, many times in a row.
333 (cached package system
21c203a5
LC
334
335 ;; Bind %CURRENT-SYSTEM so that thunked field values can refer
336 ;; to it.
337 (parameterize ((%current-system system))
338 (match package
339 (($ <package> name version source (= build-system-builder builder)
340 args inputs propagated-inputs native-inputs self-native-input?
341 outputs)
342 ;; TODO: For `search-paths', add a builder prologue that calls
343 ;; `set-path-environment-variable'.
344 (let ((inputs (map expand-input
345 (package-transitive-inputs package))))
346
347 (apply builder
348 store (package-full-name package)
349 (and source
350 (package-source-derivation store source system))
351 inputs
352 #:outputs outputs #:system system
353 (args))))))))
e3ce5d70
LC
354
355(define* (package-cross-derivation store package)
356 ;; TODO
357 #f)
d510ab46
LC
358
359(define* (package-output store package output
360 #:optional (system (%current-system)))
361 "Return the output path of PACKAGE's OUTPUT for SYSTEM---where OUTPUT is the
362symbolic output name, such as \"out\". Note that this procedure calls
363`package-derivation', which is costly."
364 (let-values (((_ drv)
365 (package-derivation store package system)))
366 (derivation-output-path
367 (assoc-ref (derivation-outputs drv) output))))