From patchwork Tue Dec 3 22:03:02 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Brian Leung X-Patchwork-Id: 16379 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 4CA8717838; Wed, 4 Dec 2019 17:06:41 +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 1F2A917834 for ; Wed, 4 Dec 2019 17:06:40 +0000 (GMT) Received: from localhost ([::1]:41640 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1icY6p-0005ZO-8J for patchwork@mira.cbaines.net; Wed, 04 Dec 2019 12:06:39 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:39985) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1icXs1-0002rC-RR 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-0007Om-C4 for guix-patches@gnu.org; Wed, 04 Dec 2019 11:51:14 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:36579) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1icXrk-00071w-D0 for guix-patches@gnu.org; Wed, 04 Dec 2019 11:51:04 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1icXri-00085h-AP 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.157547823631053 (code B ref 37730); Wed, 04 Dec 2019 16:51:02 +0000 Received: (at 37730) by debbugs.gnu.org; 4 Dec 2019 16:50:36 +0000 Received: from localhost ([127.0.0.1]:42549 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1icXrE-00084i-PZ for submit@debbugs.gnu.org; Wed, 04 Dec 2019 11:50:36 -0500 Received: from eggs.gnu.org ([209.51.188.92]:58834) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1icXrB-00084R-7C for 37730@debbugs.gnu.org; Wed, 04 Dec 2019 11:50:30 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]:50497) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1icXr1-0001xy-SM for 37730@debbugs.gnu.org; Wed, 04 Dec 2019 11:50:21 -0500 Received: from [160.174.176.236] (port=48134 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1icXqs-0007oq-Ti for 37730@debbugs.gnu.org; Wed, 04 Dec 2019 11:50:16 -0500 Resent-To: 37730@debbugs.gnu.org Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Resent-Date: Wed, 04 Dec 2019 17:50:07 +0100 Resent-Message-ID: <87fti0dohs.fsf@gnu.org> Received: from solo.fdn.fr ([unix socket]) by solo (Cyrus 2.5.10-Debian-2.5.10-3.2) with LMTPA; Tue, 03 Dec 2019 23:04:01 +0100 X-Sieve: CMU Sieve 2.4 Received: by solo.fdn.fr (Postfix) id EF4BFD0AD8; Tue, 3 Dec 2019 23:04:00 +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 94A61D0A77 for ; Tue, 3 Dec 2019 23:04:00 +0100 (CET) Received: from fencepost.gnu.org ([2001:470:142:3::e]:36958) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1icGGx-00073c-M3 for ludovic.courtes@fdn.fr; Tue, 03 Dec 2019 17:03:55 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:36241) by fencepost.gnu.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1icGGw-0005eF-FB for ludo@gnu.org; Tue, 03 Dec 2019 17:03:54 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1icGGr-0006lo-8V for ludo@gnu.org; Tue, 03 Dec 2019 17:03:54 -0500 Received: from mail-qk1-x733.google.com ([2607:f8b0:4864:20::733]:47051) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1icGGp-0006BZ-RW for ludo@gnu.org; Tue, 03 Dec 2019 17:03:49 -0500 Received: by mail-qk1-x733.google.com with SMTP id f5so5074165qkm.13 for ; Tue, 03 Dec 2019 14:03:40 -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=1Rv+sNnaUkJosgf+k6Uru7HU/7gV0a1rABSpDv/l3vY=; b=ukf66pppu4aO9YrUm7s5SaEshsPXiFs6wfZamAVVSi5VjAY7SBehZKejPKAr6cRMne Vod3tsRdn4Q350J7SJVBlZMhllcOzIIqx3K5ukGpUtbkH9b0LCCdEhiJxbXfb7oittFX 6yn5jeS0x+VEYdlyr4a4fHxtYWnU6E3mhVmkD7jN5sn1usOOaM7D/8KkHGo4a7fxKGRL vUgMVeqcK2qoMm2sHYqKs06r3UmXkya78zRCLXI9cMUyQv2Awx3Z7sR/VZx+oveuNBjy A1LPGFcpYNf2V1NS+568QZykkfUGmwpvdjnMTBPmT3MDf/lOUYJqEK+xhMEROhWcGWYm t8LQ== 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=1Rv+sNnaUkJosgf+k6Uru7HU/7gV0a1rABSpDv/l3vY=; b=lqRbYF3LabIo99hJHEzC/XWrinDzlfjzjDPw9dsi6QvyaDLCKH28zG+BBoWb1npJBV 3hnTQgWMzDn58y+Egyt1zbT7Op2hKsUu2HgWMjoCNptRk6fJ+7ssAvrzEXYcRHT3X40P aLYoM5W8d2bkxucNTA/sMqRfw0yC9QuxlP1W2M+geqkFige5oVGhJAKUaSrwWkOTUEJF M6/kW3iDDuXqQylcj1VIbKS1xrDJ80s8dNwDMi/yw+l8cDtOuwGgCQp1xf6Pq86HMcS8 PN8FhOVET2A3coSYAv1Q02TrbleVaQQSP8HSKtqQGsUMRA6pZUmBvE805okARH/OPTf/ AIDA== X-Gm-Message-State: APjAAAVTTDVU4NnU2iy1FnAkhWEayK1JLDBuAzCCtXf2pKi2AF+LFcad dQzxY7vfl38ovPwX+PQ0u5resUmqJ389rLB8piIER37X X-Google-Smtp-Source: APXvYqwEHzG4ZtrPdZzb5vQyTVHUwZsd4WhMN1qTXOt1wkHsOLjLq13eE8jsmyXPuVzh/au3uADOJyf9AvoAunT1t5k= X-Received: by 2002:a37:7487:: with SMTP id p129mr7814479qkc.296.1575410618690; Tue, 03 Dec 2019 14:03:38 -0800 (PST) MIME-Version: 1.0 References: <87lfti5rip.fsf@gnu.org> In-Reply-To: <87lfti5rip.fsf@gnu.org> From: Brian Leung Date: Tue, 3 Dec 2019 14:03:02 -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 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 2f81b3cea7f07446c0a57c2ef371d37ff2e15483 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 | 87 +++++--- 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, 414 insertions(+), 93 deletions(-) diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 4694b6e7ef..9eccf20b39 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,58 @@ 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 + (match dependencies + ((dep . rest) dep) + (() '())) + 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