From d3130d97a02f29bfe388650fe40131aa5c762f04 Mon Sep 17 00:00:00 2001 From: Martin Becze Date: Mon, 16 Dec 2019 17:33:50 -0500 Subject: [PATCH v5 2/4] guix: import: crate: crate-recusive-import, use recusive-import-semver * guix/import/crate.scm (crate-recusive-import): use recusive-import-semver * guix/import/crate.scm (make-crate-sexp)[argumnets]: use and * guix/import/crate.scm (crate-version-dependencies): dedup dependencies * guix/test/crate.scm: updated test --- guix/import/crate.scm | 175 +++++++++++++++++-------------- tests/crate.scm | 232 ++++++++++++++++++++++++------------------ 2 files changed, 229 insertions(+), 178 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 4c3f8000d0..3e5b022873 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -38,6 +38,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 crate-recursive-import @@ -85,7 +86,7 @@ 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 @@ -108,13 +109,22 @@ record or #f if it was not found." "Return the list of records of VERSION, a ." (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))) - (_ - '())))) - + (url (string-append (%crate-base-url) path)) + (deps-list (match (assoc-ref (or (json-fetch url) '()) "dependencies") + ((? vector? vector) (vector->list vector)) + (_ + '()))) + ;; turn the raw list into 's and remove dev depenedencies + (deps (filter-map (lambda (json) + (let ((dep (json->crate-dependency json))) + (if (eq? (crate-dependency-kind dep) 'dev) + #f + dep))) + deps-list))) + ;;remove duplicate dependencies + (apply lset-adjoin `(,(lambda (a b) + (string-ci=? (crate-dependency-id a) (crate-dependency-id b))) + () ,@deps)))) ;;; ;;; Converting crates to Guix packages. @@ -141,42 +151,55 @@ record or #f if it was not found." ((args ...) `((arguments (,'quasiquote ,args)))))) -(define* (make-crate-sexp #:key name version cargo-inputs cargo-development-inputs - home-page synopsis description license - #:allow-other-keys) - "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." - (let* ((port (http-fetch (crate-uri name version))) +(define (make-crate-sexp crate version* dependencies) + "Return the `package' s-expression for a rust package given , + and a list of " + (define normal-dependency? + (match-lambda ((_ dep) (not (eq? (crate-dependency-kind dep) 'dev))))) + + (let* ((dep-crates dev-dep-crates (partition normal-dependency? dependencies)) + (cargo-inputs (sort (unzip1 dep-crates) + string-ci (crate-version-license version*) + string->license)) + (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)) (pkg `(package - (name ,guix-name) - (version ,version) - (source (origin - (method url-fetch) - (uri (crate-uri ,name version)) - (file-name (string-append name "-" version ".tar.gz")) - (sha256 - (base32 - ,(bytevector->nix-base32-string (port-sha256 port)))))) - (build-system cargo-build-system) - ,@(maybe-arguments (append (maybe-cargo-inputs cargo-inputs) - (maybe-cargo-development-inputs - cargo-development-inputs))) - (home-page ,(match home-page - (() "") - (_ home-page))) - (synopsis ,synopsis) - (description ,(beautify-description description)) - (license ,(match license - (() #f) - ((license) license) - (_ `(list ,@license))))))) - (close-port port) - pkg)) + (name ,guix-name) + (version ,version) + (source (origin + (method url-fetch) + (uri (crate-uri ,name version)) + (file-name (string-append name "-" version ".crate")) + (sha256 + (base32 + ,(bytevector->nix-base32-string (port-sha256 port)))))) + (build-system cargo-build-system) + ,@(maybe-arguments (append `(#:skip-build? #t) + (maybe-cargo-inputs cargo-inputs) + (maybe-cargo-development-inputs + cargo-development-inputs))) + (home-page ,(match home-page + (() "") + (_ home-page))) + (synopsis ,synopsis) + (description ,(beautify-description description)) + (license ,(match license + (() #f) + ((license) license) + (_ `(list ,@license))))))) + + (close-port port) + pkg)) (define (string->license string) (filter-map (lambda (license) @@ -187,15 +210,24 @@ and LICENSE." 'unknown-license!))) (string-split string (string->char-set " /")))) +(define (crate->crate-version crate version-number) + "returns the for a given CRATE and VERSION-NUMBER" + (find (lambda (version) + (string=? (crate-version-number version) + version-number)) + (crate-versions crate))) + +(define (crate->versions crate) + "Returns a list of versions for a given CRATE" + (map (lambda (version) + (crate-version-number version)) + (crate-versions crate))) + (define* (crate->guix-package crate-name #:optional version) "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." - - (define (normal-dependency? dependency) - (eq? (crate-dependency-kind dependency) 'normal)) - (define crate (lookup-crate crate-name)) @@ -204,38 +236,28 @@ latest version of CRATE-NAME." (crate-latest-version crate))) (define version* - (find (lambda (version) - (string=? (crate-version-number version) - version-number)) - (crate-versions crate))) + (crate->crate-version crate version-number)) + + (define dependencies (map + (lambda (dep) + (list (crate-name->package-name + (crate-dependency-id dep)) dep)) + (crate-version-dependencies version*))) + (make-crate-sexp crate version* dependencies)) - (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 (crate-version-license version*) - string->license)) - (append cargo-inputs cargo-development-inputs))))) -(define (crate-recursive-import crate-name) - (recursive-import crate-name #f - #:repo->guix-package (lambda (name repo) - (crate->guix-package name)) - #:guix-name crate-name->package-name)) +(define* (crate-recursive-import name #:optional range) + (recursive-import-semver + #:name name + #:range (if range range "*") + #:name->metadata lookup-crate + #:metadata->package crate->crate-version + #:metadata-versions crate->versions + #:package-dependencies crate-version-dependencies + #:dependency-name crate-dependency-id + #:dependency-range crate-dependency-requirement + #:guix-name crate-name->package-name + #:make-sexp make-crate-sexp)) (define (guix-package->crate-name package) "Return the crate name of PACKAGE." @@ -284,4 +306,3 @@ latest version of CRATE-NAME." (description "Updater for crates.io packages") (pred crate-package?) (latest latest-release))) - diff --git a/tests/crate.scm b/tests/crate.scm index 61933a8de8..42c94b9996 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2014 David Thompson ;;; Copyright © 2016 David Craven ;;; Copyright © 2019 Ludovic Courtès +;;; Copyright © 2019 Martin Becze ;;; ;;; This file is part of GNU Guix. ;;; @@ -56,6 +57,7 @@ { \"crate_id\": \"bar\", \"kind\": \"normal\", + \"req\": \"1\" } ] }") @@ -88,18 +90,22 @@ { \"crate_id\": \"intermediate-1\", \"kind\": \"normal\", + \"req\": \"1\" }, { \"crate_id\": \"intermediate-2\", \"kind\": \"normal\", + \"req\": \"1\" } { \"crate_id\": \"leaf-alice\", \"kind\": \"normal\", + \"req\": \"1\" }, { \"crate_id\": \"leaf-bob\", \"kind\": \"normal\", + \"req\": \"1\" }, ] }") @@ -132,14 +138,17 @@ { \"crate_id\": \"intermediate-2\", \"kind\": \"normal\", + \"req\": \"1\" }, { \"crate_id\": \"leaf-alice\", \"kind\": \"normal\", + \"req\": \"1\" }, { \"crate_id\": \"leaf-bob\", \"kind\": \"normal\", + \"req\": \"1\" } ] }") @@ -172,6 +181,7 @@ { \"crate_id\": \"leaf-bob\", \"kind\": \"normal\", + \"req\": \"1\" }, ] }") @@ -268,14 +278,15 @@ ('source ('origin ('method 'url-fetch) ('uri ('crate-uri "foo" 'version)) - ('file-name ('string-append 'name "-" 'version ".tar.gz")) + ('file-name ('string-append 'name "-" 'version ".crate")) ('sha256 ('base32 (? string? hash))))) ('build-system 'cargo-build-system) ('arguments ('quasiquote - ('#:cargo-inputs (("rust-bar" ('unquote rust-bar)))))) + ('#:skip-build? #t + #:cargo-inputs (("rust-bar" ('unquote rust-bar)))))) ('home-page "http://example.com") ('synopsis "summary") ('description "summary") @@ -335,107 +346,126 @@ ("https://crates.io/api/v1/crates/leaf-bob/1.0.0/dependencies" (open-input-string test-leaf-bob-dependencies)) (_ (error "Unexpected URL: " url))))) + (match (crate-recursive-import "root") ;; rust-intermediate-2 has no dependency on the rust-leaf-alice package, so this is a valid ordering - ((('package - ('name "rust-leaf-alice") - ('version (? string? ver)) - ('source - ('origin - ('method 'url-fetch) - ('uri ('crate-uri "leaf-alice" 'version)) - ('file-name - ('string-append 'name "-" 'version ".tar.gz")) - ('sha256 - ('base32 - (? string? hash))))) - ('build-system 'cargo-build-system) - ('home-page "http://example.com") - ('synopsis "summary") - ('description "summary") - ('license ('list 'license:expat 'license:asl2.0))) - ('package - ('name "rust-leaf-bob") - ('version (? string? ver)) - ('source - ('origin - ('method 'url-fetch) - ('uri ('crate-uri "leaf-bob" 'version)) - ('file-name - ('string-append 'name "-" 'version ".tar.gz")) - ('sha256 - ('base32 - (? string? hash))))) - ('build-system 'cargo-build-system) - ('home-page "http://example.com") - ('synopsis "summary") - ('description "summary") - ('license ('list 'license:expat 'license:asl2.0))) - ('package - ('name "rust-intermediate-2") - ('version (? string? ver)) - ('source - ('origin - ('method 'url-fetch) - ('uri ('crate-uri "intermediate-2" 'version)) - ('file-name - ('string-append 'name "-" 'version ".tar.gz")) - ('sha256 - ('base32 - (? string? hash))))) - ('build-system 'cargo-build-system) - ('arguments - ('quasiquote - ('#:cargo-inputs (("rust-leaf-bob" ('unquote rust-leaf-bob)))))) - ('home-page "http://example.com") - ('synopsis "summary") - ('description "summary") - ('license ('list 'license:expat 'license:asl2.0))) - ('package - ('name "rust-intermediate-1") - ('version (? string? ver)) - ('source - ('origin - ('method 'url-fetch) - ('uri ('crate-uri "intermediate-1" 'version)) - ('file-name - ('string-append 'name "-" 'version ".tar.gz")) - ('sha256 - ('base32 - (? string? hash))))) - ('build-system 'cargo-build-system) - ('arguments - ('quasiquote - ('#:cargo-inputs (("rust-intermediate-2" ('unquote rust-intermediate-2)) - ("rust-leaf-alice" ('unquote rust-leaf-alice)) - ("rust-leaf-bob" ('unquote rust-leaf-bob)))))) - ('home-page "http://example.com") - ('synopsis "summary") - ('description "summary") - ('license ('list 'license:expat 'license:asl2.0))) - ('package - ('name "rust-root") - ('version (? string? ver)) - ('source - ('origin - ('method 'url-fetch) - ('uri ('crate-uri "root" 'version)) - ('file-name - ('string-append 'name "-" 'version ".tar.gz")) - ('sha256 - ('base32 - (? string? hash))))) - ('build-system 'cargo-build-system) - ('arguments - ('quasiquote - ('#:cargo-inputs (("rust-intermediate-1" ('unquote rust-intermediate-1)) - ("rust-intermediate-2" ('unquote rust-intermediate-2)) - ("rust-leaf-alice" ('unquote rust-leaf-alice)) - ("rust-leaf-bob" ('unquote rust-leaf-bob)))))) - ('home-page "http://example.com") - ('synopsis "summary") - ('description "summary") - ('license ('list 'license:expat 'license:asl2.0)))) + ((('define-public 'rust-intermediate-1-1.0.0 + ('package + ('name "rust-intermediate-1") + ('version (? string? ver)) + ('source + ('origin + ('method 'url-fetch) + ('uri ('crate-uri "intermediate-1" 'version)) + ('file-name + ('string-append 'name "-" 'version ".crate")) + ('sha256 + ('base32 + (? string? hash))))) + ('build-system 'cargo-build-system) + ('arguments + ('quasiquote + ('#:skip-build? #t + '#:cargo-inputs (("rust-intermediate-2-1.0.0" ('unquote rust-intermediate-2-1.0.0)) + ("rust-leaf-alice-1.0.0" ('unquote rust-leaf-alice-1.0.0)) + ("rust-leaf-bob-1.0.0" ('unquote rust-leaf-bob-1.0.0)))))) + ('home-page "http://example.com") + ('synopsis "summary") + ('description "summary") + ('license ('list 'license:expat 'license:asl2.0)))) + ('define-public 'rust-intermediate-2-1.0.0 + ('package + ('name "rust-intermediate-2") + ('version (? string? ver)) + ('source + ('origin + ('method 'url-fetch) + ('uri ('crate-uri "intermediate-2" 'version)) + ('file-name + ('string-append 'name "-" 'version ".crate")) + ('sha256 + ('base32 + (? string? hash))))) + ('build-system 'cargo-build-system) + ('arguments + ('quasiquote + ('#:skip-build? #t + '#:cargo-inputs (("rust-leaf-bob-1.0.0" ('unquote rust-leaf-bob-1.0.0)))))) + ('home-page "http://example.com") + ('synopsis "summary") + ('description "summary") + ('license ('list 'license:expat 'license:asl2.0)))) + ('define-public 'rust-leaf-alice-1.0.0 + ('package + ('name "rust-leaf-alice") + ('version (? string? ver)) + ('source + ('origin + ('method 'url-fetch) + ('uri ('crate-uri "leaf-alice" 'version)) + ('file-name + ('string-append 'name "-" 'version ".crate")) + ('sha256 + ('base32 + (? string? hash))))) + ('build-system 'cargo-build-system) + ('arguments + ('quasiquote + ('#:skip-build? #t))) + ('home-page "http://example.com") + ('synopsis "summary") + ('description "summary") + ('license ('list 'license:expat 'license:asl2.0)))) + ('define-public 'rust-leaf-bob-1.0.0 + ('package + ('name "rust-leaf-bob") + ('version (? string? ver)) + ('source + ('origin + ('method 'url-fetch) + ('uri ('crate-uri "leaf-bob" 'version)) + ('file-name + ('string-append 'name "-" 'version ".crate")) + ('sha256 + ('base32 + (? string? hash))))) + ('build-system 'cargo-build-system) + ('arguments + ('quasiquote + ('#:skip-build? #t))) + ('home-page "http://example.com") + ('synopsis "summary") + ('description "summary") + ('license ('list 'license:expat 'license:asl2.0)))) + ('define-public 'rust-root-1.0.0 + ('package + ('name "rust-root") + ('version (? string? ver)) + ('source + ('origin + ('method 'url-fetch) + ('uri ('crate-uri "root" 'version)) + ('file-name + ('string-append 'name "-" 'version ".crate")) + ('sha256 + ('base32 + (? string? hash))))) + ('build-system 'cargo-build-system) + ('arguments + ('quasiquote + ('#:skip-build? #t + '#:cargo-inputs (("rust-intermediate-1-1.0.0" + ('unquote rust-intermediate-1-1.0.0)) + ("rust-intermediate-2-1.0.0" + ('unquote rust-intermediate-2-1.0.0)) + ("rust-leaf-alice-1.0.0" + ('unquote rust-leaf-alice-1.0.0)) + ("rust-leaf-bob-1.0.0" + ('unquote rust-leaf-bob-1.0.0)))))) + ('home-page "http://example.com") + ('synopsis "summary") + ('description "summary") + ('license ('list 'license:expat 'license:asl2.0))))) #t) (x (pk 'fail x #f))))) -- 2.24.1