diff options
Diffstat (limited to 'guix')
| -rw-r--r-- | guix/import/crate.scm | 91 | ||||
| -rw-r--r-- | guix/import/utils.scm | 21 | ||||
| -rw-r--r-- | guix/scripts/import/crate.scm | 11 |
3 files changed, 83 insertions, 40 deletions
diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 47bfc16105..5498d1f0ff 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 David Craven <david@craven.ch> ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> -;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> +;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -37,6 +37,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-2) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-71) #:export (crate->guix-package guix-package->crate-name string->license @@ -85,10 +86,15 @@ crate-dependency? json->crate-dependency (id crate-dependency-id "crate_id") ;string - (kind crate-dependency-kind "kind" ;'normal | 'dev + (kind crate-dependency-kind "kind" ;'normal | 'dev | 'build string->symbol) (requirement crate-dependency-requirement "req")) ;string +(module-autoload! (current-module) + '(semver) '(string->semver semver<?)) +(module-autoload! (current-module) + '(semver ranges) '(string->semver-range semver-range-contains?)) + (define (lookup-crate name) "Look up NAME on https://crates.io and return the corresopnding <crate> record or #f if it was not found." @@ -142,16 +148,21 @@ record or #f if it was not found." `((arguments (,'quasiquote ,args)))))) (define* (make-crate-sexp #:key name version cargo-inputs cargo-development-inputs - home-page synopsis description license - #:allow-other-keys) + home-page synopsis description license) "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 version) + (list (crate-name->package-name name) version))) + inputs)) + (let* ((port (http-fetch (crate-uri name version))) (guix-name (crate-name->package-name name)) - (cargo-inputs (map crate-name->package-name cargo-inputs)) - (cargo-development-inputs (map crate-name->package-name - cargo-development-inputs)) + (cargo-inputs (format-inputs cargo-inputs)) + (cargo-development-inputs (format-inputs cargo-development-inputs)) (pkg `(package (name ,guix-name) (version ,version) @@ -163,7 +174,8 @@ and LICENSE." (base32 ,(bytevector->nix-base32-string (port-sha256 port)))))) (build-system cargo-build-system) - ,@(maybe-arguments (append (maybe-cargo-inputs cargo-inputs) + ,@(maybe-arguments (append '(#:skip-build? #t) + (maybe-cargo-inputs cargo-inputs) (maybe-cargo-development-inputs cargo-development-inputs))) (home-page ,(match home-page @@ -176,7 +188,7 @@ and LICENSE." ((license) license) (_ `(list ,@license))))))) (close-port port) - pkg)) + (package->definition pkg #t))) (define (string->license string) (filter-map (lambda (license) @@ -190,11 +202,17 @@ and LICENSE." (define* (crate->guix-package crate-name #:key version repo) "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, attempt to fetch that version; otherwise fetch the -latest version of CRATE-NAME." +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." + + (define (semver-range-contains-string? range version) + (semver-range-contains? (string->semver-range range) + (string->semver version))) (define (normal-dependency? dependency) - (eq? (crate-dependency-kind dependency) 'normal)) + (or (eq? (crate-dependency-kind dependency) 'build) + (eq? (crate-dependency-kind dependency) 'normal))) (define crate (lookup-crate crate-name)) @@ -204,22 +222,45 @@ latest version of CRATE-NAME." (or version (crate-latest-version crate)))) + ;; find the highest version of a crate that fulfills the semver <range> + (define (find-crate-version crate range) + (let* ((semver-range (string->semver-range range)) + (versions + (sort + (filter (lambda (entry) + (semver-range-contains? semver-range (first entry))) + (map (lambda (ver) + (list (string->semver (crate-version-number ver)) + ver)) + (crate-versions crate))) + (match-lambda* (((semver _) ...) + (apply semver<? semver)))))) + (and (not (null-list? versions)) + (second (last versions))))) + (define version* (and crate - (find (lambda (version) - (string=? (crate-version-number version) - version-number)) - (crate-versions crate)))) + (find-crate-version crate version-number))) + + ;; sort and map the dependencies to a list containing + ;; pairs of (name version) + (define (sort-map-dependencies deps) + (sort (map (lambda (dep) + (let* ((name (crate-dependency-id dep)) + (crate (lookup-crate name)) + (req (crate-dependency-requirement dep)) + (ver (find-crate-version crate req))) + (list name + (crate-version-number ver)))) + deps) + (match-lambda* (((name _) ...) + (apply string-ci<? name))))) (and crate version* - (let* ((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<?))) + (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 '())) (values (make-crate-sexp #:name crate-name #:version (crate-version-number version*) @@ -251,7 +292,7 @@ latest version of CRATE-NAME." ((name _ ...) name)))) (define (crate-name->package-name name) - (string-append "rust-" (string-join (string-split name #\_) "-"))) + (guix-name "rust-" name)) ;;; diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 895fbb11a8..10eb030188 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -229,13 +229,20 @@ into a proper sentence and by using two spaces between sentences." cleaned 'pre ". " 'post))) (define* (package-names->package-inputs names #:optional (output #f)) - "Given a list of PACKAGE-NAMES, and an optional OUTPUT, tries to generate a -quoted list of inputs, as suitable to use in an 'inputs' field of a package -definition." - (map (lambda (input) - (cons* input (list 'unquote (string->symbol input)) - (or (and output (list output)) - '()))) + "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)) + (input (make-input input #f))) names)) (define* (maybe-inputs package-names #:optional (output #f)) diff --git a/guix/scripts/import/crate.scm b/guix/scripts/import/crate.scm index 9c4286f8bd..33dae56561 100644 --- a/guix/scripts/import/crate.scm +++ b/guix/scripts/import/crate.scm @@ -2,7 +2,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 David Thompson <davet@gnu.org> ;;; Copyright © 2016 David Craven <david@craven.ch> -;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net> +;;; Copyright © 2019, 2020 Martin Becze <mjbecze@riseup.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -95,19 +95,14 @@ Import and convert the crate.io package for PACKAGE-NAME.\n")) (package-name->name+version spec)) (if (assoc-ref opts 'recursive) - (map (match-lambda - ((and ('package ('name name) . rest) pkg) - `(define-public ,(string->symbol name) - ,pkg)) - (_ #f)) - (crate-recursive-import name #:version version)) + (crate-recursive-import name #:version version) (let ((sexp (crate->guix-package name #:version version))) (unless sexp (leave (G_ "failed to download meta-data for package '~a'~%") (if version (string-append name "@" version) name))) - sexp))) + (list sexp)))) (() (leave (G_ "too few arguments~%"))) ((many ...) |