1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
|
;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*-
;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of Guix.
;;;
;;; Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix packages)
#:use-module (guix utils)
#:use-module (guix store)
#:use-module (guix build-system)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:export (location
location?
location-file
location-line
location-column
source
package-source?
package-source-uri
package-source-method
package-source-sha256
package-source-file-name
package
package?
package-name
package-version
package-source
package-build-system
package-arguments
package-inputs
package-native-inputs
package-propagated-inputs
package-outputs
package-search-paths
package-description
package-long-description
package-license
package-platforms
package-maintainers
package-properties
package-location
package-source-derivation
package-derivation
package-cross-derivation))
;;; Commentary:
;;;
;;; This module provides a high-level mechanism to define packages in a
;;; Guix-based distribution.
;;;
;;; Code:
;; A source location.
(define-record-type <location>
(make-location file line column)
location?
(file location-file) ; file name
(line location-line) ; 1-indexed line
(column location-column)) ; 0-indexed column
(define location
(memoize
(lambda (file line column)
"Return the <location> object for the given FILE, LINE, and COLUMN."
(and line column file
(make-location file line column)))))
(define (source-properties->location loc)
"Return a location object based on the info in LOC, an alist as returned
by Guile's `source-properties', `frame-source', `current-source-location',
etc."
(let ((file (assq-ref loc 'filename))
(line (assq-ref loc 'line))
(col (assq-ref loc 'column)))
(location file (and line (+ line 1)) col)))
;; The source of a package, such as a tarball URL and fetcher.
(define-record-type* <package-source>
source make-package-source
package-source?
(uri package-source-uri) ; string
(method package-source-method) ; symbol
(sha256 package-source-sha256) ; bytevector
(file-name package-source-file-name ; optional file name
(default #f)))
;; A package.
(define-record-type* <package>
package make-package
package?
(name package-name) ; string
(version package-version) ; string
(source package-source) ; <package-source> instance
(build-system package-build-system) ; build system
(arguments package-arguments ; arguments for the build method
(default '()))
(inputs package-inputs ; input packages or derivations
(default '()))
(propagated-inputs package-propagated-inputs ; same, but propagated
(default '()))
(native-inputs package-native-inputs ; native input packages/derivations
(default '()))
(outputs package-outputs ; list of strings
(default '("out")))
(search-paths package-search-paths ; list of (ENV-VAR (DIRS ...))
(default '())) ; tuples; see
; `set-path-environment-variable'
; (aka. "setup-hook")
(description package-description) ; one-line description
(long-description package-long-description) ; one or two paragraphs
(license package-license (default '()))
(home-page package-home-page)
(platforms package-platforms (default '()))
(maintainers package-maintainers (default '()))
(properties package-properties (default '())) ; alist for anything else
(location package-location
(default (and=> (current-source-location)
source-properties->location))))
(define (package-source-derivation store source)
"Return the derivation path for SOURCE, a package source."
(match source
(($ <package-source> uri method sha256 name)
(method store uri 'sha256 sha256 name))))
(define* (package-derivation store package
#:optional (system (%current-system)))
"Return the derivation of PACKAGE for SYSTEM."
(match package
(($ <package> name version source (= build-system-builder builder)
args inputs native-inputs propagated-inputs outputs)
;; TODO: For `search-paths', add a builder prologue that calls
;; `set-path-environment-variable'.
(let ((inputs (map (match-lambda
(((? string? name) (and package ($ <package>)))
(list name (package-derivation store package)))
(((? string? name) (and package ($ <package>))
(? string? sub-drv))
(list name (package-derivation store package)
sub-drv))
(((? string? name)
(and (? string?) (? derivation-path?) drv))
(list name drv)))
(concatenate (list native-inputs inputs
propagated-inputs)))))
(apply builder
store (string-append name "-" version)
(package-source-derivation store source)
inputs
#:outputs outputs #:system system
args)))))
(define* (package-cross-derivation store package)
;; TODO
#f)
|