* [bug#37730] [PATCH] Topologically sort recursively-imported packages
@ 2019-10-13 7:37 Brian Leung
2019-10-18 9:31 ` Ludovic Courtès
0 siblings, 1 reply; 6+ messages in thread
From: Brian Leung @ 2019-10-13 7:37 UTC (permalink / raw)
To: 37730
[-- Attachment #1.1: Type: text/plain, Size: 92 bytes --]
Hi Guix,
Attached is a patch modifying the recursive importer in utils.scm.
Thanks,
Brian
[-- Attachment #1.2: Type: text/html, Size: 171 bytes --]
[-- Attachment #2: 0001-guix-utils-Topologically-sort-recursively-imported-r.patch --]
[-- Type: text/x-patch, Size: 29291 bytes --]
From 6fec6a72a7938753307ccf3b7bdad8bff72e47f9 Mon Sep 17 00:00:00 2001
From: Brian Leung <leungbk@mailfence.com>
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. 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.
* guix/scripts/import/crate.scm (guix-import-crate): Unstreamify and don't
reverse here. Remove dependency on srfi-41.
* guix/scripts/import/elpa.scm (guix-import-elpa) Unstreamify and don't
reverse here. Remove dependency on srfi-41.
* guix/scripts/import/gem.scm (guix-import-gem) Unstreamify and don't reverse
here. Remove dependency on srfi-41.
* guix/scripts/import/hackage.scm (guix-import-hackage) Unstreamify and don't
reverse here. Remove dependency on srfi-41.
* guix/scripts/import/opam.scm (guix-import-opam) Unstreamify and don't
reverse here. Remove dependency on srfi-41.
* guix/scripts/import/pypi.scm (guix-import-pypi) Unstreamify and don't
reverse here. Remove dependency on srfi-41.
* guix/scripts/import/stackage.scm (guix-import-stackage) Unstreamify and
don't reverse here. 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 | 67 ++++---
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, 394 insertions(+), 93 deletions(-)
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index 4694b6e7ef..eaec357e78 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -42,7 +42,6 @@
#: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 +379,39 @@ 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 (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))
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.23.0
^ permalink raw reply related [flat|nested] 6+ messages in thread
* [bug#37730] [PATCH] Topologically sort recursively-imported packages
2019-10-13 7:37 [bug#37730] [PATCH] Topologically sort recursively-imported packages Brian Leung
@ 2019-10-18 9:31 ` Ludovic Courtès
[not found] ` <CAAc=MEyzhSWtmLwrfXmz1tr3_R74xenERX53gRuP4hOiiGXX8g@mail.gmail.com>
0 siblings, 1 reply; 6+ messages in thread
From: Ludovic Courtès @ 2019-10-18 9:31 UTC (permalink / raw)
To: Brian Leung; +Cc: 37730
Hi Brian,
Brian Leung <bkleung89@gmail.com> skribis:
> From 6fec6a72a7938753307ccf3b7bdad8bff72e47f9 Mon Sep 17 00:00:00 2001
> From: Brian Leung <leungbk@mailfence.com>
> 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’.
^ permalink raw reply [flat|nested] 6+ messages in thread
* [bug#37730] [PATCH] Topologically sort recursively-imported packages
[not found] ` <CAAc=MEwpYfW5OdgNv6Xm-db2LoKo=hnEE+70Q5DHu+23K19WMw@mail.gmail.com>
@ 2019-12-08 17:09 ` Ludovic Courtès
[not found] ` <CAAc=MEwYSqMqdOE62YeH248DrvyE9vk0t3U8wOagdq-hY+cK9w@mail.gmail.com>
0 siblings, 1 reply; 6+ messages in thread
From: Ludovic Courtès @ 2019-12-08 17:09 UTC (permalink / raw)
To: Brian Leung; +Cc: Ricardo Wurmus, 37730, Efraim Flashner
[-- Attachment #1: Type: text/plain, Size: 3596 bytes --]
Hi Brian,
Thanks for the updated patch!
Brian Leung <bkleung89@gmail.com> skribis:
> From 915274d493116d063bfe2a953a9e855b8312711e Mon Sep 17 00:00:00 2001
> From: Brian Leung <leungbk@mailfence.com>
> Date: Fri, 11 Oct 2019 23:18:03 -0700
> Subject: [PATCH] guix: utils: Topologically sort recursively imported recipes.
[...]
> + (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))
I found this to be relatively complex (and part of this complexity was
already there before the patch) and quite different from the other
graph-walking procedures we have in different places, which got me
thinking why that is.
After a bit of researching and trying, I found that the attached patch
expresses the same thing, including topological sorting, in a hopefully
clearer way, or at least more consistent with other graph-walking
procedures in the code. WDYT?
If that’s fine with you, I’d be willing to apply this patch, and then
apply other bits of your patch (the tests and stream removal) on top of
it. How does that sound?
Returning a topologically-sorted set of packages means that nothing is
output until we’ve walked the whole dependency graph, so we indeed have
to get rid of streams. I guess it’s a tradeoff. Ricardo, how do you
feel about this change?
Thanks!
Ludo’.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 3811 bytes --]
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index 4694b6e7ef..bdce902d87 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -34,12 +34,14 @@
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix download)
+ #:use-module (guix sets)
#:use-module (gnu packages)
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 receive)
#:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-41)
@@ -377,40 +379,51 @@ separated by PRED."
(chr (char-downcase chr)))
name)))
+(define (topological-sort nodes
+ node-dependencies
+ node-name)
+ "Perform a breadth-first traversal of the graph rooted at NODES, a list of
+nodes, and return the list of nodes sorted in topological order. Call
+NODE-DEPENDENCIES to obtain the dependencies of a node, and NODE-NAME to
+obtain a node's uniquely identifying \"key\"."
+ (let loop ((nodes nodes)
+ (result '())
+ (visited (set)))
+ (match nodes
+ (()
+ (reverse result))
+ ((head . tail)
+ (if (set-contains? visited (node-name head))
+ (loop tail result visited)
+ (let ((dependencies (node-dependencies head)))
+ (loop (append dependencies tail)
+ (cons head result)
+ (set-insert (node-name head) visited))))))))
+
(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."
- (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))))
+ (define-record-type <node>
+ (make-node name package dependencies)
+ node?
+ (name node-name)
+ (package node-package)
+ (dependencies node-dependencies))
- ;; 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 (exists? name)
+ (not (null? (find-packages-by-name (guix-name name)))))
+
+ (define (lookup-node name)
+ (receive (package dependencies) (repo->guix-package name repo)
+ (make-node name package dependencies)))
+
+ (list->stream ;TODO: remove streams
+ (map node-package
+ (topological-sort (list (lookup-node package-name))
+ (lambda (node)
+ (map lookup-node
+ (remove exists?
+ (node-dependencies node))))
+ node-name))))
^ permalink raw reply related [flat|nested] 6+ messages in thread
* bug#37730: [PATCH] Topologically sort recursively-imported packages
[not found] ` <CAAc=MEwYSqMqdOE62YeH248DrvyE9vk0t3U8wOagdq-hY+cK9w@mail.gmail.com>
@ 2019-12-11 11:26 ` Ludovic Courtès
2019-12-12 15:15 ` [bug#37730] " Ricardo Wurmus
0 siblings, 1 reply; 6+ messages in thread
From: Ludovic Courtès @ 2019-12-11 11:26 UTC (permalink / raw)
To: Brian Leung; +Cc: 37730-done
Hi Brian,
Brian Leung <bkleung89@gmail.com> skribis:
>> If that’s fine with you, I’d be willing to apply this patch, and then
>> apply other bits of your patch (the tests and stream removal) on top of
>> it. How does that sound?
>
> Sure, your patch seems clearer to me.
I pushed patches that combine mine and yours:
4982de4c32 import: crate: Add recursive import test.
70a8e13277 import: utils: 'recursive-import' returns a list rather than a stream.
ddd5915900 import: utils: 'recursive-import' returns packages in topological order.
Let me know if you notice anything wrong!
Thank you,
Ludo’.
^ permalink raw reply [flat|nested] 6+ messages in thread
* [bug#37730] [PATCH] Topologically sort recursively-imported packages
2019-12-11 11:26 ` bug#37730: " Ludovic Courtès
@ 2019-12-12 15:15 ` Ricardo Wurmus
2019-12-12 21:18 ` Ludovic Courtès
0 siblings, 1 reply; 6+ messages in thread
From: Ricardo Wurmus @ 2019-12-12 15:15 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: Brian Leung, 37730-done
Ludovic Courtès <ludo@gnu.org> writes:
> Hi Brian,
>
> Brian Leung <bkleung89@gmail.com> skribis:
>
>>> If that’s fine with you, I’d be willing to apply this patch, and then
>>> apply other bits of your patch (the tests and stream removal) on top of
>>> it. How does that sound?
>>
>> Sure, your patch seems clearer to me.
>
> I pushed patches that combine mine and yours:
>
> 4982de4c32 import: crate: Add recursive import test.
> 70a8e13277 import: utils: 'recursive-import' returns a list rather than a stream.
> ddd5915900 import: utils: 'recursive-import' returns packages in topological order.
Thank you!
> Let me know if you notice anything wrong!
I believe the docstring of RECURSIVE-IMPORT in (guix import utils) needs
to be adjusted. It still refers to streams.
--
Ricardo
^ permalink raw reply [flat|nested] 6+ messages in thread
* [bug#37730] [PATCH] Topologically sort recursively-imported packages
2019-12-12 15:15 ` [bug#37730] " Ricardo Wurmus
@ 2019-12-12 21:18 ` Ludovic Courtès
0 siblings, 0 replies; 6+ messages in thread
From: Ludovic Courtès @ 2019-12-12 21:18 UTC (permalink / raw)
To: Ricardo Wurmus; +Cc: Brian Leung, 37730-done
Hi,
Ricardo Wurmus <rekado@elephly.net> skribis:
> Ludovic Courtès <ludo@gnu.org> writes:
>
>> Hi Brian,
>>
>> Brian Leung <bkleung89@gmail.com> skribis:
>>
>>>> If that’s fine with you, I’d be willing to apply this patch, and then
>>>> apply other bits of your patch (the tests and stream removal) on top of
>>>> it. How does that sound?
>>>
>>> Sure, your patch seems clearer to me.
>>
>> I pushed patches that combine mine and yours:
>>
>> 4982de4c32 import: crate: Add recursive import test.
>> 70a8e13277 import: utils: 'recursive-import' returns a list rather than a stream.
>> ddd5915900 import: utils: 'recursive-import' returns packages in topological order.
>
> Thank you!
>
>> Let me know if you notice anything wrong!
>
> I believe the docstring of RECURSIVE-IMPORT in (guix import utils) needs
> to be adjusted. It still refers to streams.
Oops, fixed! (Will push shortly.)
Thanks,
Ludo’.
^ permalink raw reply [flat|nested] 6+ messages in thread
end of thread, other threads:[~2019-12-12 21:19 UTC | newest]
Thread overview: 6+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2019-10-13 7:37 [bug#37730] [PATCH] Topologically sort recursively-imported packages Brian Leung
2019-10-18 9:31 ` Ludovic Courtès
[not found] ` <CAAc=MEyzhSWtmLwrfXmz1tr3_R74xenERX53gRuP4hOiiGXX8g@mail.gmail.com>
[not found] ` <CAAc=MEwpYfW5OdgNv6Xm-db2LoKo=hnEE+70Q5DHu+23K19WMw@mail.gmail.com>
2019-12-08 17:09 ` Ludovic Courtès
[not found] ` <CAAc=MEwYSqMqdOE62YeH248DrvyE9vk0t3U8wOagdq-hY+cK9w@mail.gmail.com>
2019-12-11 11:26 ` bug#37730: " Ludovic Courtès
2019-12-12 15:15 ` [bug#37730] " Ricardo Wurmus
2019-12-12 21:18 ` Ludovic Courtès
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).