Commit | Line | Data |
---|---|---|
e3ce5d70 LC |
1 | ;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*- |
2 | ;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org> | |
3 | ;;; | |
4 | ;;; This file is part of Guix. | |
5 | ;;; | |
6 | ;;; 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 | ;;; 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 Guix. If not, see <http://www.gnu.org/licenses/>. | |
18 | ||
19 | (define-module (guix packages) | |
20 | #:use-module (guix utils) | |
21 | #:use-module (guix store) | |
22 | #:use-module (guix build-system) | |
23 | #:use-module (ice-9 match) | |
062c6927 | 24 | #:use-module (srfi srfi-1) |
35f3c5f5 LC |
25 | #:use-module (srfi srfi-9) |
26 | #:export (location | |
27 | location? | |
28 | location-file | |
29 | location-line | |
30 | location-column | |
31 | ||
90c68be8 LC |
32 | origin |
33 | origin? | |
34 | origin-uri | |
35 | origin-method | |
36 | origin-sha256 | |
37 | origin-file-name | |
e4c245f8 | 38 | base32 |
e3ce5d70 LC |
39 | |
40 | package | |
41 | package? | |
42 | package-name | |
43 | package-version | |
44 | package-source | |
45 | package-build-system | |
46 | package-arguments | |
47 | package-inputs | |
48 | package-native-inputs | |
062c6927 | 49 | package-propagated-inputs |
e3ce5d70 LC |
50 | package-outputs |
51 | package-search-paths | |
52 | package-description | |
53 | package-long-description | |
54 | package-license | |
55 | package-platforms | |
56 | package-maintainers | |
062c6927 | 57 | package-properties |
35f3c5f5 | 58 | package-location |
e3ce5d70 LC |
59 | |
60 | package-source-derivation | |
61 | package-derivation | |
62 | package-cross-derivation)) | |
63 | ||
64 | ;;; Commentary: | |
65 | ;;; | |
66 | ;;; This module provides a high-level mechanism to define packages in a | |
67 | ;;; Guix-based distribution. | |
68 | ;;; | |
69 | ;;; Code: | |
70 | ||
35f3c5f5 LC |
71 | ;; A source location. |
72 | (define-record-type <location> | |
73 | (make-location file line column) | |
74 | location? | |
75 | (file location-file) ; file name | |
76 | (line location-line) ; 1-indexed line | |
77 | (column location-column)) ; 0-indexed column | |
78 | ||
79 | (define location | |
80 | (memoize | |
81 | (lambda (file line column) | |
82 | "Return the <location> object for the given FILE, LINE, and COLUMN." | |
83 | (and line column file | |
84 | (make-location file line column))))) | |
85 | ||
86 | (define (source-properties->location loc) | |
87 | "Return a location object based on the info in LOC, an alist as returned | |
88 | by Guile's `source-properties', `frame-source', `current-source-location', | |
89 | etc." | |
90 | (let ((file (assq-ref loc 'filename)) | |
91 | (line (assq-ref loc 'line)) | |
92 | (col (assq-ref loc 'column))) | |
93 | (location file (and line (+ line 1)) col))) | |
94 | ||
95 | ||
90c68be8 LC |
96 | ;; The source of a package, such as a tarball URL and fetcher---called |
97 | ;; "origin" to avoid name clash with `package-source', `source', etc. | |
98 | (define-record-type* <origin> | |
99 | origin make-origin | |
100 | origin? | |
101 | (uri origin-uri) ; string | |
102 | (method origin-method) ; symbol | |
103 | (sha256 origin-sha256) ; bytevector | |
104 | (file-name origin-file-name (default #f))) ; optional file name | |
e3ce5d70 | 105 | |
e4c245f8 LC |
106 | (define-syntax base32 |
107 | (lambda (s) | |
108 | "Return the bytevector corresponding to the given Nix-base32 | |
109 | representation." | |
110 | (syntax-case s () | |
111 | ((_ str) | |
112 | (string? (syntax->datum #'str)) | |
113 | (with-syntax ((bv (nix-base32-string->bytevector | |
114 | (syntax->datum #'str)))) | |
115 | #''bv))))) | |
116 | ||
35f3c5f5 | 117 | ;; A package. |
e3ce5d70 LC |
118 | (define-record-type* <package> |
119 | package make-package | |
120 | package? | |
121 | (name package-name) ; string | |
122 | (version package-version) ; string | |
90c68be8 | 123 | (source package-source) ; <origin> instance |
e3ce5d70 | 124 | (build-system package-build-system) ; build system |
64fddd74 LC |
125 | (arguments package-arguments ; arguments for the build method |
126 | (default '())) | |
062c6927 | 127 | |
e3ce5d70 LC |
128 | (inputs package-inputs ; input packages or derivations |
129 | (default '())) | |
062c6927 LC |
130 | (propagated-inputs package-propagated-inputs ; same, but propagated |
131 | (default '())) | |
e3ce5d70 LC |
132 | (native-inputs package-native-inputs ; native input packages/derivations |
133 | (default '())) | |
c9d01150 LC |
134 | (self-native-input? package-self-native-input? ; whether to use itself as |
135 | ; a native input when cross- | |
136 | (default #f)) ; compiling | |
062c6927 | 137 | |
e3ce5d70 LC |
138 | (outputs package-outputs ; list of strings |
139 | (default '("out"))) | |
140 | (search-paths package-search-paths ; list of (ENV-VAR (DIRS ...)) | |
141 | (default '())) ; tuples; see | |
142 | ; `set-path-environment-variable' | |
143 | ; (aka. "setup-hook") | |
144 | ||
145 | (description package-description) ; one-line description | |
146 | (long-description package-long-description) ; one or two paragraphs | |
147 | (license package-license (default '())) | |
45753b65 | 148 | (home-page package-home-page) |
e3ce5d70 | 149 | (platforms package-platforms (default '())) |
35f3c5f5 | 150 | (maintainers package-maintainers (default '())) |
45753b65 | 151 | |
062c6927 LC |
152 | (properties package-properties (default '())) ; alist for anything else |
153 | ||
35f3c5f5 LC |
154 | (location package-location |
155 | (default (and=> (current-source-location) | |
156 | source-properties->location)))) | |
e3ce5d70 LC |
157 | |
158 | (define (package-source-derivation store source) | |
159 | "Return the derivation path for SOURCE, a package source." | |
160 | (match source | |
90c68be8 | 161 | (($ <origin> uri method sha256 name) |
e3ce5d70 LC |
162 | (method store uri 'sha256 sha256 name)))) |
163 | ||
164 | (define* (package-derivation store package | |
165 | #:optional (system (%current-system))) | |
166 | "Return the derivation of PACKAGE for SYSTEM." | |
167 | (match package | |
168 | (($ <package> name version source (= build-system-builder builder) | |
c9d01150 LC |
169 | args inputs propagated-inputs native-inputs self-native-input? |
170 | outputs) | |
e3ce5d70 LC |
171 | ;; TODO: For `search-paths', add a builder prologue that calls |
172 | ;; `set-path-environment-variable'. | |
173 | (let ((inputs (map (match-lambda | |
174 | (((? string? name) (and package ($ <package>))) | |
175 | (list name (package-derivation store package))) | |
176 | (((? string? name) (and package ($ <package>)) | |
177 | (? string? sub-drv)) | |
178 | (list name (package-derivation store package) | |
179 | sub-drv)) | |
180 | (((? string? name) | |
181 | (and (? string?) (? derivation-path?) drv)) | |
e67ac6e6 LC |
182 | (list name drv)) |
183 | (((? string? name) | |
184 | (and (? string?) (? (negate store-path?)) | |
185 | (? file-exists? file))) | |
186 | (list name | |
187 | (add-to-store store (basename file) | |
188 | #t #f "sha256" file)))) | |
062c6927 LC |
189 | (concatenate (list native-inputs inputs |
190 | propagated-inputs))))) | |
e3ce5d70 LC |
191 | (apply builder |
192 | store (string-append name "-" version) | |
193 | (package-source-derivation store source) | |
194 | inputs | |
195 | #:outputs outputs #:system system | |
03671375 LC |
196 | (if (procedure? args) |
197 | (args system) | |
198 | args)))))) | |
e3ce5d70 LC |
199 | |
200 | (define* (package-cross-derivation store package) | |
201 | ;; TODO | |
202 | #f) |