Toggle diff (272 lines)
diff --git a/guix/build-system/cargo.scm b/guix/build-system/cargo.scm
index 10a1bac844..1e8b3a578e 100644
--- a/guix/build-system/cargo.scm
+++ b/guix/build-system/cargo.scm
@@ -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
diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index 52c5cb1c30..bcd5068e6c 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -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)))
-
- (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)))
+;; 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
+
+(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,35 @@ 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))
+
+ (let* ((crate (lookup-crate crate-name))
+ (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 +222,7 @@ and LICENSE."
(define (crate-name->package-name name)
(string-append "rust-" (string-join (string-split name #\_) "-")))
+
;;;
;;; Updater
;;;
@@ -175,9 +241,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)
diff --git a/tests/crate.scm b/tests/crate.scm
index 72c3a13350..8a232ba06c 100644
--- a/tests/crate.scm
+++ b/tests/crate.scm
@@ -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\"
+ }
+ }
+ ]
}
}")
--
2.23.0
