From patchwork Tue Dec 3 23:06:51 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Brian Leung X-Patchwork-Id: 16378 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 3E43617838; Wed, 4 Dec 2019 17:00:05 +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,FREEMAIL_FROM, HTML_MESSAGE,TVD_RCVD_SPACE_BRACKET,T_DKIM_INVALID,UNPARSEABLE_RELAY, 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 0CB9D17834 for ; Wed, 4 Dec 2019 17:00:04 +0000 (GMT) Received: from localhost ([::1]:41444 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1icY0R-0001OS-68 for patchwork@mira.cbaines.net; Wed, 04 Dec 2019 12:00:03 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:39980) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1icXs1-0002r3-D5 for guix-patches@gnu.org; Wed, 04 Dec 2019 11:51:26 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1icXrm-0007PE-Di for guix-patches@gnu.org; Wed, 04 Dec 2019 11:51:12 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:36580) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1icXrk-0007CF-Py for guix-patches@gnu.org; Wed, 04 Dec 2019 11:51:06 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1icXri-00085o-P0 for guix-patches@gnu.org; Wed, 04 Dec 2019 11:51:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#37730] [PATCH] Topologically sort recursively-imported packages Resent-From: Brian Leung Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 04 Dec 2019 16:51:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 37730 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Ludovic =?utf-8?q?Court=C3=A8s?= , Efraim Flashner Received: via spool by 37730-submit@debbugs.gnu.org id=B37730.157547824231071 (code B ref 37730); Wed, 04 Dec 2019 16:51:02 +0000 Received: (at 37730) by debbugs.gnu.org; 4 Dec 2019 16:50:42 +0000 Received: from localhost ([127.0.0.1]:42552 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1icXrK-000850-Gn for submit@debbugs.gnu.org; Wed, 04 Dec 2019 11:50:42 -0500 Received: from eggs.gnu.org ([209.51.188.92]:58890) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1icXrI-00084b-7P for 37730@debbugs.gnu.org; Wed, 04 Dec 2019 11:50:37 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]:50499) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1icXr9-0002wK-Sn for 37730@debbugs.gnu.org; Wed, 04 Dec 2019 11:50:28 -0500 Received: from [160.174.176.236] (port=48136 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1icXr6-0007p1-Su for 37730@debbugs.gnu.org; Wed, 04 Dec 2019 11:50:26 -0500 Resent-To: 37730@debbugs.gnu.org Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Resent-Date: Wed, 04 Dec 2019 17:50:21 +0100 Resent-Message-ID: <87blsodohe.fsf@gnu.org> Received: from solo.fdn.fr ([unix socket]) by solo (Cyrus 2.5.10-Debian-2.5.10-3.2) with LMTPA; Wed, 04 Dec 2019 00:07:42 +0100 X-Sieve: CMU Sieve 2.4 Received: by solo.fdn.fr (Postfix) id 75F92D0AE4; Wed, 4 Dec 2019 00:07:42 +0100 (CET) Received: from eggs.gnu.org (eggs.gnu.org [IPv6:2001:470:142:3::10]) (using TLSv1 with cipher AES256-SHA (256/256 bits)) (Client did not present a certificate) by solo.fdn.fr (Postfix) with ESMTPS id 22800D0AE0 for ; Wed, 4 Dec 2019 00:07:42 +0100 (CET) Received: from fencepost.gnu.org ([2001:470:142:3::e]:37961) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1icHGf-0005IU-0Y for ludovic.courtes@fdn.fr; Tue, 03 Dec 2019 18:07:41 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:48027) by fencepost.gnu.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1icHGd-0002Yn-3d for ludo@gnu.org; Tue, 03 Dec 2019 18:07:40 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1icHGX-0005Bq-CG for ludo@gnu.org; Tue, 03 Dec 2019 18:07:37 -0500 Received: from mail-qk1-x72f.google.com ([2607:f8b0:4864:20::72f]:42180) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1icHGT-000581-FA for ludo@gnu.org; Tue, 03 Dec 2019 18:07:31 -0500 Received: by mail-qk1-x72f.google.com with SMTP id a10so5262372qko.9 for ; Tue, 03 Dec 2019 15:07:28 -0800 (PST) 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=o5+uBDLq3SiwpAvO0VruqQ9nbez5Hs69emtBrqe8f6c=; b=lrzFaignhGYmkW7z0zAJkbYV9wLObJ4m3cdAPBB9KecVAE3EwR0GKHtVD3cMImKdxk CeyGB9inz5lbMzVelLyJlIhD96WbP3pig46VyV8k3HVvWy33Rvch0qxWmBmyG2PQknev 1RGiQPMbey7RF+KS3Ou+A8whcqfrwgDIxR6GMHfXRXHDQ3eYAub+V5LrGskRPTgFJFT5 XIAy+Q0ipH5MKm1A3xYgilFN8DG47vRL2HsXa1go0lHL6H1TRy497ZbCGETfJXRBR9rI uNhtvZloP4PjSke0/PwQ6OK+L4+G5+HMg0zFtp+4sdSGS0L6ecwJn7j73X2/xdD6b/np 3vjg== 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=o5+uBDLq3SiwpAvO0VruqQ9nbez5Hs69emtBrqe8f6c=; b=HylrqA9bSGZbRewyg0ibVLXkvz70ZDziBmO3Z1d+LA7N0rctdoL64m12gYjQARVd5R iUkGgunwgX0i/R4RlFK0HXpwZbVOMELFF9YDv6vJQ79PqnIEcgnKChxuIYSRGBzQEfGo NhInDyR96sMGy0PgY8DMZgIw8iQyapuHdJv80/MCs/74M1srugFI4YFxhUFiinWB9R/z 03nAMWap+erWQPC1vYF0WyK8EEG3IiFtsYdhXR1yLvnirw4spEHXSooazD6Wr4IbCD0P ZPnX3YzZXhcEm4o43rGKzthIip741VEnaQWXJyTofSE65zb3DwvB6v9wq41W9uHVf8Ov alDw== X-Gm-Message-State: APjAAAXibPknKZ4D/1Zk2BLg8/dNXRXr8IwE5i3HH48fXOqlcNhoptr6 lItD0l8I1OLpGnKX2q4fPHZ2GvVtYnMJuB8ILNZ5Tw== X-Google-Smtp-Source: APXvYqxT/figfH9L4jx1Rl+Sbes9bI7zerfbASFyl4yfWfRoifwtyNxyp2XfjcN3olkdsdyFymR1/O6yk7rfJay/cvo= X-Received: by 2002:a37:6481:: with SMTP id y123mr7955421qkb.171.1575414447755; Tue, 03 Dec 2019 15:07:27 -0800 (PST) MIME-Version: 1.0 References: <87lfti5rip.fsf@gnu.org> In-Reply-To: From: Brian Leung Date: Tue, 3 Dec 2019 15:06:51 -0800 Message-ID: X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] 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 Attached is a small edit to clarify the shape of something and rename accordingly. On Tue, Dec 3, 2019 at 2:03 PM Brian Leung wrote: > Hi Ludo, > > Sorry for putting this off; my Guix installation got corrupted and I > wasn't able to roll back. I'm writing this from within VirtualBox. > > In the attached patch I've addressed most of your concerns, except for > this one: > > > Regarding tests, you could make the topological sort code above a > > separate procedure, and write a couple of tests that call it. > > I don't see how this would help. We would have to pass it the > `repo->guix-package` function and the `repo` variable as an arguments that > remain the same across all the tail-recursive invocations of `topo-sort`, > which would make it harder to read. And we'd have to come up with some > custom `repo->guix-package` function, when we already have one for the > (say) Crate test. > > Efraim: I recall you mentioning a while back that topologically sorted > output would be nice to have. Please confirm this patch works as expected > for you. > > Thanks, > Brian > > On Fri, Oct 18, 2019 at 2:31 AM Ludovic Courtès wrote: > >> Hi Brian, >> >> Brian Leung skribis: >> >> > From 6fec6a72a7938753307ccf3b7bdad8bff72e47f9 Mon Sep 17 00:00:00 2001 >> > From: Brian Leung >> > Date: Fri, 11 Oct 2019 23:18:03 -0700 >> > Subject: [PATCH] guix: utils: Topologically sort recursively-imported >> recipes. >> > >> > This output order, when it is well-defined, facilitates the process of >> > deciding what to upstream next for a package with a large dependency >> closure. >> >> That’s a great idea! >> >> > * guix/import/utils.scm (recursive-import): Enforce topological sort. >> > Remove dependency on srfi-41. Reverse output here instead of in >> individual >> > importers. >> > * guix/scripts/import/cran.scm (guix-import-cran): Unstreamify and don't >> > reverse here. Remove dependency on srfi-41. >> >> Instead of “Unstreamify”, please write precisely what has changed, like >> “Remove call to ‘stream-fold’ and call ‘foobar’ directly.”, “Remove call >> to ‘stream->list’.”, etc. >> >> > + (define graph (make-hash-table)) >> > + (define recipe-map (make-hash-table)) >> > + (define stack (list package-name)) >> > + (define accum '()) >> > + >> > + (while (not (null? stack)) >> > + (let ((package-name (car stack))) >> > + (match (hash-ref graph package-name) >> > + ('() >> > + (set! stack (cdr stack)) >> > + (set! accum (cons (hash-ref recipe-map package-name) accum))) >> > + ((dep . rest) >> > + (define (handle? dep) >> > + (and >> > + (not (equal? dep package-name)) >> > + (not (hash-ref recipe-map dep)) >> > + (not (exists? dep)))) >> > + (hash-set! graph package-name rest) >> > + (when (handle? dep) >> > + (set! stack (cons dep stack)))) >> > + (#f >> > + (receive (package-recipe . dependencies) >> > + (repo->guix-package package-name repo) >> > + (hash-set! graph package-name >> > + (or (and (not (null? dependencies)) >> > + (car dependencies)) >> > + '())) >> > + (hash-set! recipe-map package-name >> > + (or package-recipe '()))))))) >> > + >> > + (reverse accum)) >> >> Do you think you could rewrite this (1) in a functional style (you can >> use vhashes instead of hash tables), and (2) using ‘match’ instead of >> ‘cdr’ & co.? >> >> That would more closely match our conventions (info "(guix) Coding >> Style") and would also probably allow for easier testing. >> >> Regarding tests, you could make the topological sort code above a >> separate procedure, and write a couple of tests that call it. >> >> WDYT? >> >> The rest LGTM. >> >> Thank you! >> >> Ludo’. >> > From 915274d493116d063bfe2a953a9e855b8312711e Mon Sep 17 00:00:00 2001 From: Brian Leung Date: Fri, 11 Oct 2019 23:18:03 -0700 Subject: [PATCH] guix: utils: Topologically sort recursively imported recipes. This output order, when it is well-defined, facilitates the process of deciding what to upstream next for a package with a large dependency closure. * guix/import/utils.scm (recursive-import): Enforce topological sort. Remove dependency on srfi-41. Import vlist module. Reverse output here instead of in individual importers. * guix/scripts/import/cran.scm (guix-import-cran): Remove calls to stream->list and reverse. Remove dependency on srfi-41. * guix/scripts/import/crate.scm (guix-import-crate): Remove calls to stream->list and reverse. Remove dependency on srfi-41. * guix/scripts/import/elpa.scm (guix-import-elpa): Remove calls to stream->list and reverse. Remove dependency on srfi-41. * guix/scripts/import/gem.scm (guix-import-gem): Remove calls to stream->list and reverse. Remove dependency on srfi-41. * guix/scripts/import/hackage.scm (guix-import-hackage): Remove calls to stream->list and reverse. Remove dependency on srfi-41. * guix/scripts/import/opam.scm (guix-import-opam): Remove calls to stream->list and reverse. Remove dependency on srfi-41. * guix/scripts/import/pypi.scm (guix-import-pypi): Remove calls to stream->list and reverse. Remove dependency on srfi-41. * guix/scripts/import/stackage.scm (guix-import-stackage): Remove calls to stream->list and reverse. Remove dependency on srfi-41. * tests/crate.scm (cargo-recursive-import): Add test. * tests/gem.scm (gem-recursive-import): Update to reflect the fact that the reversing of the list now takes place in the recursive importer. Remove dependency on srfi-41. --- guix/import/utils.scm | 86 +++++--- guix/scripts/import/cran.scm | 7 +- guix/scripts/import/crate.scm | 5 +- guix/scripts/import/elpa.scm | 7 +- guix/scripts/import/gem.scm | 5 +- guix/scripts/import/hackage.scm | 5 +- guix/scripts/import/opam.scm | 5 +- guix/scripts/import/pypi.scm | 5 +- guix/scripts/import/stackage.scm | 5 +- guix/scripts/import/texlive.scm | 1 - tests/crate.scm | 334 ++++++++++++++++++++++++++++++- tests/gem.scm | 41 ++-- 12 files changed, 413 insertions(+), 93 deletions(-) diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 4694b6e7ef..0d9e5fbfdd 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -39,10 +39,10 @@ #:use-module (ice-9 rdelim) #:use-module (ice-9 receive) #:use-module (ice-9 regex) + #:use-module (ice-9 vlist) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) - #:use-module (srfi srfi-41) #:export (factorize-uri flatten @@ -380,37 +380,57 @@ separated by PRED." (define* (recursive-import package-name repo #:key repo->guix-package guix-name #:allow-other-keys) - "Generate a stream of package expressions for PACKAGE-NAME and all its -dependencies." + "Generate a list of package expressions for PACKAGE-NAME and all its +dependencies. The list will be in a topological ordering, if one exists." (define (exists? dependency) (not (null? (find-packages-by-name (guix-name dependency))))) - (define initial-state (list #f (list package-name) (list))) - (define (step state) - (match state - ((prev (next . rest) done) - (define (handle? dep) - (and - (not (equal? dep next)) - (not (member dep done)) - (not (exists? dep)))) - (receive (package . dependencies) (repo->guix-package next repo) - (list - (if package package '()) ;; default #f on failure would interrupt - (if package - (lset-union equal? rest (filter handle? (car dependencies))) - rest) - (cons next done)))) - ((prev '() done) - (list #f '() done)))) - - ;; Generate a lazy stream of package expressions for all unknown - ;; dependencies in the graph. - (stream-unfold - ;; map: produce a stream element - (match-lambda ((latest queue done) latest)) - ;; predicate - (match-lambda ((latest queue done) latest)) - ;; generator: update the queue - step - ;; initial state - (step initial-state))) + + (define graph vlist-null) + (define recipe-map vlist-null) + (define stack (list package-name)) + (define accum '()) + + (define (topo-sort stack graph recipe-map accum) + (if (null? stack) + (reverse accum) + (let ((head-package (car stack))) + (match (vhash-assoc head-package graph) + ((key . '()) + (let ((next-stack (cdr stack)) + (next-accum (cons (cdr (vhash-assoc head-package recipe-map)) + accum))) + (topo-sort next-stack + graph + recipe-map + next-accum))) + ((key . (dep . rest)) + (define (handle? dep) + (and + (not (equal? dep head-package)) + (not (vhash-assoc dep recipe-map)) + (not (exists? dep)))) + (let* ((next-stack (if (handle? dep) + (cons dep stack) + stack)) + (next-graph (vhash-cons key rest graph))) + (topo-sort next-stack + next-graph + recipe-map + accum))) + (#f + (receive (package-recipe . dependencies) (repo->guix-package head-package repo) + (let ((next-graph (vhash-cons head-package + ;; dependencies has shape '(("package-a" "package-b" ...)) + (car dependencies) + graph)) + (next-recipe-map (vhash-cons head-package + (or + package-recipe + '()) + recipe-map))) + (topo-sort stack + next-graph + next-recipe-map + accum)))))))) + + (topo-sort stack graph recipe-map accum)) diff --git a/guix/scripts/import/cran.scm b/guix/scripts/import/cran.scm index b6592f78a9..d6f371ef3a 100644 --- a/guix/scripts/import/cran.scm +++ b/guix/scripts/import/cran.scm @@ -27,7 +27,6 @@ #: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-cran)) @@ -98,10 +97,8 @@ Import and convert the CRAN package for PACKAGE-NAME.\n")) (if (assoc-ref opts 'recursive) ;; Recursive import (map package->definition - (reverse - (stream->list - (cran-recursive-import package-name - (or (assoc-ref opts 'repo) 'cran))))) + (cran-recursive-import package-name + (or (assoc-ref opts 'repo) 'cran))) ;; Single import (let ((sexp (cran->guix-package package-name (or (assoc-ref opts 'repo) 'cran)))) diff --git a/guix/scripts/import/crate.scm b/guix/scripts/import/crate.scm index 4690cceb4d..92034dab3c 100644 --- a/guix/scripts/import/crate.scm +++ b/guix/scripts/import/crate.scm @@ -28,7 +28,6 @@ #: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)) @@ -101,9 +100,7 @@ Import and convert the crate.io package for PACKAGE-NAME.\n")) `(define-public ,(string->symbol name) ,pkg)) (_ #f)) - (reverse - (stream->list - (crate-recursive-import name)))) + (crate-recursive-import name)) (let ((sexp (crate->guix-package name version))) (unless sexp (leave (G_ "failed to download meta-data for package '~a'~%") diff --git a/guix/scripts/import/elpa.scm b/guix/scripts/import/elpa.scm index f1ed5016ba..d270d2b4bc 100644 --- a/guix/scripts/import/elpa.scm +++ b/guix/scripts/import/elpa.scm @@ -27,7 +27,6 @@ #: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-elpa)) @@ -101,10 +100,8 @@ Import the latest package named PACKAGE-NAME from an ELPA repository.\n")) `(define-public ,(string->symbol name) ,pkg)) (_ #f)) - (reverse - (stream->list - (elpa-recursive-import package-name - (or (assoc-ref opts 'repo) 'gnu))))) + (elpa-recursive-import package-name + (or (assoc-ref opts 'repo) 'gnu))) (let ((sexp (elpa->guix-package package-name (assoc-ref opts 'repo)))) (unless sexp (leave (G_ "failed to download package '~a'~%") package-name)) diff --git a/guix/scripts/import/gem.scm b/guix/scripts/import/gem.scm index b6d9ccaae4..c64596b514 100644 --- a/guix/scripts/import/gem.scm +++ b/guix/scripts/import/gem.scm @@ -26,7 +26,6 @@ #: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-gem)) @@ -95,9 +94,7 @@ Import and convert the RubyGems package for PACKAGE-NAME.\n")) `(define-public ,(string->symbol name) ,pkg)) (_ #f)) - (reverse - (stream->list - (gem-recursive-import package-name 'rubygems)))) + (gem-recursive-import package-name 'rubygems)) (let ((sexp (gem->guix-package package-name))) (unless sexp (leave (G_ "failed to download meta-data for package '~a'~%") diff --git a/guix/scripts/import/hackage.scm b/guix/scripts/import/hackage.scm index f4aac61078..710e786a79 100644 --- a/guix/scripts/import/hackage.scm +++ b/guix/scripts/import/hackage.scm @@ -27,7 +27,6 @@ #: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-hackage)) @@ -130,9 +129,7 @@ version.\n")) `(define-public ,(string->symbol name) ,pkg)) (_ #f)) - (reverse - (stream->list - (apply hackage-recursive-import arguments)))) + (apply hackage-recursive-import arguments)) ;; Single import (apply hackage->guix-package arguments)))) (unless sexp (error-fn)) diff --git a/guix/scripts/import/opam.scm b/guix/scripts/import/opam.scm index 2d249a213f..20da1437fe 100644 --- a/guix/scripts/import/opam.scm +++ b/guix/scripts/import/opam.scm @@ -25,7 +25,6 @@ #: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-opam)) @@ -94,9 +93,7 @@ Import and convert the opam package for PACKAGE-NAME.\n")) `(define-public ,(string->symbol name) ,pkg)) (_ #f)) - (reverse - (stream->list - (opam-recursive-import package-name)))) + (opam-recursive-import package-name)) ;; Single import (let ((sexp (opam->guix-package package-name))) (unless sexp diff --git a/guix/scripts/import/pypi.scm b/guix/scripts/import/pypi.scm index 7bd83818ba..33167174e2 100644 --- a/guix/scripts/import/pypi.scm +++ b/guix/scripts/import/pypi.scm @@ -26,7 +26,6 @@ #: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-pypi)) @@ -95,9 +94,7 @@ Import and convert the PyPI package for PACKAGE-NAME.\n")) `(define-public ,(string->symbol name) ,pkg)) (_ #f)) - (reverse - (stream->list - (pypi-recursive-import package-name)))) + (pypi-recursive-import package-name)) ;; Single import (let ((sexp (pypi->guix-package package-name))) (unless sexp diff --git a/guix/scripts/import/stackage.scm b/guix/scripts/import/stackage.scm index b4b12581bf..d77328dcbf 100644 --- a/guix/scripts/import/stackage.scm +++ b/guix/scripts/import/stackage.scm @@ -27,7 +27,6 @@ #: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-stackage)) @@ -110,9 +109,7 @@ Import and convert the LTS Stackage package for PACKAGE-NAME.\n")) `(define-public ,(string->symbol name) ,pkg)) (_ #f)) - (reverse - (stream->list - (apply stackage-recursive-import arguments)))) + (apply stackage-recursive-import arguments)) ;; Single import (apply stackage->guix-package arguments)))) (unless sexp (error-fn)) diff --git a/guix/scripts/import/texlive.scm b/guix/scripts/import/texlive.scm index 1cceee7051..e31c56d0ce 100644 --- a/guix/scripts/import/texlive.scm +++ b/guix/scripts/import/texlive.scm @@ -25,7 +25,6 @@ #: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-texlive)) diff --git a/tests/crate.scm b/tests/crate.scm index c14862ad9f..d55c814bcf 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -28,7 +28,7 @@ #:use-module (ice-9 match) #:use-module (srfi srfi-64)) -(define test-crate +(define test-foo-crate "{ \"crate\": { \"max_version\": \"1.0.0\", @@ -50,7 +50,7 @@ } }") -(define test-dependencies +(define test-foo-dependencies "{ \"dependencies\": [ { @@ -60,6 +60,176 @@ ] }") +(define test-root-crate + "{ + \"crate\": { + \"max_version\": \"1.0.0\", + \"name\": \"root\", + \"description\": \"summary\", + \"homepage\": \"http://example.com\", + \"repository\": \"http://example.com\", + \"keywords\": [\"dummy\" \"test\"], + \"categories\": [\"test\"] + \"actual_versions\": [ + { \"id\": \"foo\", + \"num\": \"1.0.0\", + \"license\": \"MIT OR Apache-2.0\", + \"links\": { + \"dependencies\": \"/api/v1/crates/root/1.0.0/dependencies\" + } + } + ] + } +}") + +(define test-root-dependencies + "{ + \"dependencies\": [ + { + \"crate_id\": \"intermediate-1\", + \"kind\": \"normal\", + }, + { + \"crate_id\": \"intermediate-2\", + \"kind\": \"normal\", + } + { + \"crate_id\": \"leaf-alice\", + \"kind\": \"normal\", + }, + { + \"crate_id\": \"leaf-bob\", + \"kind\": \"normal\", + }, + ] +}") + +(define test-intermediate-1-crate + "{ + \"crate\": { + \"max_version\": \"1.0.0\", + \"name\": \"intermediate-1\", + \"description\": \"summary\", + \"homepage\": \"http://example.com\", + \"repository\": \"http://example.com\", + \"keywords\": [\"dummy\" \"test\"], + \"categories\": [\"test\"] + \"actual_versions\": [ + { \"id\": \"intermediate-1\", + \"num\": \"1.0.0\", + \"license\": \"MIT OR Apache-2.0\", + \"links\": { + \"dependencies\": \"/api/v1/crates/intermediate-1/1.0.0/dependencies\" + } + } + ] + } +}") + +(define test-intermediate-1-dependencies + "{ + \"dependencies\": [ + { + \"crate_id\": \"intermediate-2\", + \"kind\": \"normal\", + }, + { + \"crate_id\": \"leaf-alice\", + \"kind\": \"normal\", + }, + { + \"crate_id\": \"leaf-bob\", + \"kind\": \"normal\", + } + ] +}") + +(define test-intermediate-2-crate + "{ + \"crate\": { + \"max_version\": \"1.0.0\", + \"name\": \"intermediate-2\", + \"description\": \"summary\", + \"homepage\": \"http://example.com\", + \"repository\": \"http://example.com\", + \"keywords\": [\"dummy\" \"test\"], + \"categories\": [\"test\"] + \"actual_versions\": [ + { \"id\": \"intermediate-2\", + \"num\": \"1.0.0\", + \"license\": \"MIT OR Apache-2.0\", + \"links\": { + \"dependencies\": \"/api/v1/crates/intermediate-2/1.0.0/dependencies\" + } + } + ] + } +}") + +(define test-intermediate-2-dependencies + "{ + \"dependencies\": [ + { + \"crate_id\": \"leaf-bob\", + \"kind\": \"normal\", + }, + ] +}") + +(define test-leaf-alice-crate + "{ + \"crate\": { + \"max_version\": \"1.0.0\", + \"name\": \"leaf-alice\", + \"description\": \"summary\", + \"homepage\": \"http://example.com\", + \"repository\": \"http://example.com\", + \"keywords\": [\"dummy\" \"test\"], + \"categories\": [\"test\"] + \"actual_versions\": [ + { \"id\": \"leaf-alice\", + \"num\": \"1.0.0\", + \"license\": \"MIT OR Apache-2.0\", + \"links\": { + \"dependencies\": \"/api/v1/crates/leaf-alice/1.0.0/dependencies\" + } + } + ] + } +}") + +(define test-leaf-alice-dependencies + "{ + \"dependencies\": [] +}") + +(define test-leaf-bob-crate + "{ + \"crate\": { + \"max_version\": \"1.0.0\", + \"name\": \"leaf-bob\", + \"description\": \"summary\", + \"homepage\": \"http://example.com\", + \"repository\": \"http://example.com\", + \"keywords\": [\"dummy\" \"test\"], + \"categories\": [\"test\"] + \"actual_versions\": [ + { \"id\": \"leaf-bob\", + \"num\": \"1.0.0\", + \"license\": \"MIT OR Apache-2.0\", + \"links\": { + \"dependencies\": \"/api/v1/crates/leaf-bob/1.0.0/dependencies\" + } + } + ] + } +}") + +(define test-leaf-bob-dependencies + "{ + \"dependencies\": [] +}") + (define test-source-hash "") @@ -79,14 +249,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 @@ -111,4 +281,160 @@ (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/root" + (open-input-string test-root-crate)) + ("https://crates.io/api/v1/crates/root/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/root/1.0.0/dependencies" + (open-input-string test-root-dependencies)) + ("https://crates.io/api/v1/crates/intermediate-1" + (open-input-string test-intermediate-1-crate)) + ("https://crates.io/api/v1/crates/intermediate-1/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/intermediate-1/1.0.0/dependencies" + (open-input-string test-intermediate-1-dependencies)) + ("https://crates.io/api/v1/crates/intermediate-2" + (open-input-string test-intermediate-2-crate)) + ("https://crates.io/api/v1/crates/intermediate-2/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/intermediate-2/1.0.0/dependencies" + (open-input-string test-intermediate-2-dependencies)) + ("https://crates.io/api/v1/crates/leaf-alice" + (open-input-string test-leaf-alice-crate)) + ("https://crates.io/api/v1/crates/leaf-alice/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/leaf-alice/1.0.0/dependencies" + (open-input-string test-leaf-alice-dependencies)) + ("https://crates.io/api/v1/crates/leaf-bob" + (open-input-string test-leaf-bob-crate)) + ("https://crates.io/api/v1/crates/leaf-bob/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/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-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-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-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)))) + #t) + (x + (pk 'fail x #f))))) + (test-end "crate") diff --git a/tests/gem.scm b/tests/gem.scm index a12edb294c..01ae8a4470 100644 --- a/tests/gem.scm +++ b/tests/gem.scm @@ -24,7 +24,6 @@ #:use-module (gcrypt hash) #:use-module (guix tests) #:use-module ((guix build utils) #:select (delete-file-recursively)) - #:use-module (srfi srfi-41) #:use-module (srfi srfi-64) #:use-module (ice-9 match)) @@ -121,27 +120,8 @@ (values (open-input-string test-bundler-json) (string-length test-bundler-json))) (_ (error "Unexpected URL: " url))))) - (match (stream->list (gem-recursive-import "foo")) + (match (gem-recursive-import "foo") ((('package - ('name "ruby-foo") - ('version "1.0.0") - ('source - ('origin - ('method 'url-fetch) - ('uri ('rubygems-uri "foo" 'version)) - ('sha256 - ('base32 - "1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk")))) - ('build-system 'ruby-build-system) - ('propagated-inputs - ('quasiquote - (("bundler" ('unquote 'bundler)) - ("ruby-bar" ('unquote 'ruby-bar))))) - ('synopsis "A cool gem") - ('description "This package provides a cool gem") - ('home-page "https://example.com") - ('license ('list 'license:expat 'license:asl2.0))) - ('package ('name "ruby-bundler") ('version "1.14.2") ('source @@ -173,6 +153,25 @@ ('synopsis "Another cool gem") ('description "Another cool gem") ('home-page "https://example.com") + ('license ('list 'license:expat 'license:asl2.0))) + ('package + ('name "ruby-foo") + ('version "1.0.0") + ('source + ('origin + ('method 'url-fetch) + ('uri ('rubygems-uri "foo" 'version)) + ('sha256 + ('base32 + "1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk")))) + ('build-system 'ruby-build-system) + ('propagated-inputs + ('quasiquote + (("bundler" ('unquote 'bundler)) + ("ruby-bar" ('unquote 'ruby-bar))))) + ('synopsis "A cool gem") + ('description "This package provides a cool gem") + ('home-page "https://example.com") ('license ('list 'license:expat 'license:asl2.0)))) #t) (x -- 2.24.0