nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

import: crate: Separate crates.io API from actual conversion. 

This provides a clean separation between bindings to the
https://crates.io/api/v1 API and actual conversion to Guix package
sexps.

As a side-effect, it fixes things like "guix import blake2-rfc", "guix
refresh -t crates", etc.

* guix/import/crate.scm (<crate>, <crate-version>, <crate-dependency>):
New record types.
(lookup-crate, crate-version-dependencies): New procedures.
(crate-fetch): Remove.
(crate->guix-package): Rewrite to use the new API.
(latest-release): Likewise.
* guix/build-system/cargo.scm (%crate-base-url): New variable.
* tests/crate.scm (test-crate): Update accordingly.

fixlet
This commit is contained in:
Ludovic Courtès 2019-09-01 16:20:36 +02:00
parent a85a74ce6c
commit 2791870d09
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 130 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
guix/build-system/cargo.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014, 2015, 2016, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2016 David Craven <david@craven.ch> ;;; Copyright © 2016 David Craven <david@craven.ch>
@ -35,12 +35,17 @@
#:export (%cargo-build-system-modules #:export (%cargo-build-system-modules
%cargo-utils-modules %cargo-utils-modules
cargo-build-system cargo-build-system
%crate-base-url
crate-url crate-url
crate-url? crate-url?
crate-uri)) crate-uri))
(define crate-url "https://crates.io/api/v1/crates/") (define %crate-base-url
(define crate-url? (cut string-prefix? crate-url <>)) (make-parameter "https://crates.io"))
(define crate-url
(string-append (%crate-base-url) "/api/v1/crates/"))
(define crate-url?
(cut string-prefix? crate-url <>))
(define (crate-uri name version) (define (crate-uri name version)
"Return a URI string for the crate package hosted at crates.io corresponding "Return a URI string for the crate package hosted at crates.io corresponding

149
guix/import/crate.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 David Craven <david@craven.ch> ;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -22,6 +23,7 @@
#:use-module ((guix download) #:prefix download:) #:use-module ((guix download) #:prefix download:)
#:use-module (gcrypt hash) #:use-module (gcrypt hash)
#:use-module (guix http-client) #:use-module (guix http-client)
#:use-module (guix json)
#:use-module (guix import json) #:use-module (guix import json)
#:use-module (guix import utils) #:use-module (guix import utils)
#:use-module ((guix licenses) #:prefix license:) #:use-module ((guix licenses) #:prefix license:)
@ -30,7 +32,6 @@
#:use-module (guix upstream) #:use-module (guix upstream)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 pretty-print) ; recursive
#:use-module (json) #:use-module (json)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-2) #:use-module (srfi srfi-2)
@ -39,46 +40,82 @@
guix-package->crate-name guix-package->crate-name
%crate-updater)) %crate-updater))
(define (crate-fetch crate-name callback)
"Fetch the metadata for CRATE-NAME from crates.io and call the callback." ;;;
;;; Interface to https://crates.io/api/v1.
;;;
(define (crates->inputs crates) ;; Crates. A crate is essentially a "package". It can have several
(sort (map (cut assoc-ref <> "crate_id") crates) string-ci<?)) ;; "versions", each of which has its own set of dependencies, license,
;; etc.--see <crate-version> below.
(define-json-mapping <crate> make-crate crate?
json->crate
(name crate-name) ;string
(latest-version crate-latest-version "max_version") ;string
(home-page crate-home-page "homepage") ;string | #nil
(repository crate-repository) ;string
(description crate-description) ;string
(keywords crate-keywords ;list of strings
"keywords" vector->list)
(categories crate-categories ;list of strings
"categories" vector->list)
(versions crate-versions "actual_versions" ;list of <crate-version>
(lambda (vector)
(map json->crate-version
(vector->list vector))))
(links crate-links)) ;alist
(define (string->license string) ;; Crate version.
(map spdx-string->license (string-split string #\/))) (define-json-mapping <crate-version> make-crate-version crate-version?
json->crate-version
(id crate-version-id) ;integer
(number crate-version-number "num") ;string
(download-path crate-version-download-path "dl_path") ;string
(readme-path crate-version-readme-path "readme_path") ;string
(license crate-version-license "license") ;string
(links crate-version-links)) ;alist
(define (crate-kind-predicate kind) ;; Crate dependency. Each dependency (each edge in the graph) is annotated as
(lambda (dep) (string=? (assoc-ref dep "kind") kind))) ;; being a "normal" dependency or a development dependency. There also
;; information about the minimum required version, such as "^0.0.41".
(define-json-mapping <crate-dependency> make-crate-dependency
crate-dependency?
json->crate-dependency
(id crate-dependency-id "crate_id") ;string
(kind crate-dependency-kind "kind" ;'normal | 'dev
string->symbol)
(requirement crate-dependency-requirement "req")) ;string
(and-let* ((crate-json (json-fetch (string-append crate-url crate-name))) (define (lookup-crate name)
(crate (assoc-ref crate-json "crate")) "Look up NAME on https://crates.io and return the corresopnding <crate>
(name (assoc-ref crate "name")) record or #f if it was not found."
(version (assoc-ref crate "max_version")) (let ((json (json-fetch (string-append (%crate-base-url) "/api/v1/crates/"
(homepage (assoc-ref crate "homepage")) name))))
(repository (assoc-ref crate "repository")) (and=> (and json (assoc-ref json "crate"))
(synopsis (assoc-ref crate "description")) (lambda (alist)
(description (assoc-ref crate "description")) ;; The "versions" field of ALIST is simply a list of version IDs
(license (or (and=> (assoc-ref crate "license") ;; (integers). Here, we squeeze in the actual version
string->license) ;; dictionaries that are not part of ALIST but are just more
'())) ;missing license info ;; convenient handled this way.
(path (string-append "/" version "/dependencies")) (let ((versions (or (assoc-ref json "versions") '#())))
(deps-json (json-fetch (string-append crate-url name path))) (json->crate `(,@alist
(deps (vector->list (assoc-ref deps-json "dependencies"))) ("actual_versions" . ,versions))))))))
(dep-crates (filter (crate-kind-predicate "normal") deps))
(dev-dep-crates (define (crate-version-dependencies version)
(filter (lambda (dep) "Return the list of <crate-dependency> records of VERSION, a
(not ((crate-kind-predicate "normal") dep))) deps)) <crate-version>."
(cargo-inputs (crates->inputs dep-crates)) (let* ((path (assoc-ref (crate-version-links version) "dependencies"))
(cargo-development-inputs (crates->inputs dev-dep-crates)) (url (string-append (%crate-base-url) path)))
(home-page (match homepage (match (assoc-ref (or (json-fetch url) '()) "dependencies")
(() repository) ((? vector? vector)
(_ homepage)))) (map json->crate-dependency (vector->list vector)))
(callback #:name name #:version version (_
#:cargo-inputs cargo-inputs '()))))
#:cargo-development-inputs cargo-development-inputs
#:home-page home-page #:synopsis synopsis
#:description description #:license license))) ;;;
;;; Converting crates to Guix packages.
;;;
(define (maybe-cargo-inputs package-names) (define (maybe-cargo-inputs package-names)
(match (package-names->package-inputs package-names) (match (package-names->package-inputs package-names)
@ -141,7 +178,38 @@ and LICENSE."
(define (crate->guix-package crate-name) (define (crate->guix-package crate-name)
"Fetch the metadata for CRATE-NAME from crates.io, and return the "Fetch the metadata for CRATE-NAME from crates.io, and return the
`package' s-expression corresponding to that package, or #f on failure." `package' s-expression corresponding to that package, or #f on failure."
(crate-fetch crate-name make-crate-sexp)) (define (string->license string)
(map spdx-string->license (string-split string #\/)))
(define (normal-dependency? dependency)
(eq? (crate-dependency-kind dependency) 'normal))
(define crate
(lookup-crate crate-name))
(and crate
(let* ((version (find (lambda (version)
(string=? (crate-version-number version)
(crate-latest-version crate)))
(crate-versions crate)))
(dependencies (crate-version-dependencies version))
(dep-crates (filter normal-dependency? dependencies))
(dev-dep-crates (remove normal-dependency? dependencies))
(cargo-inputs (sort (map crate-dependency-id dep-crates)
string-ci<?))
(cargo-development-inputs
(sort (map crate-dependency-id dev-dep-crates)
string-ci<?)))
(make-crate-sexp #:name crate-name
#:version (crate-version-number version)
#:cargo-inputs cargo-inputs
#:cargo-development-inputs cargo-development-inputs
#:home-page (or (crate-home-page crate)
(crate-repository crate))
#:synopsis (crate-description crate)
#:description (crate-description crate)
#:license (and=> (crate-version-license version)
string->license)))))
(define (guix-package->crate-name package) (define (guix-package->crate-name package)
"Return the crate name of PACKAGE." "Return the crate name of PACKAGE."
@ -157,6 +225,7 @@ and LICENSE."
(define (crate-name->package-name name) (define (crate-name->package-name name)
(string-append "rust-" (string-join (string-split name #\_) "-"))) (string-append "rust-" (string-join (string-split name #\_) "-")))
;;; ;;;
;;; Updater ;;; Updater
;;; ;;;
@ -175,8 +244,8 @@ and LICENSE."
(define (latest-release package) (define (latest-release package)
"Return an <upstream-source> for the latest release of PACKAGE." "Return an <upstream-source> for the latest release of PACKAGE."
(let* ((crate-name (guix-package->crate-name package)) (let* ((crate-name (guix-package->crate-name package))
(callback (lambda* (#:key version #:allow-other-keys) version)) (crate (lookup-crate crate-name))
(version (crate-fetch crate-name callback)) (version (crate-latest-version crate))
(url (crate-uri crate-name version))) (url (crate-uri crate-name version)))
(upstream-source (upstream-source
(package (package-name package)) (package (package-name package))

13
tests/crate.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 David Thompson <davet@gnu.org> ;;; Copyright © 2014 David Thompson <davet@gnu.org>
;;; Copyright © 2016 David Craven <david@craven.ch> ;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -32,10 +33,20 @@
\"crate\": { \"crate\": {
\"max_version\": \"1.0.0\", \"max_version\": \"1.0.0\",
\"name\": \"foo\", \"name\": \"foo\",
\"license\": \"MIT/Apache-2.0\",
\"description\": \"summary\", \"description\": \"summary\",
\"homepage\": \"http://example.com\", \"homepage\": \"http://example.com\",
\"repository\": \"http://example.com\", \"repository\": \"http://example.com\",
\"keywords\": [\"dummy\" \"test\"],
\"categories\": [\"test\"]
\"actual_versions\": [
{ \"id\": \"foo\",
\"num\": \"1.0.0\",
\"license\": \"MIT/Apache-2.0\",
\"links\": {
\"dependencies\": \"/api/v1/crates/foo/1.0.0/dependencies\"
}
}
]
} }
}") }")