mirror of
https://codeberg.org/guix/guix.git
synced 2025-10-02 02:15:12 +00:00
import: crate: Stop importing dependencies from crates.io.
* guix/scripts/import/crate.scm (show-help, %options, guix-import-crate)
[--recursive, --recursive-dev-dependencies, --mark-missing]: Remove options.
* doc/guix.texi (Invoking guix import)[crate]: Adjust accordingly.
Mention packaging workflow.
* guix/import/crate.scm (make-crate-sexp): Don't use "rust-" prefix and semver
suffix for package name.
[#:cargo-inputs, #:cargo-development-inputs, #:build?]: Remove arguments.
(crate->guix-package)[#:include-dev-deps?, #:mark-missing?]: Remove arguments.
(<crate-dependency>): Remove data type.
(make-crate-dependency, crate-dependency?, json->crate-dependency)
(crate-version-dependencies, package-names->package-inputs)
(maybe-cargo-inputs, maybe-cargo-development-inputs, maybe-arguments)
(version->semver-prefix, find-package-version, crate-recursive-import): Remove
procedures.
* tests/crate.scm (test-foo-crate, test-bar-crate): Adjust for modified tests.
(test-foo-dependencies, test-bar-dependencies, test-root-crate)
(test-root-dependencies, test-intermediate-a-crate)
(test-intermediate-a-dependencies, test-intermediate-b-crate)
(test-intermediate-b-dependencies, test-intermediate-c-crate)
(test-intermediate-c-dependencies, test-leaf-alice-crate)
(test-leaf-alice-dependencies, test-leaf-bob-crate)
(test-leaf-bob-dependencies, rust-leaf-bob-3, rust-leaf-bob-3.0.2-yanked):
Remove variables.
("crate->guix-package yanked", "crate->guix-package only yanked available"): New
tests.
("crate->guix-package"): Adjust accordingly.
("crate->guix-package-marks-missing-packages", "crate-recursive-import")
("crate-recursive-import-honors-existing-packages")
("crate-import-only-yanked-available"): Remove tests.
Change-Id: Ib1d24511ed0ea1a2373f53de12e06afa7950a7d7
This commit is contained in:
Hilton Chain
parent
efaa3e681e
commit
92d130e035
4 changed files with 152 additions and 1332 deletions
|
|
@ -14939,27 +14939,17 @@ guix import crate constant-time-eq@@0.1.0
|
|||
Additional options include:
|
||||
|
||||
@table @code
|
||||
@item --recursive
|
||||
@itemx -r
|
||||
Traverse the dependency graph of the given upstream package recursively
|
||||
and generate package expressions for all those packages that are not yet
|
||||
in Guix.
|
||||
@item --recursive-dev-dependencies
|
||||
If @option{--recursive-dev-dependencies} is specified, also the recursively
|
||||
imported packages contain their development dependencies, which are recursively
|
||||
imported as well.
|
||||
@item --allow-yanked
|
||||
If no non-yanked version of a crate is available, use the latest yanked
|
||||
version instead instead of aborting.
|
||||
@item --mark-missing
|
||||
If a crate dependency is not (yet) packaged, make the corresponding
|
||||
input in @code{#:cargo-inputs} or @code{#:cargo-development-inputs} into
|
||||
a comment.
|
||||
@item --lockfile=@var{file}
|
||||
@itemx -f @var{file}
|
||||
When @option{--lockfile} is specified, the importer will ignore other options
|
||||
and won't output package expressions, instead importing source expressions
|
||||
from @var{file}, a @file{Cargo.lock} file.
|
||||
|
||||
@xref{Packaging Rust Crates,,, guix-cookbook, GNU Guix Cookbook}, for packaging
|
||||
workflow utilizing it.
|
||||
@end table
|
||||
|
||||
@item elm
|
||||
|
|
|
|||
|
|
@ -104,20 +104,9 @@
|
|||
(yanked? crate-version-yanked? "yanked") ;boolean
|
||||
(links crate-version-links)) ;alist
|
||||
|
||||
;; 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 | 'build
|
||||
string->symbol)
|
||||
(requirement crate-dependency-requirement "req")) ;string
|
||||
|
||||
;; Autoload Guile-Semver so we only have a soft dependency.
|
||||
(module-autoload! (current-module)
|
||||
'(semver) '(string->semver semver->string semver<? semver=? semver>?))
|
||||
'(semver) '(string->semver semver->string semver>?))
|
||||
(module-autoload! (current-module)
|
||||
'(semver ranges) '(string->semver-range semver-range-contains?))
|
||||
|
||||
|
|
@ -138,91 +127,17 @@ record or #f if it was not found."
|
|||
|
||||
(define lookup-crate* (memoize lookup-crate))
|
||||
|
||||
(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)
|
||||
(delete-duplicates (map json->crate-dependency (vector->list vector))))
|
||||
(_
|
||||
'()))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Converting crates to Guix packages.
|
||||
;;;
|
||||
|
||||
(define* (package-names->package-inputs names #:optional (output #f))
|
||||
"Given a list of PACKAGE-NAMES or (PACKAGE-NAME VERSION) pairs, and an
|
||||
optional OUTPUT, tries to generate a quoted list of inputs, as suitable to
|
||||
use in an 'inputs' field of a package definition."
|
||||
(define (make-input input version)
|
||||
(cons* input (list 'unquote (string->symbol
|
||||
(if version
|
||||
(string-append input "-" version)
|
||||
input)))
|
||||
(or (and output (list output))
|
||||
'())))
|
||||
|
||||
(map (match-lambda
|
||||
((input version) (make-input input version))
|
||||
((? blank? comment) comment)
|
||||
(input (make-input input #f)))
|
||||
names))
|
||||
|
||||
(define (maybe-cargo-inputs package-names)
|
||||
(match (package-names->package-inputs package-names)
|
||||
(()
|
||||
'())
|
||||
((package-inputs ...)
|
||||
`(#:cargo-inputs ,package-inputs))))
|
||||
|
||||
(define (maybe-cargo-development-inputs package-names)
|
||||
(match (package-names->package-inputs package-names)
|
||||
(()
|
||||
'())
|
||||
((package-inputs ...)
|
||||
`(#:cargo-development-inputs ,package-inputs))))
|
||||
|
||||
(define (maybe-arguments arguments)
|
||||
(match arguments
|
||||
(()
|
||||
'())
|
||||
((args ...)
|
||||
`((arguments (,'quasiquote ,args))))))
|
||||
|
||||
(define (version->semver-prefix version)
|
||||
"Return the version up to and including the first non-zero part"
|
||||
(first
|
||||
(map match:substring
|
||||
(list-matches "^(0+\\.){,2}[0-9]+" version))))
|
||||
|
||||
(define* (make-crate-sexp #:key name version cargo-inputs cargo-development-inputs
|
||||
home-page synopsis description license build? yanked?)
|
||||
(define* (make-crate-sexp #:key name version
|
||||
home-page synopsis description license yanked?)
|
||||
"Return the `package' s-expression for a rust package with the given NAME,
|
||||
VERSION, CARGO-INPUTS, CARGO-DEVELOPMENT-INPUTS, HOME-PAGE, SYNOPSIS, DESCRIPTION,
|
||||
and LICENSE."
|
||||
(define (format-inputs inputs)
|
||||
(map
|
||||
(match-lambda
|
||||
((name missing version yanked)
|
||||
(let ((input (list (crate-name->package-name name)
|
||||
(if yanked
|
||||
(string-append version "-yanked")
|
||||
(version->semver-prefix version)))))
|
||||
(if missing
|
||||
(comment
|
||||
(string-append ";; " (string-join input "-") "\n")
|
||||
#f)
|
||||
input))))
|
||||
inputs))
|
||||
|
||||
VERSION, HOME-PAGE, SYNOPSIS, DESCRIPTION and LICENSE."
|
||||
(let* ((port (http-fetch (crate-uri name version)))
|
||||
(guix-name (crate-name->package-name name))
|
||||
(cargo-inputs (format-inputs cargo-inputs))
|
||||
(cargo-development-inputs (format-inputs cargo-development-inputs))
|
||||
(guix-name (downstream-package-name "" name))
|
||||
(description (beautify-description description))
|
||||
(pkg `(package
|
||||
(name ,guix-name)
|
||||
|
|
@ -244,12 +159,7 @@ and LICENSE."
|
|||
`((properties '((crate-version-yanked? . #t))))
|
||||
'())
|
||||
(build-system cargo-build-system)
|
||||
,@(maybe-arguments (append (if build?
|
||||
'()
|
||||
'(#:skip-build? #t))
|
||||
(maybe-cargo-inputs cargo-inputs)
|
||||
(maybe-cargo-development-inputs
|
||||
cargo-development-inputs)))
|
||||
(inputs (cargo-inputs ',(string->symbol guix-name)))
|
||||
(home-page ,home-page)
|
||||
(synopsis ,(beautify-synopsis synopsis))
|
||||
(description ,(if (string-prefix? "This" description)
|
||||
|
|
@ -262,10 +172,7 @@ and LICENSE."
|
|||
((license) license)
|
||||
(_ `(list ,@license)))))))
|
||||
(close-port port)
|
||||
(package->definition pkg
|
||||
(if yanked?
|
||||
(string-append version "-yanked")
|
||||
(version->semver-prefix version)))))
|
||||
(package->definition pkg)))
|
||||
|
||||
(define (string->license string)
|
||||
(filter-map (lambda (license)
|
||||
|
|
@ -310,50 +217,13 @@ satisfies SEMVER-RANGE."
|
|||
(not (crate-version-yanked? entry)))
|
||||
(crate-versions crate)))
|
||||
|
||||
(define (find-package-version name range allow-yanked?)
|
||||
"Find the latest existing package that fulfills the SemVer RANGE. If
|
||||
ALLOW-YANKED? is #t, include packages marked as yanked at a lower
|
||||
priority."
|
||||
(set! range (string->semver-range range))
|
||||
(let loop ((packages (find-packages-by-name
|
||||
(crate-name->package-name name)))
|
||||
(semver #f)
|
||||
(yanked? #f))
|
||||
(match packages
|
||||
((pkg packages ...)
|
||||
(let ((pkg-yanked? (assoc-ref (package-properties pkg)
|
||||
'crate-version-yanked?)))
|
||||
(if (or allow-yanked? (not pkg-yanked?))
|
||||
(let ((pkg-semver (string->semver (package-version pkg))))
|
||||
(if (and (or (not semver)
|
||||
(and yanked? (not pkg-yanked?))
|
||||
(and (eq? yanked? pkg-yanked?)
|
||||
(semver>? pkg-semver semver)))
|
||||
(semver-range-contains? range pkg-semver))
|
||||
(loop packages pkg-semver pkg-yanked?)
|
||||
(loop packages semver yanked?)))
|
||||
(loop packages semver yanked?))))
|
||||
(() (and semver (list (semver->string semver) yanked?))))))
|
||||
|
||||
(define* (crate->guix-package
|
||||
crate-name
|
||||
#:key version include-dev-deps? allow-yanked? mark-missing?
|
||||
#:allow-other-keys)
|
||||
crate-name #:key version allow-yanked? #:allow-other-keys)
|
||||
"Fetch the metadata for CRATE-NAME from crates.io, and return the
|
||||
`package' s-expression corresponding to that package, or #f on failure.
|
||||
When VERSION is specified, convert it into a semver range and attempt to fetch
|
||||
the latest version matching this semver range; otherwise fetch the latest
|
||||
version of CRATE-NAME. If INCLUDE-DEV-DEPS is true then this will also
|
||||
look up the development dependencs for the given crate."
|
||||
|
||||
(define (semver-range-contains-string? range version)
|
||||
(semver-range-contains? (string->semver-range range)
|
||||
(string->semver version)))
|
||||
|
||||
(define (normal-dependency? dependency)
|
||||
(or (eq? (crate-dependency-kind dependency) 'build)
|
||||
(eq? (crate-dependency-kind dependency) 'normal)))
|
||||
|
||||
version of CRATE-NAME."
|
||||
(define crate
|
||||
(lookup-crate* crate-name))
|
||||
|
||||
|
|
@ -375,78 +245,15 @@ look up the development dependencs for the given crate."
|
|||
(max-crate-version-of-semver semver-range
|
||||
(crate-versions crate))))))
|
||||
|
||||
;; If no non-yanked existing package version was found, check the upstream
|
||||
;; versions. If a non-yanked upstream version exists, use it instead,
|
||||
;; otherwise use the existing package version, provided it exists.
|
||||
(define (dependency-name+missing+version+yanked dep)
|
||||
(let* ((name (crate-dependency-id dep))
|
||||
(req (crate-dependency-requirement dep))
|
||||
(existing-version
|
||||
(find-package-version name req allow-yanked?)))
|
||||
(if (and existing-version (not (second existing-version)))
|
||||
(cons* name #f existing-version)
|
||||
(let* ((crate (lookup-crate* name))
|
||||
(ver (find-crate-version crate req)))
|
||||
(if existing-version
|
||||
(if (and ver (not (crate-version-yanked? ver)))
|
||||
(if (semver=? (string->semver (first existing-version))
|
||||
(string->semver (crate-version-number ver)))
|
||||
(begin
|
||||
(warning (G_ "~A: version ~a is no longer yanked~%")
|
||||
name (first existing-version))
|
||||
(cons* name #f existing-version))
|
||||
(list name
|
||||
#f
|
||||
(crate-version-number ver)
|
||||
(crate-version-yanked? ver)))
|
||||
(begin
|
||||
(warning (G_ "~A: using existing version ~a, which was yanked~%")
|
||||
name (first existing-version))
|
||||
(cons* name #f existing-version)))
|
||||
(begin
|
||||
(unless ver
|
||||
(leave (G_ "~A: no version found for requirement ~a~%") name req))
|
||||
(if (crate-version-yanked? ver)
|
||||
(warning (G_ "~A: imported version ~a was yanked~%")
|
||||
name (crate-version-number ver)))
|
||||
(list name
|
||||
mark-missing?
|
||||
(crate-version-number ver)
|
||||
(crate-version-yanked? ver))))))))
|
||||
|
||||
(define version*
|
||||
(and crate
|
||||
(or (find-crate-version crate version-number)
|
||||
(leave (G_ "~A: version ~a not found~%") crate-name version-number))))
|
||||
|
||||
;; sort and map the dependencies to a list containing
|
||||
;; pairs of (name version)
|
||||
(define (sort-map-dependencies deps)
|
||||
(sort (map dependency-name+missing+version+yanked
|
||||
deps)
|
||||
(match-lambda* (((name _ _ _) ...)
|
||||
(apply string-ci<? name)))))
|
||||
|
||||
(define (remove-missing+yanked-info deps)
|
||||
(map
|
||||
(match-lambda ((name missing version yanked)
|
||||
(list name version)))
|
||||
deps))
|
||||
|
||||
(if (and crate version*)
|
||||
(let* ((dependencies (crate-version-dependencies version*))
|
||||
(dep-crates dev-dep-crates (partition normal-dependency? dependencies))
|
||||
(cargo-inputs (sort-map-dependencies dep-crates))
|
||||
(cargo-development-inputs (if include-dev-deps?
|
||||
(sort-map-dependencies dev-dep-crates)
|
||||
'())))
|
||||
(values
|
||||
(make-crate-sexp #:build? include-dev-deps?
|
||||
#:yanked? (crate-version-yanked? version*)
|
||||
(make-crate-sexp #:yanked? (crate-version-yanked? version*)
|
||||
#:name crate-name
|
||||
#:version (crate-version-number version*)
|
||||
#:cargo-inputs cargo-inputs
|
||||
#:cargo-development-inputs cargo-development-inputs
|
||||
#:home-page
|
||||
(let ((home-page (crate-home-page crate)))
|
||||
(if (string? home-page)
|
||||
|
|
@ -459,28 +266,8 @@ look up the development dependencs for the given crate."
|
|||
#:description (crate-description crate)
|
||||
#:license (and=> (crate-version-license version*)
|
||||
string->license))
|
||||
(append
|
||||
(remove-missing+yanked-info cargo-inputs)
|
||||
(remove-missing+yanked-info cargo-development-inputs))))
|
||||
(values #f '())))
|
||||
|
||||
(define* (crate-recursive-import
|
||||
crate-name #:key version recursive-dev-dependencies? allow-yanked?)
|
||||
(recursive-import
|
||||
crate-name
|
||||
#:repo->guix-package
|
||||
(let ((crate->guix-package* (memoize crate->guix-package)))
|
||||
(lambda* params
|
||||
;; download development dependencies only for the top level package
|
||||
(let ((include-dev-deps?
|
||||
(or (equal? (car params) crate-name)
|
||||
recursive-dev-dependencies?)))
|
||||
(apply crate->guix-package*
|
||||
(append params `(#:include-dev-deps? ,include-dev-deps?
|
||||
#:allow-yanked? ,allow-yanked?))))))
|
||||
#:version version
|
||||
#:guix-name crate-name->package-name))
|
||||
|
||||
(define (guix-package->crate-name package)
|
||||
"Return the crate name of PACKAGE."
|
||||
(and-let* ((origin (package-source package))
|
||||
|
|
|
|||
|
|
@ -49,18 +49,9 @@
|
|||
(define (show-help)
|
||||
(display (G_ "Usage: guix import crate PACKAGE-NAME
|
||||
Import and convert the crates.io package for PACKAGE-NAME.\n"))
|
||||
(display (G_ "
|
||||
-r, --recursive import packages recursively"))
|
||||
(display (G_ "
|
||||
--recursive-dev-dependencies
|
||||
include dev-dependencies recursively"))
|
||||
(newline)
|
||||
(display (G_ "
|
||||
--allow-yanked allow importing yanked crates if no alternative
|
||||
satisfying the version requirement is found"))
|
||||
(display (G_ "
|
||||
--mark-missing comment out the desired dependency if no
|
||||
sufficient package exists for it"))
|
||||
(newline)
|
||||
(display (G_ "
|
||||
-f, --lockfile=FILE import dependencies from FILE, a 'Cargo.lock' file"))
|
||||
|
|
@ -81,18 +72,9 @@ Import and convert the crates.io package for PACKAGE-NAME.\n"))
|
|||
(option '(#\V "version") #f #f
|
||||
(lambda args
|
||||
(show-version-and-exit "guix import crate")))
|
||||
(option '(#\r "recursive") #f #f
|
||||
(lambda (opt name arg result)
|
||||
(alist-cons 'recursive #t result)))
|
||||
(option '("recursive-dev-dependencies") #f #f
|
||||
(lambda (opt name arg result)
|
||||
(alist-cons 'recursive-dev-dependencies #t result)))
|
||||
(option '("allow-yanked") #f #f
|
||||
(lambda (opt name arg result)
|
||||
(alist-cons 'allow-yanked #t result)))
|
||||
(option '("mark-missing") #f #f
|
||||
(lambda (opt name arg result)
|
||||
(alist-cons 'mark-missing #t result)))
|
||||
(option '(#\f "lockfile") #f #t
|
||||
(lambda (opt name arg result)
|
||||
(if (file-exists? arg)
|
||||
|
|
@ -124,8 +106,7 @@ Import and convert the crates.io package for PACKAGE-NAME.\n"))
|
|||
(define-values (name version)
|
||||
(package-name->name+version spec))
|
||||
|
||||
(match (cond
|
||||
(lockfile
|
||||
(match (if lockfile
|
||||
(let ((source-expressions
|
||||
_
|
||||
(cargo-lock->expressions lockfile name)))
|
||||
|
|
@ -150,18 +131,10 @@ Import and convert the crates.io package for PACKAGE-NAME.\n"))
|
|||
(pretty-print-with-comments port cargo-inputs)
|
||||
(newline port)
|
||||
(close-port port)))
|
||||
source-expressions))
|
||||
((assoc-ref opts 'recursive)
|
||||
(crate-recursive-import
|
||||
name #:version version
|
||||
#:recursive-dev-dependencies?
|
||||
(assoc-ref opts 'recursive-dev-dependencies)
|
||||
#:allow-yanked? (assoc-ref opts 'allow-yanked)))
|
||||
(else
|
||||
source-expressions)
|
||||
(crate->guix-package
|
||||
name #:version version #:include-dev-deps? #t
|
||||
#:allow-yanked? (assoc-ref opts 'allow-yanked)
|
||||
#:mark-missing? (assoc-ref opts 'mark-missing))))
|
||||
name #:version version
|
||||
#:allow-yanked? (assoc-ref opts 'allow-yanked)))
|
||||
((or #f '())
|
||||
(leave (G_ "failed to download meta-data for package '~a'~%")
|
||||
(if version
|
||||
|
|
|
|||
1016
tests/crate.scm
1016
tests/crate.scm
File diff suppressed because it is too large
Load diff
Loading…
Add table
Add a link
Reference in a new issue