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