From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:470:142:3::10]:54658) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1iel78-0001Pj-Eu for guix-patches@gnu.org; Tue, 10 Dec 2019 14:24:07 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1iel76-0003v5-Sh for guix-patches@gnu.org; Tue, 10 Dec 2019 14:24:06 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:50659) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1iel76-0003uv-PO for guix-patches@gnu.org; Tue, 10 Dec 2019 14:24:04 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1iel76-000543-Mt for guix-patches@gnu.org; Tue, 10 Dec 2019 14:24:04 -0500 Subject: [bug#38408] [PATCH v4 6/6] guix: import: recursive-import-semver: allow the range of a package to be specified when begining import. Resent-Message-ID: From: Martin Becze Date: Tue, 10 Dec 2019 14:23:43 -0500 Message-Id: In-Reply-To: References: MIME-Version: 1.0 Content-Transfer-Encoding: 8bit List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 38408@debbugs.gnu.org Cc: Martin Becze * guix/import/crate.scm (crate-recursive-import) changed param version to range * guix/import/util.scm (recursive-import-semver) changed param version to range * guix/tests/import-utils.scm added range test for (recursive-import-semver) --- guix/import/crate.scm | 5 +-- guix/import/utils.scm | 69 ++++++++++++++++++++++++------------------ tests/import-utils.scm | 15 ++++++++- 3 files changed, 57 insertions(+), 32 deletions(-) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 535ac2d8e5..cd9ab61cca 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -247,10 +247,11 @@ latest version of CRATE-NAME." (crate-version-dependencies version*))) (make-crate-sexp crate version* dependencies)) -(define* (crate-recursive-import name #:optional version) + +(define* (crate-recursive-import name #:optional range) (recursive-import-semver #:name name - #:version version + #:range (if range range "*") #:name->metadata lookup-crate #:metadata->package crate->crate-version #:metadata-versions crate->versions diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 6932614f8e..35d5c79286 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -422,8 +422,9 @@ dependencies." ;; initial state (step initial-state))) -(define* (recursive-import-semver #:key name - (version #f) +(define* (recursive-import-semver #:key + name + (range "*") name->metadata metadata->package metadata-versions @@ -433,7 +434,7 @@ dependencies." guix-name make-sexp) "Generates a stream of package expressions for the dependencies of the given -NAME and VERSION. The dependencies will be resolved using semantic versioning. +NAME and version RANGE. The dependencies will be resolved using semantic versioning. This procedure makes the assumption that most package repositories will, for a given package provide some on that package that includes what versions of the package that are available and a list of dependencies for each @@ -442,7 +443,7 @@ other data. This procedure takes the following keys: NAME - The name of the package to import - VERSION - The version of the package to import + RANGE - The version range of the package to import NAME->METADATA - A procedure that takes a NAME of a package and returns that package's METADATA->PACKAGE A procedure that takes a package's and VERSION @@ -473,6 +474,8 @@ s-expression" (semver-range-contains? range (string->semver version))) + ;; given a name of a package and a version number this returns the export + ;; symbol that will be used (define (guix-export-name name version) (let ((versions (name->versions name)) (name (guix-name name))) @@ -518,14 +521,17 @@ s-expression" (export-name (guix-export-name name version))) `(,export-name ,version #t))) + (define (find-dep-version-by-name-range name range-string known-deps) + (let ((range (string->semver-range range-string))) + (or (find-known name range known-deps) + (find-locally name range) + (find-remote name range)))) (define (find-dep-version dep known-deps) (let* ((name (dependency-name dep)) - (range (string->semver-range (dependency-range dep))) + (range (dependency-range dep)) (export-name-version-needed - (or (find-known name range known-deps) - (find-locally name range) - (find-remote name range)))) + (find-dep-version-by-name-range name range known-deps))) `(,name ,@export-name-version-needed ,dep) )) @@ -536,12 +542,12 @@ s-expression" (deps (map (lambda (dep) (find-dep-version dep known-deps)) (package-dependencies package))) + (deps-with-export-symbol (map + (match-lambda ((_ export-symbol _ _ dep) + (list export-symbol dep))) + deps)) (sexp - (make-sexp metadata package - (map - (match-lambda ((_ export-symbol _ _ dep) - (list export-symbol dep))) - deps)))) + (make-sexp metadata package deps-with-export-symbol))) (values (package->definition sexp (latest? versions version)) (filter-map @@ -551,15 +557,12 @@ s-expression" #f))) deps)))) - (define initial-state - (list #f - (list - ;; packages to find - (list name (if version - version - (car (name->versions name))))) - ;; packages that have been found - (list))) + (define (initial-state name version) + `(#f + ;; packages to find + ,(list (list name version)) + ;; packages that have been found + ())) (define (step state) (match state @@ -573,11 +576,19 @@ s-expression" (cons (list next-name next-version) done)))) ((prev '() done) (list #f '() done)))) + + (define (create-stream initial-state) + (stream-unfold + ;; map: produce a stream element + (match-lambda ((latest queue done) latest)) + ;; predicate + (match-lambda ((latest queue done) latest)) + step + (step initial-state))) - (stream-unfold - ;; map: produce a stream element - (match-lambda ((latest queue done) latest)) - ;; predicate - (match-lambda ((latest queue done) latest)) - step - (step initial-state))) + (match (find-dep-version-by-name-range name range '()) + ((_ version #t) + (create-stream (initial-state name version))) + ;; if the initial package alread exsits then just return its export symbol + ((export-name _ #f) + (list->stream (list export-name))))) diff --git a/tests/import-utils.scm b/tests/import-utils.scm index 4ed3a5e1da..022b8f2b32 100644 --- a/tests/import-utils.scm +++ b/tests/import-utils.scm @@ -190,7 +190,7 @@ (define* (test-recursive-importer name version #:optional (guix-name guix-name)) (recursive-import-semver #:name name - #:version version + #:range version #:name->metadata name->metadata #:metadata->package metadata->package #:metadata-versions metadata-semver-versions @@ -250,6 +250,19 @@ (dependcies ())))) (stream->list (test-recursive-importer "one-dep" "0.1.0"))) +(test-equal "recursive import test with a version range" + `((define-public test-one-dep + (package + (name "test-one-dep") + (version "1.0.0") + (dependcies (("test-no-deps" "test-no-deps"))))) + (define-public test-no-deps + (package + (name "test-no-deps") + (version "1.0.0") + (dependcies ())))) + (stream->list (test-recursive-importer "one-dep" "*"))) + (test-equal "recursive import test with with dependency that is already in the repo" `((define-public test-already-packaged (package (name "test-already-packaged") -- 2.24.0