* [bug#51493] [PATCH 2/5] import: cran: Allow imports of a specific version.
2021-10-29 21:35 ` [bug#51493] [PATCH 1/5] import: pypi: Allow imports of a specific version Ludovic Courtès
@ 2021-10-29 21:35 ` Ludovic Courtès
2021-10-29 21:35 ` [bug#51493] [PATCH 3/5] import: print: Properly render packages with origins as inputs Ludovic Courtès
` (3 subsequent siblings)
4 siblings, 0 replies; 10+ messages in thread
From: Ludovic Courtès @ 2021-10-29 21:35 UTC (permalink / raw)
To: 51493; +Cc: Ludovic Courtès
* guix/import/cran.scm (download): Handle the case where URL is a list.
(fetch-description-from-tarball): New procedure.
(fetch-description): Add #:version parameter. Honor it when REPOSITORY
is 'cran. Use 'fetch-description-from-tarball' when REPOSITORY is
'bioconductor.
(description->package): SOURCE-URL may now be a list.
(cran->guix-package): Pass VERSION to 'fetch-description'.
(cran-recursive-import): Add #:version parameter.
* guix/scripts/import/cran.scm (guix-import-cran): Expect a spec rather
than a mere package name.
* doc/guix.texi (Invoking guix import): Document it.
---
doc/guix.texi | 6 +++
guix/import/cran.scm | 89 +++++++++++++++++++++++-------------
guix/scripts/import/cran.scm | 35 +++++++-------
3 files changed, 83 insertions(+), 47 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index b742a4808a..7645f6f01a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11833,6 +11833,12 @@ The command command below imports metadata for the Cairo R package:
guix import cran Cairo
@end example
+You can also ask for a specific version:
+
+@example
+guix import cran rasterVis@@0.50.3
+@end example
+
When @option{--recursive} is added, the importer will traverse the
dependency graph of the given upstream package recursively and generate
package expressions for all those packages that are not yet in Guix.
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index 5f5f73cbf4..22fae5d7cb 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -229,26 +229,61 @@ (define download
(let ((store-directory
(add-to-store store (basename url) #t "sha256" dir)))
(values store-directory changeset)))))))
- (else (download-to-store store url)))))))
+ (else
+ (match url
+ ((? string?)
+ (download-to-store store url))
+ ((urls ...)
+ ;; Try all the URLs. A use case where this is useful is when one
+ ;; of the URLs is the /Archive CRAN URL.
+ (any (cut download-to-store store <>) urls)))))))))
-(define (fetch-description repository name)
+(define (fetch-description-from-tarball url)
+ "Fetch the tarball at URL, extra its 'DESCRIPTION' file, parse it, and
+return the resulting alist."
+ (match (download url)
+ (#f #f)
+ (tarball
+ (call-with-temporary-directory
+ (lambda (dir)
+ (parameterize ((current-error-port (%make-void-port "rw+"))
+ (current-output-port (%make-void-port "rw+")))
+ (and (zero? (system* "tar" "--wildcards" "-x"
+ "--strip-components=1"
+ "-C" dir
+ "-f" tarball "*/DESCRIPTION"))
+ (description->alist
+ (call-with-input-file (string-append dir "/DESCRIPTION")
+ read-string)))))))))
+
+(define* (fetch-description repository name #:optional version)
"Return an alist of the contents of the DESCRIPTION file for the R package
-NAME in the given REPOSITORY, or #f in case of failure. NAME is
+NAME at VERSION in the given REPOSITORY, or #f in case of failure. NAME is
case-sensitive."
(case repository
((cran)
- (let ((url (string-append %cran-url name "/DESCRIPTION")))
- (guard (c ((http-get-error? c)
- (warning (G_ "failed to retrieve package information \
+ (guard (c ((http-get-error? c)
+ (warning (G_ "failed to retrieve package information \
from ~a: ~a (~a)~%")
- (uri->string (http-get-error-uri c))
- (http-get-error-code c)
- (http-get-error-reason c))
- #f))
- (let* ((port (http-fetch url))
- (result (description->alist (read-string port))))
- (close-port port)
- result))))
+ (uri->string (http-get-error-uri c))
+ (http-get-error-code c)
+ (http-get-error-reason c))
+ #f))
+ ;; When VERSION is true, we have to download the tarball to get at its
+ ;; 'DESCRIPTION' file; only the latest one is directly accessible over
+ ;; HTTP.
+ (if version
+ (let ((urls (list (string-append "mirror://cran/src/contrib/"
+ name "_" version ".tar.gz")
+ (string-append "mirror://cran/src/contrib/Archive/"
+ name "/"
+ name "_" version ".tar.gz"))))
+ (fetch-description-from-tarball urls))
+ (let* ((url (string-append %cran-url name "/DESCRIPTION"))
+ (port (http-fetch url))
+ (result (description->alist (read-string port))))
+ (close-port port)
+ result))))
((bioconductor)
;; Currently, the bioconductor project does not offer a way to access a
;; package's DESCRIPTION file over HTTP, so we determine the version,
@@ -257,22 +292,13 @@ (define (fetch-description repository name)
(and (latest-bioconductor-package-version name) #t)
(and (latest-bioconductor-package-version name 'annotation) 'annotation)
(and (latest-bioconductor-package-version name 'experiment) 'experiment)))
+ ;; TODO: Honor VERSION.
(version (latest-bioconductor-package-version name type))
(url (car (bioconductor-uri name version type)))
- (tarball (download url)))
- (call-with-temporary-directory
- (lambda (dir)
- (parameterize ((current-error-port (%make-void-port "rw+"))
- (current-output-port (%make-void-port "rw+")))
- (and (zero? (system* "tar" "--wildcards" "-x"
- "--strip-components=1"
- "-C" dir
- "-f" tarball "*/DESCRIPTION"))
- (and=> (description->alist (with-input-from-file
- (string-append dir "/DESCRIPTION") read-string))
- (lambda (meta)
- (if (boolean? type) meta
- (cons `(bioconductor-type . ,type) meta))))))))))
+ (meta (fetch-description-from-tarball url)))
+ (if (boolean? type)
+ meta
+ (cons `(bioconductor-type . ,type) meta))))
((git)
(and (string-prefix? "http" name)
;; Download the git repository at "NAME"
@@ -485,7 +511,7 @@ (define (description->package repository meta)
((bioconductor)
(list (assoc-ref meta 'bioconductor-type)))
(else '())))
- ((url rest ...) url)
+ ((urls ...) urls)
((? string? url) url)
(_ #f)))))
(git? (assoc-ref meta 'git))
@@ -592,7 +618,7 @@ (define cran->guix-package
(lambda* (package-name #:key (repo 'cran) version)
"Fetch the metadata for PACKAGE-NAME from REPO and return the `package'
s-expression corresponding to that package, or #f on failure."
- (let ((description (fetch-description repo package-name)))
+ (let ((description (fetch-description repo package-name version)))
(if description
(description->package repo description)
(case repo
@@ -610,8 +636,9 @@ (define cran->guix-package
(&message
(message "couldn't find meta-data for R package")))))))))))
-(define* (cran-recursive-import package-name #:key (repo 'cran))
+(define* (cran-recursive-import package-name #:key (repo 'cran) version)
(recursive-import package-name
+ #:version version
#:repo repo
#:repo->guix-package cran->guix-package
#:guix-name cran-guix-name))
diff --git a/guix/scripts/import/cran.scm b/guix/scripts/import/cran.scm
index 3e4b038cc4..2934d4300a 100644
--- a/guix/scripts/import/cran.scm
+++ b/guix/scripts/import/cran.scm
@@ -27,8 +27,8 @@ (define-module (guix scripts import cran)
#:use-module (guix import utils)
#:use-module (guix scripts import)
#:use-module (srfi srfi-1)
- #:use-module (srfi srfi-11)
#:use-module (srfi srfi-37)
+ #:use-module (srfi srfi-71)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:export (guix-import-cran))
@@ -98,21 +98,24 @@ (define (parse-options)
(reverse opts))))
(parameterize ((%input-style (assoc-ref opts 'style)))
(match args
- ((package-name)
- (if (assoc-ref opts 'recursive)
- ;; Recursive import
- (with-error-handling
- (map package->definition
- (filter identity
- (cran-recursive-import package-name
- #:repo (or (assoc-ref opts 'repo) 'cran)))))
- ;; Single import
- (let ((sexp (cran->guix-package package-name
- #:repo (or (assoc-ref opts 'repo) 'cran))))
- (unless sexp
- (leave (G_ "failed to download description for package '~a'~%")
- package-name))
- sexp)))
+ ((spec)
+ (let ((name version (package-name->name+version spec)))
+ (if (assoc-ref opts 'recursive)
+ ;; Recursive import
+ (with-error-handling
+ (map package->definition
+ (filter identity
+ (cran-recursive-import name
+ #:version version
+ #:repo (or (assoc-ref opts 'repo) 'cran)))))
+ ;; Single import
+ (let ((sexp (cran->guix-package name
+ #:version version
+ #:repo (or (assoc-ref opts 'repo) 'cran))))
+ (unless sexp
+ (leave (G_ "failed to download description for package '~a'~%")
+ name))
+ sexp))))
(()
(leave (G_ "too few arguments~%")))
((many ...)
--
2.33.0
^ permalink raw reply related [flat|nested] 10+ messages in thread* [bug#51493] [PATCH 3/5] import: print: Properly render packages with origins as inputs.
2021-10-29 21:35 ` [bug#51493] [PATCH 1/5] import: pypi: Allow imports of a specific version Ludovic Courtès
2021-10-29 21:35 ` [bug#51493] [PATCH 2/5] import: cran: " Ludovic Courtès
@ 2021-10-29 21:35 ` Ludovic Courtès
2021-10-29 21:35 ` [bug#51493] [PATCH 4/5] import: print: Correctly handle URI lists Ludovic Courtès
` (2 subsequent siblings)
4 siblings, 0 replies; 10+ messages in thread
From: Ludovic Courtès @ 2021-10-29 21:35 UTC (permalink / raw)
To: 51493; +Cc: Ludovic Courtès
* guix/import/print.scm (package->code)[source->code]: Check whether
VERSION is true before calling 'factorize-uri'.
[package-lists->code]: Add clause for inputs that are origins.
* tests/print.scm (pkg-with-origin-input, pkg-with-origin-input-source):
New variables.
("package with origin input"): New test.
---
guix/import/print.scm | 14 +++++++++-----
tests/print.scm | 28 ++++++++++++++++++++++++++++
2 files changed, 37 insertions(+), 5 deletions(-)
diff --git a/guix/import/print.scm b/guix/import/print.scm
index 0310739b3a..8acf5d52f6 100644
--- a/guix/import/print.scm
+++ b/guix/import/print.scm
@@ -89,9 +89,11 @@ (define (source->code source version)
(guix hg-download)
(guix svn-download)))
(procedure-name method)))
- (uri (string-append ,@(match (factorize-uri uri version)
- ((? string? uri) (list uri))
- (factorized factorized))))
+ (uri ,(if version
+ `(string-append ,@(match (factorize-uri uri version)
+ ((? string? uri) (list uri))
+ (factorized factorized)))
+ uri))
,(if (equal? (content-hash-algorithm hash) 'sha256)
`(sha256 (base32 ,(bytevector->nix-base32-string
(content-hash-value hash))))
@@ -109,7 +111,7 @@ (define (package-lists->code lsts)
(map (match-lambda
((? symbol? s)
(list (symbol->string s) (list 'unquote s)))
- ((label pkg . out)
+ ((label (? package? pkg) . out)
(let ((mod (package-module-name pkg)))
(cons* label
;; FIXME: using '@ certainly isn't pretty, but it
@@ -117,7 +119,9 @@ (define (package-lists->code lsts)
;; modules.
(list 'unquote
(list '@ mod (variable-name pkg mod)))
- out))))
+ out)))
+ ((label (? origin? origin))
+ (list label (list 'unquote (source->code origin #f)))))
lsts)))
(let ((name (package-name package))
diff --git a/tests/print.scm b/tests/print.scm
index 3386590d3a..ad19f4573a 100644
--- a/tests/print.scm
+++ b/tests/print.scm
@@ -67,6 +67,30 @@ (define-with-source pkg-with-inputs pkg-with-inputs-source
(description "This is a dummy package.")
(license license:gpl3+)))
+(define-with-source pkg-with-origin-input pkg-with-origin-input-source
+ (package
+ (name "test")
+ (version "1.2.3")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "file:///tmp/test-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah"))))
+ (build-system (@ (guix build-system gnu) gnu-build-system))
+ (inputs
+ `(("o" ,(origin
+ (method url-fetch)
+ (uri "http://example.org/somefile.txt")
+ (sha256
+ (base32
+ "0000000000000000000000000000000000000000000000000000"))))))
+ (home-page "http://gnu.org")
+ (synopsis "Dummy")
+ (description "This is a dummy package.")
+ (license license:gpl3+)))
+
(test-equal "simple package"
`(define-public test ,pkg-source)
(package->code pkg))
@@ -75,4 +99,8 @@ (define-with-source pkg-with-inputs pkg-with-inputs-source
`(define-public test ,pkg-with-inputs-source)
(package->code pkg-with-inputs))
+(test-equal "package with origin input"
+ `(define-public test ,pkg-with-origin-input-source)
+ (package->code pkg-with-origin-input))
+
(test-end "print")
--
2.33.0
^ permalink raw reply related [flat|nested] 10+ messages in thread* [bug#51493] [PATCH 4/5] import: print: Correctly handle URI lists.
2021-10-29 21:35 ` [bug#51493] [PATCH 1/5] import: pypi: Allow imports of a specific version Ludovic Courtès
2021-10-29 21:35 ` [bug#51493] [PATCH 2/5] import: cran: " Ludovic Courtès
2021-10-29 21:35 ` [bug#51493] [PATCH 3/5] import: print: Properly render packages with origins as inputs Ludovic Courtès
@ 2021-10-29 21:35 ` Ludovic Courtès
2021-10-29 21:35 ` [bug#51493] [PATCH 5/5] import: print: Handle patches that are origins Ludovic Courtès
2021-11-12 10:18 ` [bug#51493] [PATCH 1/5] import: pypi: Allow imports of a specific version zimoun
4 siblings, 0 replies; 10+ messages in thread
From: Ludovic Courtès @ 2021-10-29 21:35 UTC (permalink / raw)
To: 51493; +Cc: Ludovic Courtès
* guix/import/print.scm (package->code)[factorized-uri-code]: New
procedure.
[source->code]: Use it, and factorize URI when it's a list.
* tests/print.scm (pkg-with-origin-input): Check origin URI to a list.
---
guix/import/print.scm | 15 ++++++++++++---
tests/print.scm | 6 ++++--
2 files changed, 16 insertions(+), 5 deletions(-)
diff --git a/guix/import/print.scm b/guix/import/print.scm
index 8acf5d52f6..4e65d18bc3 100644
--- a/guix/import/print.scm
+++ b/guix/import/print.scm
@@ -25,6 +25,7 @@ (define-module (guix import print)
#:use-module (guix build-system)
#:use-module (gnu packages)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
#:use-module (guix import utils)
#:use-module (ice-9 control)
#:use-module (ice-9 match)
@@ -72,6 +73,11 @@ (define (search-path-specification->code spec)
(file-type (quote ,(search-path-specification-file-type spec)))
(file-pattern ,(search-path-specification-file-pattern spec))))
+ (define (factorized-uri-code uri version)
+ (match (factorize-uri uri version)
+ ((? string? uri) uri)
+ ((factorized ...) `(string-append ,@factorized))))
+
(define (source->code source version)
(let ((uri (origin-uri source))
(method (origin-method source))
@@ -90,9 +96,12 @@ (define (source->code source version)
(guix svn-download)))
(procedure-name method)))
(uri ,(if version
- `(string-append ,@(match (factorize-uri uri version)
- ((? string? uri) (list uri))
- (factorized factorized)))
+ (match uri
+ ((? string? uri)
+ (factorized-uri-code uri version))
+ ((lst ...)
+ `(list
+ ,@(map (cut factorized-uri-code <> version) uri))))
uri))
,(if (equal? (content-hash-algorithm hash) 'sha256)
`(sha256 (base32 ,(bytevector->nix-base32-string
diff --git a/tests/print.scm b/tests/print.scm
index ad19f4573a..7f4c8ccdd1 100644
--- a/tests/print.scm
+++ b/tests/print.scm
@@ -73,8 +73,10 @@ (define-with-source pkg-with-origin-input pkg-with-origin-input-source
(version "1.2.3")
(source (origin
(method url-fetch)
- (uri (string-append "file:///tmp/test-"
- version ".tar.gz"))
+ (uri (list (string-append "file:///tmp/test-"
+ version ".tar.gz")
+ (string-append "http://example.org/test-"
+ version ".tar.gz")))
(sha256
(base32
"070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah"))))
--
2.33.0
^ permalink raw reply related [flat|nested] 10+ messages in thread* [bug#51493] [PATCH 5/5] import: print: Handle patches that are origins.
2021-10-29 21:35 ` [bug#51493] [PATCH 1/5] import: pypi: Allow imports of a specific version Ludovic Courtès
` (2 preceding siblings ...)
2021-10-29 21:35 ` [bug#51493] [PATCH 4/5] import: print: Correctly handle URI lists Ludovic Courtès
@ 2021-10-29 21:35 ` Ludovic Courtès
2021-11-12 10:18 ` [bug#51493] [PATCH 1/5] import: pypi: Allow imports of a specific version zimoun
4 siblings, 0 replies; 10+ messages in thread
From: Ludovic Courtès @ 2021-10-29 21:35 UTC (permalink / raw)
To: 51493; +Cc: Ludovic Courtès
* guix/import/print.scm (package->code)[source->code]: Handle patches
that are origins.
* tests/print.scm (pkg-with-origin-input): Add 'patches' field.
(pkg-with-origin-patch, pkg-with-origin-patch-source): New variables.
("package with origin patch"): New test.
---
guix/import/print.scm | 13 +++++++++++--
tests/print.scm | 33 ++++++++++++++++++++++++++++++++-
2 files changed, 43 insertions(+), 3 deletions(-)
diff --git a/guix/import/print.scm b/guix/import/print.scm
index 4e65d18bc3..e04a6647b4 100644
--- a/guix/import/print.scm
+++ b/guix/import/print.scm
@@ -112,8 +112,17 @@ (define (source->code source version)
;; FIXME: in order to be able to throw away the directory prefix,
;; we just assume that the patch files can be found with
;; "search-patches".
- ,@(if (null? patches) '()
- `((patches (search-patches ,@(map basename patches))))))))
+ ,@(cond ((null? patches)
+ '())
+ ((every string? patches)
+ `((patches (search-patches ,@(map basename patches)))))
+ (else
+ `((patches (list ,@(map (match-lambda
+ ((? string? file)
+ `(search-patch ,file))
+ ((? origin? origin)
+ (source->code origin #f)))
+ patches)))))))))
(define (package-lists->code lsts)
(list 'quasiquote
diff --git a/tests/print.scm b/tests/print.scm
index 7f4c8ccdd1..ff0db469ab 100644
--- a/tests/print.scm
+++ b/tests/print.scm
@@ -22,6 +22,7 @@ (define-module (test-print)
#:use-module (guix download)
#:use-module (guix packages)
#:use-module ((guix licenses) #:prefix license:)
+ #:use-module ((gnu packages) #:select (search-patches))
#:use-module (srfi srfi-64))
(define-syntax-rule (define-with-source object source expr)
@@ -79,7 +80,9 @@ (define-with-source pkg-with-origin-input pkg-with-origin-input-source
version ".tar.gz")))
(sha256
(base32
- "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah"))))
+ "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah"))
+ (patches (search-patches "guile-linux-syscalls.patch"
+ "guile-relocatable.patch"))))
(build-system (@ (guix build-system gnu) gnu-build-system))
(inputs
`(("o" ,(origin
@@ -93,6 +96,30 @@ (define-with-source pkg-with-origin-input pkg-with-origin-input-source
(description "This is a dummy package.")
(license license:gpl3+)))
+(define-with-source pkg-with-origin-patch pkg-with-origin-patch-source
+ (package
+ (name "test")
+ (version "1.2.3")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "file:///tmp/test-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah"))
+ (patches
+ (list (origin
+ (method url-fetch)
+ (uri "http://example.org/x.patch")
+ (sha256
+ (base32
+ "0000000000000000000000000000000000000000000000000000")))))))
+ (build-system (@ (guix build-system gnu) gnu-build-system))
+ (home-page "http://gnu.org")
+ (synopsis "Dummy")
+ (description "This is a dummy package.")
+ (license license:gpl3+)))
+
(test-equal "simple package"
`(define-public test ,pkg-source)
(package->code pkg))
@@ -105,4 +132,8 @@ (define-with-source pkg-with-origin-input pkg-with-origin-input-source
`(define-public test ,pkg-with-origin-input-source)
(package->code pkg-with-origin-input))
+(test-equal "package with origin patch"
+ `(define-public test ,pkg-with-origin-patch-source)
+ (package->code pkg-with-origin-patch))
+
(test-end "print")
--
2.33.0
^ permalink raw reply related [flat|nested] 10+ messages in thread* [bug#51493] [PATCH 1/5] import: pypi: Allow imports of a specific version.
2021-10-29 21:35 ` [bug#51493] [PATCH 1/5] import: pypi: Allow imports of a specific version Ludovic Courtès
` (3 preceding siblings ...)
2021-10-29 21:35 ` [bug#51493] [PATCH 5/5] import: print: Handle patches that are origins Ludovic Courtès
@ 2021-11-12 10:18 ` zimoun
2021-11-12 10:49 ` Tobias Geerinckx-Rice via Guix-patches via
4 siblings, 1 reply; 10+ messages in thread
From: zimoun @ 2021-11-12 10:18 UTC (permalink / raw)
To: Ludovic Courtès, 51493; +Cc: Ludovic Courtès
Hi Ludo,
I am late to the party. I just have one bikeshedding question about
double ’@’ for specifying the version…
On Fri, 29 Oct 2021 at 23:35, Ludovic Courtès <ludo@gnu.org> wrote:
> +You can also ask for a specific version:
> +
> +@example
> +guix import pypi itsdangerous@@1.1.0
> +@end example
…as here. Is doubling ’@’ mandatory for technical reasons? Because
usually, Guix uses simple ’@’ when referring to a specific version.
BTW, patch#51545 [1] adds similar features for egg importer.
1: <http://issues.guix.gnu.org/issue/51545>
Cheers,
simon
^ permalink raw reply [flat|nested] 10+ messages in thread