From patchwork Tue Aug 6 03:42:32 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Brian Leung X-Patchwork-Id: 14874 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 305DD1724B; Tue, 6 Aug 2019 04:44:09 +0100 (BST) 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,FREEMAIL_FROM, HTML_MESSAGE,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 AB6A71723E for ; Tue, 6 Aug 2019 04:44:08 +0100 (BST) Received: from localhost ([::1]:58332 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1huqOO-0003ib-C9 for patchwork@mira.cbaines.net; Mon, 05 Aug 2019 23:44:08 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:33178) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1huqOJ-0003iV-H0 for guix-patches@gnu.org; Mon, 05 Aug 2019 23:44:05 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1huqOH-00038v-SK for guix-patches@gnu.org; Mon, 05 Aug 2019 23:44:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:55563) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1huqOH-00038r-Km for guix-patches@gnu.org; Mon, 05 Aug 2019 23:44:01 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1huqOH-0008M0-I6 for guix-patches@gnu.org; Mon, 05 Aug 2019 23:44:01 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#35813] [PATCH] Add crate-recursive-import. Resent-From: Brian Leung Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 06 Aug 2019 03:44:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 35813 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 35813@debbugs.gnu.org Received: via spool by 35813-submit@debbugs.gnu.org id=B35813.156506299632039 (code B ref 35813); Tue, 06 Aug 2019 03:44:01 +0000 Received: (at 35813) by debbugs.gnu.org; 6 Aug 2019 03:43:16 +0000 Received: from localhost ([127.0.0.1]:36151 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1huqNY-0008Kd-6I for submit@debbugs.gnu.org; Mon, 05 Aug 2019 23:43:16 -0400 Received: from mail-qk1-f170.google.com ([209.85.222.170]:37840) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1huqNW-0008KL-Bg for 35813@debbugs.gnu.org; Mon, 05 Aug 2019 23:43:15 -0400 Received: by mail-qk1-f170.google.com with SMTP id d15so61821422qkl.4 for <35813@debbugs.gnu.org>; Mon, 05 Aug 2019 20:43:14 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=mime-version:references:in-reply-to:from:date:message-id:subject:to; bh=t9FwSg07Utq8zuRoaGOHtVRKNFNtHGMzqIjJl1rsXQo=; b=PwyX8GpCugsXLZAmyQ27NkxIJjvMgc/fyUULzpZrqkg4Jvk2vR/39pzz55kim/FRyh 0fp5SZvwY39qUMSHg4DGc6SlpHM2aQQEkozImhn6fuznVzyaZqWHTZ+L9YwFG6swvpLg bzL3okZTG/3iz9ac+vRJrA0G0m+/uS+MyYN6FePPOGCEb5hMrmHKVQ4cUOaog9SbT+XM uq4KjDkLMxY5Imai7CDJKtcYblpA5CFmM4cs6h7Jrlddjh3c/S/6kz83lNwjo4/TpP9X IV/yBD22jTNCmN6GangPjbrj6FddgNNa/EmSB90u2vjjIP1/zq9RMqzGbvlhvLBu4eyp SPSA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:mime-version:references:in-reply-to:from:date :message-id:subject:to; bh=t9FwSg07Utq8zuRoaGOHtVRKNFNtHGMzqIjJl1rsXQo=; b=VWz8MHCg9hugeXuFH75mlnEKGpKyQL2J2xuI10BRisFQkbKdwxzKVMJAXpdwSaGezc Nk7NXW0MbwLhheTRnWok8aNx+aHDJTBeBP0rHzKYJuQBh1u+0nCM3GWbdA+fCMhjCx7w mtla+fjINpefe36g9tWUavzGm9GG/99Yg6LBWkj++O1RCmjg3q0ECA/TYzfcH9tABKWl YNW28L0i1KmfnMMYYreRh8yk+n27SXVdUUAlnwYIOb4rLip7mhbONWLvpPFsAa2JNV5c +CAWJ1MdUhgpU0Cv3zSeDud+bWpxq9LcVz+dlknJgwtK0ovBDVlfaKM4LMKSXn5oDTLX lQWw== X-Gm-Message-State: APjAAAWG0oiwGezhJaolafaiMgKMNKgzS7QlVgplPKlFk144GUSJUBgH 4tNn9mBlCMT74+TupADuLN9+EVGiF8Vsx9uM/RNMPoIB X-Google-Smtp-Source: APXvYqwhBc8+uRd+4n104fbJo0rajPGu8N20aZpLIqX+aS/H4Gy2DCdgdgnY/qFL7XRWqIj6cWYuJePBc0JPOxYuDuA= X-Received: by 2002:a05:620a:70f:: with SMTP id 15mr1395876qkc.171.1565062988664; Mon, 05 Aug 2019 20:43:08 -0700 (PDT) MIME-Version: 1.0 References: In-Reply-To: From: Brian Leung Date: Tue, 6 Aug 2019 05:42:32 +0200 Message-ID: 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 OK, I updated to remove print statements I missed. On Mon, Aug 5, 2019 at 7:50 PM Brian Leung wrote: > I took Karl's changes and updated them accordingly. I've also added a > small test. The patch containing his importer, my changes, and my test is > attached (the commit was made using my name--not sure if I should instead > apply Karl's patch). > From a3528e0b3333864528805150a16caad88c07fd7a Mon Sep 17 00:00:00 2001 From: Brian Leung Date: Sat, 20 Jul 2019 21:35:14 +0200 Subject: [PATCH] gnu: Add crate-recursive-import. * guix/import/crate.scm (crate-recursive-import): New variable. * guix/script/import/crate.scm: Add recursive option. * guix/tests/crate.scm (crate-recursive-import): New test. --- --- guix/import/crate.scm | 28 +++++++---- guix/scripts/import/crate.scm | 28 +++++++++-- tests/crate.scm | 92 +++++++++++++++++++++++++++++++++-- 3 files changed, 129 insertions(+), 19 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 52c5cb1c30..355f0264bc 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -36,6 +36,7 @@ #:use-module (srfi srfi-2) #:use-module (srfi srfi-26) #:export (crate->guix-package + crate-recursive-import guix-package->crate-name %crate-updater)) @@ -109,8 +110,8 @@ VERSION, CARGO-INPUTS, CARGO-DEVELOPMENT-INPUTS, HOME-PAGE, SYNOPSIS, DESCRIPTIO and LICENSE." (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 + (inputs (map crate-name->package-name cargo-inputs)) + (development-inputs (map crate-name->package-name cargo-development-inputs)) (pkg `(package (name ,guix-name) @@ -123,9 +124,9 @@ 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 (maybe-cargo-inputs inputs) (maybe-cargo-development-inputs - cargo-development-inputs))) + development-inputs))) (home-page ,(match home-page (() "") (_ home-page))) @@ -136,12 +137,19 @@ and LICENSE." ((license) license) (_ `(list ,@license))))))) (close-port port) - pkg)) - -(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)) + (values pkg (append cargo-development-inputs cargo-inputs)))) + +(define crate->guix-package + (memoize + (lambda* (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* (crate-recursive-import package-name) + (recursive-import package-name #f + #:repo->guix-package (lambda (name _) (crate->guix-package name)) + #:guix-name crate-name->package-name)) (define (guix-package->crate-name package) "Return the crate name of PACKAGE." diff --git a/guix/scripts/import/crate.scm b/guix/scripts/import/crate.scm index cab9a4397b..b18cab8286 100644 --- a/guix/scripts/import/crate.scm +++ b/guix/scripts/import/crate.scm @@ -27,6 +27,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-37) + #:use-module (srfi srfi-41) #:use-module (ice-9 match) #:use-module (ice-9 format) #:export (guix-import-crate)) @@ -45,6 +46,8 @@ Import and convert the crate.io package for PACKAGE-NAME.\n")) (display (G_ " -h, --help display this help and exit")) (display (G_ " + -r, --recursive import packages recursively")) + (display (G_ " -V, --version display version information and exit")) (newline) (show-bug-report-information)) @@ -58,6 +61,9 @@ Import and convert the crate.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))) %standard-import-options)) @@ -83,11 +89,23 @@ Import and convert the crate.io package for PACKAGE-NAME.\n")) (reverse opts)))) (match args ((package-name) - (let ((sexp (crate->guix-package package-name))) - (unless sexp - (leave (G_ "failed to download meta-data for package '~a'~%") - package-name)) - sexp)) + (if (assoc-ref opts 'recursive) + ;; Recursive import + (map (match-lambda + ((and ('package ('name name) . rest) pkg) + `(define-public ,(string->symbol name) + ,pkg)) + (_ #f)) + (reverse + (stream->list + (crate-recursive-import package-name)))) + ;; Single import + (let ((sexp (crate->guix-package package-name ;; #f + ))) + (unless sexp + (leave (G_ "failed to download meta-data for package '~a'~%") + package-name)) + sexp))) (() (leave (G_ "too few arguments~%"))) ((many ...) diff --git a/tests/crate.scm b/tests/crate.scm index 72c3a13350..1787d4f2f6 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -25,9 +25,10 @@ #:use-module (guix tests) #:use-module (ice-9 iconv) #:use-module (ice-9 match) + #:use-module (srfi srfi-41) #:use-module (srfi srfi-64)) -(define test-crate +(define test-foo-crate "{ \"crate\": { \"max_version\": \"1.0.0\", @@ -39,7 +40,7 @@ } }") -(define test-dependencies +(define test-foo-dependencies "{ \"dependencies\": [ { @@ -49,6 +50,23 @@ ] }") +(define test-bar-crate + "{ + \"crate\": { + \"max_version\": \"1.0.0\", + \"name\": \"bar\", + \"license\": \"MIT/Apache-2.0\", + \"description\": \"summary\", + \"homepage\": \"http://example.com\", + \"repository\": \"http://example.com\", + } +}") + +(define test-bar-dependencies + "{ + \"dependencies\": [] +}") + (define test-source-hash "") @@ -68,14 +86,14 @@ (lambda (url . rest) (match url ("https://crates.io/api/v1/crates/foo" - (open-input-string test-crate)) + (open-input-string test-foo-crate)) ("https://crates.io/api/v1/crates/foo/1.0.0/download" (set! test-source-hash (bytevector->nix-base32-string (sha256 (string->bytevector "empty file\n" "utf-8")))) (open-input-string "empty file\n")) ("https://crates.io/api/v1/crates/foo/1.0.0/dependencies" - (open-input-string test-dependencies)) + (open-input-string test-foo-dependencies)) (_ (error "Unexpected URL: " url))))) (match (crate->guix-package "foo") (('package @@ -100,4 +118,70 @@ (x (pk 'fail x #f))))) +(test-assert "cargo-recursive-import" + ;; Replace network resources with sample data. + (mock ((guix http-client) http-fetch + (lambda (url . rest) + (match url + ("https://crates.io/api/v1/crates/foo" + (open-input-string test-foo-crate)) + ("https://crates.io/api/v1/crates/foo/1.0.0/download" + (set! test-source-hash + (bytevector->nix-base32-string + (sha256 (string->bytevector "empty file\n" "utf-8")))) + (open-input-string "empty file\n")) + ("https://crates.io/api/v1/crates/foo/1.0.0/dependencies" + (open-input-string test-foo-dependencies)) + ("https://crates.io/api/v1/crates/bar" + (open-input-string test-bar-crate)) + ("https://crates.io/api/v1/crates/bar/1.0.0/download" + (set! test-source-hash + (bytevector->nix-base32-string + (sha256 (string->bytevector "empty file\n" "utf-8")))) + (open-input-string "empty file\n")) + ("https://crates.io/api/v1/crates/bar/1.0.0/dependencies" + (open-input-string test-bar-dependencies)) + (_ (error "Unexpected URL: " url))))) + (match (stream->list (crate-recursive-import "foo")) + ((('package + ('name "rust-foo") + ('version (? string? ver)) + ('source + ('origin + ('method 'url-fetch) + ('uri ('crate-uri "foo" 'version)) + ('file-name + ('string-append 'name "-" 'version ".tar.gz")) + ('sha256 + ('base32 + (? string? hash))))) + ('build-system 'cargo-build-system) + ('arguments + ('quasiquote + ('#:cargo-inputs (("rust-bar" ('unquote rust-bar)))))) + ('home-page "http://example.com") + ('synopsis "summary") + ('description "summary") + ('license ('list 'license:expat 'license:asl2.0))) + ('package + ('name "rust-bar") + ('version (? string? ver)) + ('source + ('origin + ('method 'url-fetch) + ('uri ('crate-uri "bar" '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)))) + #t) + (x + (pk 'fail x #f))))) + (test-end "crate") -- 2.22.0