From patchwork Thu Dec 5 20:05:33 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Martin Becze X-Patchwork-Id: 16391 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 8EC7E17851; Thu, 5 Dec 2019 20:21:20 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.0 (2014-02-07) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00,T_DKIM_INVALID, URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.0 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id DC05717850 for ; Thu, 5 Dec 2019 20:21:19 +0000 (GMT) Received: from localhost ([::1]:60600 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1icxcl-0001ng-9Q for patchwork@mira.cbaines.net; Thu, 05 Dec 2019 15:21:19 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:55598) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1icxP0-00038q-UL for guix-patches@gnu.org; Thu, 05 Dec 2019 15:07:08 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1icxOy-0007FT-Sd for guix-patches@gnu.org; Thu, 05 Dec 2019 15:07:06 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:39297) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1icxOy-0007E6-Kf for guix-patches@gnu.org; Thu, 05 Dec 2019 15:07:04 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1icxOy-0002nr-Dm for guix-patches@gnu.org; Thu, 05 Dec 2019 15:07:04 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#38408] [PATCH v2 3/5] Rewrote some of guix/import/crate.scm to use recursive-import-semver and updated script and test. Resent-From: Martin Becze Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 05 Dec 2019 20:07:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 38408 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 38408@debbugs.gnu.org Cc: Martin Becze Received: via spool by 38408-submit@debbugs.gnu.org id=B38408.157557638810680 (code B ref 38408); Thu, 05 Dec 2019 20:07:04 +0000 Received: (at 38408) by debbugs.gnu.org; 5 Dec 2019 20:06:28 +0000 Received: from localhost ([127.0.0.1]:45261 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1icxON-0002m1-LY for submit@debbugs.gnu.org; Thu, 05 Dec 2019 15:06:28 -0500 Received: from mx1.riseup.net ([198.252.153.129]:45904) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1icxOK-0002lD-1s for 38408@debbugs.gnu.org; Thu, 05 Dec 2019 15:06:25 -0500 Received: from capuchin.riseup.net (capuchin-pn.riseup.net [10.0.1.176]) (using TLSv1 with cipher ECDHE-RSA-AES256-SHA (256/256 bits)) (Client CN "*.riseup.net", Issuer "Sectigo RSA Domain Validation Secure Server CA" (not verified)) by mx1.riseup.net (Postfix) with ESMTPS id 47TRYH2TW9zFcnT for <38408@debbugs.gnu.org>; Thu, 5 Dec 2019 12:05:55 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=riseup.net; s=squak; t=1575576381; bh=/mXFFri2VLK/k5oza9VQ6xurOa3MksoTDnW4B/KLRgU=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=DiP1WIzQbR1euvdVCZr0AXcffZQR3qTQw66zXJuZWpVOOOT1xdB6yLmH+AiMCaAwi 1+EYSHktDiYoMZPpPwjJQRfGy3nyj20LxeloSgQi3kCSt+C/A79P6XMTOH2MRLKKHm /Cjb2DA9M2IBjJUEJy6xTmYaHrOmVSD5gvgsiNXQ= X-Riseup-User-ID: 7E2260EAC630EC9DA0AC8DD1181CDC0CBA7C1AAD7A31375C1DF8782F1B4C3450 Received: from [127.0.0.1] (localhost [127.0.0.1]) by capuchin.riseup.net (Postfix) with ESMTPSA id 47TRYG53sRz8tgK; Thu, 5 Dec 2019 12:05:54 -0800 (PST) From: Martin Becze Date: Thu, 5 Dec 2019 15:05:33 -0500 Message-Id: <7cccd4231b9c1327d59ff39daf2aa7dd47a2e765.1575575779.git.mjbecze@riseup.net> In-Reply-To: References: MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * guix/import/crate.scm (make-crate-sexp): Use as args * guix/import/crate.scm (crate->crate-version): New Procedure * guix/import/crate.scm (crate->versions): New Procedure * guix/import/crate.scm (crate-recursive-import): Updated to user recursive-import-semver * guix/scripts/import/crate.scm (guix-import-crate): Remove `define-public` generation from UI * guix/tests/crate.scm: Updated tests --- guix/import/crate.scm | 165 ++++++++++++++++++---------------- guix/scripts/import/crate.scm | 9 +- tests/crate.scm | 2 +- 3 files changed, 91 insertions(+), 85 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 8dc014d232..da92c43b8c 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 @@ -111,7 +112,9 @@ record or #f if it was not found." (url (string-append (%crate-base-url) path))) (match (assoc-ref (or (json-fetch url) '()) "dependencies") ((? vector? vector) - (map json->crate-dependency (vector->list vector))) + (filter (lambda (dep) + (not (eq? (crate-dependency-kind dep) 'dev))) + (map json->crate-dependency (vector->list vector)))) (_ '())))) @@ -141,62 +144,84 @@ 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))))) + + (define (string->license string) + (match (regexp-exec %dual-license-rx string) + (#f (list (spdx-string->license string))) + (m (list (spdx-string->license (match:substring m 1)) + (spdx-string->license (match:substring m 2)))))) + + (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 (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 %dual-license-rx ;; Dual licensing is represented by a string such as "MIT OR Apache-2.0". ;; This regexp matches that. (make-regexp "^(.*) OR (.*)$")) +(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 (string->license string) - (match (regexp-exec %dual-license-rx string) - (#f (list (spdx-string->license string))) - (m (list (spdx-string->license (match:substring m 1)) - (spdx-string->license (match:substring m 2)))))) - - (define (normal-dependency? dependency) - (eq? (crate-dependency-kind dependency) 'normal)) - (define crate (lookup-crate crate-name)) @@ -205,38 +230,27 @@ 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)) - (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 dependencies (map + (lambda (dep) + (list (crate-name->package-name + (crate-dependency-id dep)) dep)) + (crate-version-dependencies version*))) + (make-crate-sexp crate version* dependencies)) -(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 version) + (recursive-import-semver + #:name name + #:version version + #: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." @@ -285,4 +299,3 @@ latest version of CRATE-NAME." (description "Updater for crates.io packages") (pred crate-package?) (latest latest-release))) - diff --git a/guix/scripts/import/crate.scm b/guix/scripts/import/crate.scm index 4690cceb4d..85ae6fbe59 100644 --- a/guix/scripts/import/crate.scm +++ b/guix/scripts/import/crate.scm @@ -96,14 +96,7 @@ 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)) - (reverse - (stream->list - (crate-recursive-import name)))) + (stream->list (crate-recursive-import name version)) (let ((sexp (crate->guix-package name version))) (unless sexp (leave (G_ "failed to download meta-data for package '~a'~%") diff --git a/tests/crate.scm b/tests/crate.scm index c14862ad9f..b77cbb08c6 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -95,7 +95,7 @@ ('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)))))