Commit | Line | Data |
---|---|---|
3e0c0365 DC |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2016 David Craven <david@craven.ch> | |
72c678af | 3 | ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> |
fd63ecbe | 4 | ;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> |
3e0c0365 DC |
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 crate) | |
22 | #:use-module (guix base32) | |
23 | #:use-module (guix build-system cargo) | |
24 | #:use-module ((guix download) #:prefix download:) | |
ca719424 | 25 | #:use-module (gcrypt hash) |
3e0c0365 DC |
26 | #:use-module (guix http-client) |
27 | #:use-module (guix import json) | |
28 | #:use-module (guix import utils) | |
29 | #:use-module ((guix licenses) #:prefix license:) | |
30 | #:use-module (guix monads) | |
31 | #:use-module (guix packages) | |
32 | #:use-module (guix upstream) | |
33 | #:use-module (guix utils) | |
34 | #:use-module (ice-9 match) | |
191668bc | 35 | #:use-module (ice-9 regex) |
3e0c0365 DC |
36 | #:use-module (json) |
37 | #:use-module (srfi srfi-1) | |
38 | #:use-module (srfi srfi-2) | |
39 | #:use-module (srfi srfi-26) | |
40 | #:export (crate->guix-package | |
8ac52987 | 41 | guix-package->crate-name |
72c678af | 42 | string->license |
f8372932 | 43 | crate-recursive-import |
8ac52987 | 44 | %crate-updater)) |
3e0c0365 | 45 | |
2791870d LC |
46 | \f |
47 | ;;; | |
48 | ;;; Interface to https://crates.io/api/v1. | |
49 | ;;; | |
3e0c0365 | 50 | |
2791870d LC |
51 | ;; Crates. A crate is essentially a "package". It can have several |
52 | ;; "versions", each of which has its own set of dependencies, license, | |
53 | ;; etc.--see <crate-version> below. | |
54 | (define-json-mapping <crate> make-crate crate? | |
55 | json->crate | |
56 | (name crate-name) ;string | |
57 | (latest-version crate-latest-version "max_version") ;string | |
58 | (home-page crate-home-page "homepage") ;string | #nil | |
59 | (repository crate-repository) ;string | |
60 | (description crate-description) ;string | |
61 | (keywords crate-keywords ;list of strings | |
62 | "keywords" vector->list) | |
63 | (categories crate-categories ;list of strings | |
64 | "categories" vector->list) | |
65 | (versions crate-versions "actual_versions" ;list of <crate-version> | |
66 | (lambda (vector) | |
67 | (map json->crate-version | |
68 | (vector->list vector)))) | |
69 | (links crate-links)) ;alist | |
3e0c0365 | 70 | |
2791870d LC |
71 | ;; Crate version. |
72 | (define-json-mapping <crate-version> make-crate-version crate-version? | |
73 | json->crate-version | |
74 | (id crate-version-id) ;integer | |
75 | (number crate-version-number "num") ;string | |
76 | (download-path crate-version-download-path "dl_path") ;string | |
77 | (readme-path crate-version-readme-path "readme_path") ;string | |
78 | (license crate-version-license "license") ;string | |
79 | (links crate-version-links)) ;alist | |
80 | ||
81 | ;; Crate dependency. Each dependency (each edge in the graph) is annotated as | |
82 | ;; being a "normal" dependency or a development dependency. There also | |
83 | ;; information about the minimum required version, such as "^0.0.41". | |
84 | (define-json-mapping <crate-dependency> make-crate-dependency | |
85 | crate-dependency? | |
86 | json->crate-dependency | |
87 | (id crate-dependency-id "crate_id") ;string | |
88 | (kind crate-dependency-kind "kind" ;'normal | 'dev | |
89 | string->symbol) | |
90 | (requirement crate-dependency-requirement "req")) ;string | |
91 | ||
92 | (define (lookup-crate name) | |
93 | "Look up NAME on https://crates.io and return the corresopnding <crate> | |
94 | record or #f if it was not found." | |
95 | (let ((json (json-fetch (string-append (%crate-base-url) "/api/v1/crates/" | |
96 | name)))) | |
97 | (and=> (and json (assoc-ref json "crate")) | |
98 | (lambda (alist) | |
99 | ;; The "versions" field of ALIST is simply a list of version IDs | |
100 | ;; (integers). Here, we squeeze in the actual version | |
101 | ;; dictionaries that are not part of ALIST but are just more | |
102 | ;; convenient handled this way. | |
103 | (let ((versions (or (assoc-ref json "versions") '#()))) | |
104 | (json->crate `(,@alist | |
105 | ("actual_versions" . ,versions)))))))) | |
106 | ||
107 | (define (crate-version-dependencies version) | |
108 | "Return the list of <crate-dependency> records of VERSION, a | |
109 | <crate-version>." | |
110 | (let* ((path (assoc-ref (crate-version-links version) "dependencies")) | |
111 | (url (string-append (%crate-base-url) path))) | |
112 | (match (assoc-ref (or (json-fetch url) '()) "dependencies") | |
113 | ((? vector? vector) | |
cf2b91aa | 114 | (delete-duplicates (map json->crate-dependency (vector->list vector)))) |
2791870d LC |
115 | (_ |
116 | '())))) | |
3e0c0365 | 117 | |
2791870d LC |
118 | \f |
119 | ;;; | |
120 | ;;; Converting crates to Guix packages. | |
121 | ;;; | |
3e0c0365 | 122 | |
5a9ef8a9 IP |
123 | (define (maybe-cargo-inputs package-names) |
124 | (match (package-names->package-inputs package-names) | |
125 | (() | |
126 | '()) | |
127 | ((package-inputs ...) | |
022288ba | 128 | `(#:cargo-inputs ,package-inputs)))) |
5a9ef8a9 IP |
129 | |
130 | (define (maybe-cargo-development-inputs package-names) | |
131 | (match (package-names->package-inputs package-names) | |
132 | (() | |
133 | '()) | |
134 | ((package-inputs ...) | |
022288ba | 135 | `(#:cargo-development-inputs ,package-inputs)))) |
5a9ef8a9 IP |
136 | |
137 | (define (maybe-arguments arguments) | |
138 | (match arguments | |
139 | (() | |
140 | '()) | |
141 | ((args ...) | |
142 | `((arguments (,'quasiquote ,args)))))) | |
143 | ||
144 | (define* (make-crate-sexp #:key name version cargo-inputs cargo-development-inputs | |
3e0c0365 DC |
145 | home-page synopsis description license |
146 | #:allow-other-keys) | |
147 | "Return the `package' s-expression for a rust package with the given NAME, | |
5a9ef8a9 IP |
148 | VERSION, CARGO-INPUTS, CARGO-DEVELOPMENT-INPUTS, HOME-PAGE, SYNOPSIS, DESCRIPTION, |
149 | and LICENSE." | |
3e0c0365 DC |
150 | (let* ((port (http-fetch (crate-uri name version))) |
151 | (guix-name (crate-name->package-name name)) | |
5a9ef8a9 IP |
152 | (cargo-inputs (map crate-name->package-name cargo-inputs)) |
153 | (cargo-development-inputs (map crate-name->package-name | |
154 | cargo-development-inputs)) | |
3e0c0365 DC |
155 | (pkg `(package |
156 | (name ,guix-name) | |
157 | (version ,version) | |
158 | (source (origin | |
159 | (method url-fetch) | |
160 | (uri (crate-uri ,name version)) | |
161 | (file-name (string-append name "-" version ".tar.gz")) | |
162 | (sha256 | |
163 | (base32 | |
164 | ,(bytevector->nix-base32-string (port-sha256 port)))))) | |
165 | (build-system cargo-build-system) | |
5a9ef8a9 IP |
166 | ,@(maybe-arguments (append (maybe-cargo-inputs cargo-inputs) |
167 | (maybe-cargo-development-inputs | |
168 | cargo-development-inputs))) | |
f53a5514 DC |
169 | (home-page ,(match home-page |
170 | (() "") | |
171 | (_ home-page))) | |
3e0c0365 DC |
172 | (synopsis ,synopsis) |
173 | (description ,(beautify-description description)) | |
174 | (license ,(match license | |
175 | (() #f) | |
176 | ((license) license) | |
177 | (_ `(list ,@license))))))) | |
178 | (close-port port) | |
179 | pkg)) | |
180 | ||
263a267b BW |
181 | (define (string->license string) |
182 | (filter-map (lambda (license) | |
183 | (and (not (string-null? license)) | |
184 | (not (any (lambda (elem) (string=? elem license)) | |
185 | '("AND" "OR" "WITH"))) | |
186 | (or (spdx-string->license license) | |
187 | 'unknown-license!))) | |
188 | (string-split string (string->char-set " /")))) | |
191668bc | 189 | |
fd63ecbe | 190 | (define* (crate->guix-package crate-name #:optional version) |
3e0c0365 | 191 | "Fetch the metadata for CRATE-NAME from crates.io, and return the |
fd63ecbe MB |
192 | `package' s-expression corresponding to that package, or #f on failure. |
193 | When VERSION is specified, attempt to fetch that version; otherwise fetch the | |
194 | latest version of CRATE-NAME." | |
2791870d LC |
195 | |
196 | (define (normal-dependency? dependency) | |
197 | (eq? (crate-dependency-kind dependency) 'normal)) | |
198 | ||
199 | (define crate | |
200 | (lookup-crate crate-name)) | |
201 | ||
fd63ecbe | 202 | (define version-number |
5fbc753a LC |
203 | (and crate |
204 | (or version | |
205 | (crate-latest-version crate)))) | |
fd63ecbe MB |
206 | |
207 | (define version* | |
5fbc753a LC |
208 | (and crate |
209 | (find (lambda (version) | |
210 | (string=? (crate-version-number version) | |
211 | version-number)) | |
212 | (crate-versions crate)))) | |
fd63ecbe MB |
213 | |
214 | (and crate version* | |
215 | (let* ((dependencies (crate-version-dependencies version*)) | |
2791870d LC |
216 | (dep-crates (filter normal-dependency? dependencies)) |
217 | (dev-dep-crates (remove normal-dependency? dependencies)) | |
218 | (cargo-inputs (sort (map crate-dependency-id dep-crates) | |
219 | string-ci<?)) | |
220 | (cargo-development-inputs | |
221 | (sort (map crate-dependency-id dev-dep-crates) | |
222 | string-ci<?))) | |
f8372932 MB |
223 | (values |
224 | (make-crate-sexp #:name crate-name | |
225 | #:version (crate-version-number version*) | |
226 | #:cargo-inputs cargo-inputs | |
227 | #:cargo-development-inputs cargo-development-inputs | |
228 | #:home-page (or (crate-home-page crate) | |
229 | (crate-repository crate)) | |
230 | #:synopsis (crate-description crate) | |
231 | #:description (crate-description crate) | |
232 | #:license (and=> (crate-version-license version*) | |
233 | string->license)) | |
234 | (append cargo-inputs cargo-development-inputs))))) | |
235 | ||
c7ca707b | 236 | (define* (crate-recursive-import crate-name #:optional version) |
f8372932 | 237 | (recursive-import crate-name #f |
c7ca707b LC |
238 | #:repo->guix-package |
239 | (lambda (name repo) | |
240 | (let ((version (and (string=? name crate-name) | |
241 | version))) | |
242 | (crate->guix-package name version))) | |
f8372932 | 243 | #:guix-name crate-name->package-name)) |
3e0c0365 DC |
244 | |
245 | (define (guix-package->crate-name package) | |
246 | "Return the crate name of PACKAGE." | |
247 | (and-let* ((origin (package-source package)) | |
248 | (uri (origin-uri origin)) | |
249 | (crate-url? uri) | |
250 | (len (string-length crate-url)) | |
251 | (path (xsubstring uri len)) | |
252 | (parts (string-split path #\/))) | |
253 | (match parts | |
254 | ((name _ ...) name)))) | |
255 | ||
256 | (define (crate-name->package-name name) | |
257 | (string-append "rust-" (string-join (string-split name #\_) "-"))) | |
258 | ||
2791870d | 259 | \f |
8ac52987 DC |
260 | ;;; |
261 | ;;; Updater | |
262 | ;;; | |
263 | ||
00290e73 LC |
264 | (define crate-package? |
265 | (url-predicate crate-url?)) | |
8ac52987 DC |
266 | |
267 | (define (latest-release package) | |
268 | "Return an <upstream-source> for the latest release of PACKAGE." | |
269 | (let* ((crate-name (guix-package->crate-name package)) | |
2791870d LC |
270 | (crate (lookup-crate crate-name)) |
271 | (version (crate-latest-version crate)) | |
272 | (url (crate-uri crate-name version))) | |
8ac52987 DC |
273 | (upstream-source |
274 | (package (package-name package)) | |
275 | (version version) | |
276 | (urls (list url))))) | |
277 | ||
278 | (define %crate-updater | |
279 | (upstream-updater | |
280 | (name 'crates) | |
281 | (description "Updater for crates.io packages") | |
282 | (pred crate-package?) | |
283 | (latest latest-release))) | |
284 |