mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
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
parent
a85a74ce6c
commit
2791870d09
3 changed files with 130 additions and 45 deletions
|
|
@ -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 @@ (define-module (guix build-system cargo)
|
|||
#: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
|
||||
|
|
|
|||
|
|
@ -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 @@ (define-module (guix import crate)
|
|||
#: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 @@ (define-module (guix import crate)
|
|||
#: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 @@ (define-module (guix import crate)
|
|||
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 @@ (define* (make-crate-sexp #:key name version cargo-inputs cargo-development-inpu
|
|||
(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 @@ (define (guix-package->crate-name package)
|
|||
(define (crate-name->package-name name)
|
||||
(string-append "rust-" (string-join (string-split name #\_) "-")))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Updater
|
||||
;;;
|
||||
|
|
@ -175,8 +244,8 @@ (define (crate-package? package)
|
|||
(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))
|
||||
(crate (lookup-crate crate-name))
|
||||
(version (crate-latest-version crate))
|
||||
(url (crate-uri crate-name version)))
|
||||
(upstream-source
|
||||
(package (package-name package))
|
||||
|
|
|
|||
|
|
@ -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 @@ (define test-crate
|
|||
\"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\"
|
||||
}
|
||||
}
|
||||
]
|
||||
}
|
||||
}")
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue