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
master
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
;;; 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 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2016 David Craven <david@craven.ch>
@ -35,12 +35,17 @@
#:export (%cargo-build-system-modules
%cargo-utils-modules
cargo-build-system
%crate-base-url
crate-url
crate-url?
crate-uri))
(define crate-url "https://crates.io/api/v1/crates/")
(define crate-url? (cut string-prefix? crate-url <>))
(define %crate-base-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)
"Return a URI string for the crate package hosted at crates.io corresponding

151
guix/import/crate.scm
View File

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

13
tests/crate.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 David Thompson <davet@gnu.org>
;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -32,10 +33,20 @@
\"crate\": {
\"max_version\": \"1.0.0\",
\"name\": \"foo\",
\"license\": \"MIT/Apache-2.0\",
\"description\": \"summary\",
\"homepage\": \"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\"
}
}
]
}
}")