Commit | Line | Data |
---|---|---|
b29455cf FB |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> | |
f9ea74ad | 3 | ;;; Copyright © 2016 Eric Bavier <bavier@member.fsf.org> |
47956fa0 | 4 | ;;; Copyright © 2016 ng0 <ng0@n0.is> |
f6078422 | 5 | ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> |
b29455cf FB |
6 | ;;; |
7 | ;;; This file is part of GNU Guix. | |
8 | ;;; | |
9 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
10 | ;;; under the terms of the GNU General Public License as published by | |
11 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
12 | ;;; your option) any later version. | |
13 | ;;; | |
14 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
15 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | ;;; GNU General Public License for more details. | |
18 | ;;; | |
19 | ;;; You should have received a copy of the GNU General Public License | |
20 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
21 | ||
22 | (define-module (guix import hackage) | |
23 | #:use-module (ice-9 match) | |
42efe27a | 24 | #:use-module (ice-9 regex) |
a4824c60 | 25 | #:use-module (srfi srfi-34) |
b29455cf | 26 | #:use-module (srfi srfi-26) |
b29455cf FB |
27 | #:use-module (srfi srfi-11) |
28 | #:use-module (srfi srfi-1) | |
42efe27a | 29 | #:use-module ((guix download) #:select (download-to-store url-fetch)) |
96018e21 FB |
30 | #:use-module ((guix utils) #:select (package-name->name+version |
31 | canonical-newline-port)) | |
2ae9c63f | 32 | #:use-module (guix http-client) |
a9285961 | 33 | #:use-module ((guix import utils) #:select (factorize-uri recursive-import)) |
a4154748 | 34 | #:use-module (guix import cabal) |
b29455cf | 35 | #:use-module (guix store) |
ca719424 | 36 | #:use-module (gcrypt hash) |
b29455cf | 37 | #:use-module (guix base32) |
a9285961 | 38 | #:use-module (guix memoization) |
42efe27a EB |
39 | #:use-module (guix upstream) |
40 | #:use-module (guix packages) | |
b29455cf | 41 | #:use-module ((guix utils) #:select (call-with-temporary-output-file)) |
42efe27a | 42 | #:export (hackage->guix-package |
a9285961 | 43 | hackage-recursive-import |
bc5844d1 FB |
44 | %hackage-updater |
45 | ||
46 | guix-package->hackage-name | |
a3ece51a | 47 | hackage-name->package-name |
bc5844d1 FB |
48 | hackage-fetch |
49 | hackage-source-url | |
50 | hackage-cabal-url | |
51 | hackage-package?)) | |
b29455cf | 52 | |
b29455cf | 53 | (define ghc-standard-libraries |
759756a9 | 54 | ;; List of libraries distributed with ghc (7.10.2). We include GHC itself as |
b29455cf | 55 | ;; some packages list it. |
759756a9 | 56 | '("array" |
b29455cf | 57 | "base" |
759756a9 | 58 | "bin-package-db" |
b29455cf FB |
59 | "binary" |
60 | "bytestring" | |
759756a9 PW |
61 | "cabal" ;; in the output of `ghc-pkg list` Cabal is uppercased, but |
62 | ;; hackage-name->package-name takes this into account. | |
b29455cf | 63 | "containers" |
759756a9 PW |
64 | "deepseq" |
65 | "directory" | |
66 | "filepath" | |
67 | "ghc" | |
b29455cf | 68 | "ghc-prim" |
759756a9 PW |
69 | "haskeline" |
70 | "hoopl" | |
71 | "hpc" | |
b29455cf | 72 | "integer-gmp" |
759756a9 | 73 | "pretty" |
b29455cf | 74 | "process" |
759756a9 PW |
75 | "rts" |
76 | "template-haskell" | |
b29455cf | 77 | "terminfo" |
759756a9 PW |
78 | "time" |
79 | "transformers" | |
b29455cf | 80 | "unix" |
759756a9 PW |
81 | "win32" |
82 | "xhtml")) | |
b29455cf FB |
83 | |
84 | (define package-name-prefix "ghc-") | |
85 | ||
f9ea74ad EB |
86 | (define (hackage-source-url name version) |
87 | "Given a Hackage package NAME and VERSION, return a url to the source | |
88 | tarball." | |
18f74735 | 89 | (string-append "https://hackage.haskell.org/package/" name |
f9ea74ad EB |
90 | "/" name "-" version ".tar.gz")) |
91 | ||
92 | (define* (hackage-cabal-url name #:optional version) | |
93 | "Given a Hackage package NAME and VERSION, return a url to the corresponding | |
94 | .cabal file on Hackage. If VERSION is #f or missing, the url for the latest | |
95 | version is returned." | |
96 | (if version | |
18f74735 | 97 | (string-append "https://hackage.haskell.org/package/" |
f9ea74ad | 98 | name "-" version "/" name ".cabal") |
18f74735 | 99 | (string-append "https://hackage.haskell.org/package/" |
f9ea74ad EB |
100 | name "/" name ".cabal"))) |
101 | ||
b29455cf | 102 | (define (hackage-name->package-name name) |
a4154748 | 103 | "Given the NAME of a Cabal package, return the corresponding Guix name." |
b29455cf FB |
104 | (if (string-prefix? package-name-prefix name) |
105 | (string-downcase name) | |
106 | (string-append package-name-prefix (string-downcase name)))) | |
107 | ||
42efe27a EB |
108 | (define guix-package->hackage-name |
109 | (let ((uri-rx (make-regexp "https?://hackage.haskell.org/package/([^/]+)/.*")) | |
110 | (name-rx (make-regexp "(.*)-[0-9\\.]+"))) | |
111 | (lambda (package) | |
112 | "Given a Guix package name, return the corresponding Hackage name." | |
113 | (let* ((source-url (and=> (package-source package) origin-uri)) | |
114 | (name (match:substring (regexp-exec uri-rx source-url) 1))) | |
115 | (match (regexp-exec name-rx name) | |
116 | (#f name) | |
117 | (m (match:substring m 1))))))) | |
118 | ||
b29455cf FB |
119 | (define (hackage-fetch name-version) |
120 | "Return the Cabal file for the package NAME-VERSION, or #f on failure. If | |
121 | the version part is omitted from the package name, then return the latest | |
122 | version." | |
a4824c60 FB |
123 | (guard (c ((and (http-get-error? c) |
124 | (= 404 (http-get-error-code c))) | |
125 | #f)) ;"expected" if package is unknown | |
126 | (let-values (((name version) (package-name->name+version name-version))) | |
127 | (let* ((url (hackage-cabal-url name version)) | |
128 | (port (http-fetch url)) | |
129 | (result (read-cabal (canonical-newline-port port)))) | |
130 | (close-port port) | |
131 | result)))) | |
b29455cf FB |
132 | |
133 | (define string->license | |
134 | ;; List of valid values from | |
135 | ;; https://www.haskell.org | |
136 | ;; /cabal/release/cabal-latest/doc/API/Cabal/Distribution-License.html. | |
137 | (match-lambda | |
138 | ("GPL-2" 'gpl2) | |
139 | ("GPL-3" 'gpl3) | |
140 | ("GPL" "'gpl??") | |
141 | ("AGPL-3" 'agpl3) | |
142 | ("AGPL" "'agpl??") | |
143 | ("LGPL-2.1" 'lgpl2.1) | |
144 | ("LGPL-3" 'lgpl3) | |
145 | ("LGPL" "'lgpl??") | |
146 | ("BSD2" 'bsd-2) | |
147 | ("BSD3" 'bsd-3) | |
148 | ("MIT" 'expat) | |
149 | ("ISC" 'isc) | |
150 | ("MPL" 'mpl2.0) | |
151 | ("Apache-2.0" 'asl2.0) | |
152 | ((x) (string->license x)) | |
153 | ((lst ...) `(list ,@(map string->license lst))) | |
154 | (_ #f))) | |
155 | ||
a4154748 | 156 | |
d804d0b9 DM |
157 | (define (cabal-dependencies->names cabal) |
158 | "Return the list of dependencies names from the CABAL package object, | |
159 | not including test suite dependencies or custom-setup dependencies." | |
a4154748 FB |
160 | (let* ((lib (cabal-package-library cabal)) |
161 | (lib-deps (if (pair? lib) | |
162 | (map cabal-dependency-name | |
163 | (append-map cabal-library-dependencies lib)) | |
164 | '())) | |
165 | (exe (cabal-package-executables cabal)) | |
166 | (exe-deps (if (pair? exe) | |
167 | (map cabal-dependency-name | |
168 | (append-map cabal-executable-dependencies exe)) | |
a4154748 | 169 | '()))) |
d804d0b9 DM |
170 | (delete-duplicates (append lib-deps exe-deps)))) |
171 | ||
172 | (define (cabal-test-dependencies->names cabal) | |
173 | "Return the list of test suite dependencies from the CABAL package | |
174 | object." | |
175 | (let* ((ts (cabal-package-test-suites cabal)) | |
176 | (ts-deps (if (pair? ts) | |
177 | (map cabal-dependency-name | |
178 | (append-map cabal-test-suite-dependencies ts)) | |
179 | '()))) | |
180 | ts-deps)) | |
181 | ||
182 | (define (cabal-custom-setup-dependencies->names cabal) | |
183 | "Return the list of custom-setup dependencies from the CABAL package | |
184 | object." | |
f6078422 RW |
185 | (let* ((custom-setup-dependencies (or (and=> (cabal-package-custom-setup cabal) |
186 | cabal-custom-setup-dependencies) | |
187 | '()))) | |
d804d0b9 | 188 | (map cabal-dependency-name custom-setup-dependencies))) |
a4154748 FB |
189 | |
190 | (define (filter-dependencies dependencies own-name) | |
191 | "Filter the dependencies included with the GHC compiler from DEPENDENCIES, a | |
192 | list with the names of dependencies. OWN-NAME is the name of the Cabal | |
193 | package being processed and is used to filter references to itself." | |
194 | (filter (lambda (d) (not (member (string-downcase d) | |
195 | (cons own-name ghc-standard-libraries)))) | |
196 | dependencies)) | |
197 | ||
198 | (define* (hackage-module->sexp cabal #:key (include-test-dependencies? #t)) | |
199 | "Return the `package' S-expression for a Cabal package. CABAL is the | |
b29455cf FB |
200 | representation of a Cabal file as produced by 'read-cabal'." |
201 | ||
202 | (define name | |
a4154748 | 203 | (cabal-package-name cabal)) |
b29455cf FB |
204 | |
205 | (define version | |
a4154748 | 206 | (cabal-package-version cabal)) |
b29455cf FB |
207 | |
208 | (define source-url | |
f9ea74ad | 209 | (hackage-source-url name version)) |
b29455cf | 210 | |
a9285961 RW |
211 | (define hackage-dependencies |
212 | ((compose (cut filter-dependencies <> | |
213 | (cabal-package-name cabal)) | |
214 | (cut cabal-dependencies->names <>)) | |
215 | cabal)) | |
216 | ||
217 | (define hackage-native-dependencies | |
69b0a847 AI |
218 | (lset-difference |
219 | equal? | |
220 | ((compose (cut filter-dependencies <> | |
221 | (cabal-package-name cabal)) | |
222 | ;; FIXME: Check include-test-dependencies? | |
223 | (lambda (cabal) | |
224 | (append (if include-test-dependencies? | |
225 | (cabal-test-dependencies->names cabal) | |
226 | '()) | |
227 | (cabal-custom-setup-dependencies->names cabal)))) | |
228 | cabal) | |
229 | hackage-dependencies)) | |
a9285961 | 230 | |
a4154748 | 231 | (define dependencies |
a9285961 RW |
232 | (map (lambda (name) |
233 | (list name (list 'unquote (string->symbol name)))) | |
234 | (map hackage-name->package-name | |
235 | hackage-dependencies))) | |
d804d0b9 DM |
236 | |
237 | (define native-dependencies | |
a9285961 RW |
238 | (map (lambda (name) |
239 | (list name (list 'unquote (string->symbol name)))) | |
240 | (map hackage-name->package-name | |
241 | hackage-native-dependencies))) | |
b29455cf FB |
242 | |
243 | (define (maybe-inputs input-type inputs) | |
244 | (match inputs | |
245 | (() | |
246 | '()) | |
247 | ((inputs ...) | |
248 | (list (list input-type | |
249 | (list 'quasiquote inputs)))))) | |
250 | ||
a4154748 FB |
251 | (define (maybe-arguments) |
252 | (if (not include-test-dependencies?) | |
253 | '((arguments `(#:tests? #f))) | |
254 | '())) | |
255 | ||
b29455cf FB |
256 | (let ((tarball (with-store store |
257 | (download-to-store store source-url)))) | |
a9285961 RW |
258 | (values |
259 | `(package | |
260 | (name ,(hackage-name->package-name name)) | |
261 | (version ,version) | |
262 | (source (origin | |
263 | (method url-fetch) | |
264 | (uri (string-append ,@(factorize-uri source-url version))) | |
265 | (sha256 | |
266 | (base32 | |
267 | ,(if tarball | |
268 | (bytevector->nix-base32-string (file-sha256 tarball)) | |
269 | "failed to download tar archive"))))) | |
270 | (build-system haskell-build-system) | |
271 | ,@(maybe-inputs 'inputs dependencies) | |
272 | ,@(maybe-inputs 'native-inputs native-dependencies) | |
273 | ,@(maybe-arguments) | |
274 | (home-page ,(cabal-package-home-page cabal)) | |
275 | (synopsis ,(cabal-package-synopsis cabal)) | |
276 | (description ,(cabal-package-description cabal)) | |
277 | (license ,(string->license (cabal-package-license cabal)))) | |
278 | (append hackage-dependencies hackage-native-dependencies)))) | |
a4154748 | 279 | |
a9285961 RW |
280 | (define hackage->guix-package |
281 | (memoize | |
282 | (lambda* (package-name #:key | |
283 | (include-test-dependencies? #t) | |
284 | (port #f) | |
285 | (cabal-environment '())) | |
286 | "Fetch the Cabal file for PACKAGE-NAME from hackage.haskell.org, or, if the | |
a4154748 FB |
287 | called with keyword parameter PORT, from PORT. Return the `package' |
288 | S-expression corresponding to that package, or #f on failure. | |
289 | CABAL-ENVIRONMENT is an alist defining the environment in which the Cabal | |
290 | conditionals are evaluated. The accepted keys are: \"os\", \"arch\", \"impl\" | |
291 | and the name of a flag. The value associated with a flag has to be either the | |
292 | symbol 'true' or 'false'. The value associated with other keys has to conform | |
293 | to the Cabal file format definition. The default value associated with the | |
294 | keys \"os\", \"arch\" and \"impl\" is \"linux\", \"x86_64\" and \"ghc\" | |
295 | respectively." | |
a9285961 RW |
296 | (let ((cabal-meta (if port |
297 | (read-cabal (canonical-newline-port port)) | |
298 | (hackage-fetch package-name)))) | |
299 | (and=> cabal-meta (compose (cut hackage-module->sexp <> | |
300 | #:include-test-dependencies? | |
301 | include-test-dependencies?) | |
302 | (cut eval-cabal <> cabal-environment))))))) | |
303 | ||
304 | (define* (hackage-recursive-import package-name . args) | |
305 | (recursive-import package-name #f | |
306 | #:repo->guix-package (lambda (name repo) | |
307 | (apply hackage->guix-package (cons name args))) | |
308 | #:guix-name hackage-name->package-name)) | |
b29455cf | 309 | |
42efe27a EB |
310 | (define (hackage-package? package) |
311 | "Return #t if PACKAGE is a Haskell package from Hackage." | |
312 | ||
313 | (define haskell-url? | |
314 | (let ((hackage-rx (make-regexp "https?://hackage.haskell.org"))) | |
315 | (lambda (url) | |
316 | (regexp-exec hackage-rx url)))) | |
317 | ||
318 | (let ((source-url (and=> (package-source package) origin-uri)) | |
319 | (fetch-method (and=> (package-source package) origin-method))) | |
320 | (and (eq? fetch-method url-fetch) | |
321 | (match source-url | |
322 | ((? string?) | |
323 | (haskell-url? source-url)) | |
324 | ((source-url ...) | |
325 | (any haskell-url? source-url)))))) | |
326 | ||
7d27a025 LC |
327 | (define (latest-release package) |
328 | "Return an <upstream-source> for the latest release of PACKAGE." | |
329 | (let* ((hackage-name (guix-package->hackage-name package)) | |
42efe27a EB |
330 | (cabal-meta (hackage-fetch hackage-name))) |
331 | (match cabal-meta | |
332 | (#f | |
333 | (format (current-error-port) | |
334 | "warning: failed to parse ~a~%" | |
335 | (hackage-cabal-url hackage-name)) | |
336 | #f) | |
337 | ((_ *** ("version" (version))) | |
338 | (let ((url (hackage-source-url hackage-name version))) | |
339 | (upstream-source | |
7d27a025 | 340 | (package (package-name package)) |
42efe27a EB |
341 | (version version) |
342 | (urls (list url)))))))) | |
343 | ||
344 | (define %hackage-updater | |
345 | (upstream-updater | |
346 | (name 'hackage) | |
347 | (description "Updater for Hackage packages") | |
348 | (pred hackage-package?) | |
349 | (latest latest-release))) | |
350 | ||
b29455cf | 351 | ;;; cabal.scm ends here |