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