* [bug#58623] [PATCH v2 0/6] import/cran: Parameterize for guix-cran.
2022-11-05 20:47 ` Ludovic Courtès
@ 2022-11-30 16:47 ` Lars-Dominik Braun
2022-12-01 11:05 ` Lars-Dominik Braun
0 siblings, 1 reply; 6+ messages in thread
From: Lars-Dominik Braun @ 2022-11-30 16:47 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: rekado, 58623
[-- Attachment #1: Type: text/plain, Size: 1471 bytes --]
Hi Ludo,
here’s a v2, which hopefully addresses your comments. Passing in
arguments required some refactoring in import/utils.scm. I also added
another commit, which speeds up imports significantly. There I tried
to use VALUES (and LET*-VALUES), but ultimately failed and fell back to
LIST and CAR/CADR. There’s probably a better solution?
Cheers,
Lars
Lars-Dominik Braun (6):
import/utils: Pass all arguments through to package builder.
import/cran: Allow custom license prefix.
import/cran: Allow overriding description fetch function.
import/cran: Allow overriding tarball download.
import/cran: Translate more package dependencies.
import/cran: Always operate on source directory.
doc/guix.texi | 4 +
guix/import/cran.scm | 156 +++++++++++++++++------------------
guix/import/crate.scm | 3 +-
guix/import/egg.scm | 3 +-
guix/import/elm.scm | 2 +-
guix/import/gem.scm | 3 +-
guix/import/gnu.scm | 3 +-
guix/import/go.scm | 5 +-
guix/import/hackage.scm | 5 +-
guix/import/hexpm.scm | 2 +-
guix/import/minetest.scm | 5 +-
guix/import/opam.scm | 2 +-
guix/import/pypi.scm | 2 +-
guix/import/stackage.scm | 5 +-
guix/import/texlive.scm | 4 +-
guix/import/utils.scm | 10 +--
guix/scripts/import/cran.scm | 21 ++++-
17 files changed, 130 insertions(+), 105 deletions(-)
--
2.37.4
[-- Attachment #2: 0001-import-utils-Pass-all-arguments-through-to-package-b.patch --]
[-- Type: text/plain, Size: 14836 bytes --]
From 94dcfe07d25dd405879e462055fc659b283ed025 Mon Sep 17 00:00:00 2001
From: Lars-Dominik Braun <lars@6xq.net>
Date: Sun, 27 Nov 2022 11:12:32 +0100
Subject: [PATCH v2 1/6] import/utils: Pass all arguments through to package
builder.
Individual importer may have additional arguments.
* guix/import/utils.scm (recursive-import): Patch all keyword arguments
through to repo->guix-package.
* guix/import/cran.scm (cran->guix-package): Add #:allow-other-keys.
* guix/import/crate.scm (crate->guix-package): Ditto.
* guix/import/egg.scm (egg->guix-package): Ditto.
* guix/import/elm.scm (elm->guix-package): Ditto.
* guix/import/gem.scm (gem->guix-package): Ditto.
* guix/import/gnu.scm (gnu->guix-package): Ditto.
* guix/import/go.scm (go-module->guix-package): Ditto.
(go-module-recursive-import): Ditto.
* guix/import/hackage.scm (hackage->guix-package): Ditto.
(hackage-recursive-import): Ditto.
* guix/import/hexpm.scm (hexpm->guix-package): Ditto.
* guix/import/minetest.scm (minetest->guix-package): Ditto.
(minetest-recursive-import): Ditto.
* guix/import/opam.scm (opam->guix-package): Ditto.
* guix/import/pypi.scm (pypi->guix-package): Ditto.
* guix/import/stackage.scm (stackage->guix-package): Ditto.
(stackage-recursive-import): Ditto.
* guix/import/texlive.scm (texlive->guix-package): Ditto.
---
guix/import/cran.scm | 2 +-
guix/import/crate.scm | 3 ++-
guix/import/egg.scm | 3 ++-
guix/import/elm.scm | 2 +-
guix/import/gem.scm | 3 ++-
guix/import/gnu.scm | 3 ++-
guix/import/go.scm | 5 +++--
guix/import/hackage.scm | 5 +++--
guix/import/hexpm.scm | 2 +-
guix/import/minetest.scm | 5 +++--
guix/import/opam.scm | 2 +-
guix/import/pypi.scm | 2 +-
guix/import/stackage.scm | 5 +++--
guix/import/texlive.scm | 4 ++--
guix/import/utils.scm | 10 ++++------
15 files changed, 31 insertions(+), 25 deletions(-)
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index a02e746417..41e5d45acf 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -639,7 +639,7 @@ (define (description->package repository meta)
(define cran->guix-package
(memoize
- (lambda* (package-name #:key (repo 'cran) version)
+ (lambda* (package-name #:key (repo 'cran) version #:allow-other-keys)
"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 version)))
diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index c76d7e9c1a..415b816a9b 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -216,7 +216,8 @@ (define (string->license string)
'unknown-license!)))
(string-split string (string->char-set " /"))))
-(define* (crate->guix-package crate-name #:key version include-dev-deps? repo)
+(define* (crate->guix-package crate-name #:key version include-dev-deps?
+ #:allow-other-keys)
"Fetch the metadata for CRATE-NAME from crates.io, and return the
`package' s-expression corresponding to that package, or #f on failure.
When VERSION is specified, convert it into a semver range and attempt to fetch
diff --git a/guix/import/egg.scm b/guix/import/egg.scm
index 0d6d72c465..6a189994fb 100644
--- a/guix/import/egg.scm
+++ b/guix/import/egg.scm
@@ -170,7 +170,8 @@ (define string->license
;;; Egg importer.
;;;
-(define* (egg->guix-package name version #:key (file #f) (source #f))
+(define* (egg->guix-package name version #:key (file #f) (source #f)
+ #:allow-other-keys)
"Import a CHICKEN egg called NAME from either the given .egg FILE, or from the
latest NAME metadata downloaded from the official repository if FILE is #f.
Return a <package> record or #f on failure. If VERSION is specified, import
diff --git a/guix/import/elm.scm b/guix/import/elm.scm
index 74902b8617..c8fb15343f 100644
--- a/guix/import/elm.scm
+++ b/guix/import/elm.scm
@@ -190,7 +190,7 @@ (define guix-name
(define elm->guix-package
(memoize
- (lambda* (package-name #:key repo version)
+ (lambda* (package-name #:key version #:allow-other-keys)
"Fetch the metadata for PACKAGE-NAME, an Elm package registered at
package.elm.org, and return two values: the `package' s-expression
corresponding to that package (or #f on failure) and a list of Elm
diff --git a/guix/import/gem.scm b/guix/import/gem.scm
index ad1343bff4..eaaae5dc9e 100644
--- a/guix/import/gem.scm
+++ b/guix/import/gem.scm
@@ -123,7 +123,8 @@ (define (make-gem-sexp name version hash home-page synopsis description
((license) (license->symbol license))
(_ `(list ,@(map license->symbol licenses)))))))
-(define* (gem->guix-package package-name #:key (repo 'rubygems) version)
+(define* (gem->guix-package package-name #:key (repo 'rubygems) version
+ #:allow-other-keys)
"Fetch the metadata for PACKAGE-NAME from rubygems.org, and return the
`package' s-expression corresponding to that package, or #f on failure.
Optionally include a VERSION string to fetch a specific version gem."
diff --git a/guix/import/gnu.scm b/guix/import/gnu.scm
index 2b9b71feb0..130844923e 100644
--- a/guix/import/gnu.scm
+++ b/guix/import/gnu.scm
@@ -109,7 +109,8 @@ (define sig-url
#f))))
(define* (gnu->guix-package name
- #:key (key-download 'interactive))
+ #:key (key-download 'interactive)
+ #:allow-other-keys)
"Return the package declaration for NAME as an s-expression. Use
KEY-DOWNLOAD as the OpenPGP key download policy (see 'download-tarball' for
details.)"
diff --git a/guix/import/go.scm b/guix/import/go.scm
index d00c13475a..90d4c8931d 100644
--- a/guix/import/go.scm
+++ b/guix/import/go.scm
@@ -602,7 +602,8 @@ (define (validate-version version available-versions module-path)
(define* (go-module->guix-package module-path #:key
(goproxy "https://proxy.golang.org")
version
- pin-versions?)
+ pin-versions?
+ #:allow-other-keys)
"Return the package S-expression corresponding to MODULE-PATH at VERSION, a Go package.
The meta-data is fetched from the GOPROXY server and https://pkg.go.dev/.
When VERSION is unspecified, the latest version available is used."
@@ -687,7 +688,7 @@ (define* (go-module-recursive-import package-name
package-name
#:repo->guix-package
(memoize
- (lambda* (name #:key version repo)
+ (lambda* (name #:key version repo #:allow-other-keys)
(receive (package-sexp dependencies)
(go-module->guix-package* name #:goproxy goproxy
#:version version
diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm
index 878a7d2f9c..bbce8b1fdc 100644
--- a/guix/import/hackage.scm
+++ b/guix/import/hackage.scm
@@ -323,7 +323,8 @@ (define (maybe-arguments)
(define* (hackage->guix-package package-name #:key
(include-test-dependencies? #t)
(port #f)
- (cabal-environment '()))
+ (cabal-environment '())
+ #:allow-other-keys)
"Fetch the Cabal file for PACKAGE-NAME from hackage.haskell.org, or, if the
called with keyword parameter PORT, from PORT. Return the `package'
S-expression corresponding to that package, or #f on failure.
@@ -350,7 +351,7 @@ (define hackage->guix-package/m ;memoized variant
(define* (hackage-recursive-import package-name . args)
(recursive-import package-name
- #:repo->guix-package (lambda* (name #:key repo version)
+ #:repo->guix-package (lambda* (name #:key version #:allow-other-keys)
(apply hackage->guix-package/m
(cons name args)))
#:guix-name hackage-name->package-name))
diff --git a/guix/import/hexpm.scm b/guix/import/hexpm.scm
index 2a7a9f3d82..de5e4c6e8e 100644
--- a/guix/import/hexpm.scm
+++ b/guix/import/hexpm.scm
@@ -234,7 +234,7 @@ (define (hexpm-latest-release package)
(fold (lambda (a b)
(if (version>? a b) a b)) (car versions) versions)))))
-(define* (hexpm->guix-package package-name #:key repo version)
+(define* (hexpm->guix-package package-name #:key version #:allow-other-keys)
"Fetch the metadata for PACKAGE-NAME from hexpms.io, and return the
`package' s-expression corresponding to that package, or #f on failure.
When VERSION is specified, attempt to fetch that version; otherwise fetch the
diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm
index 43cfb533e2..3bdc02120e 100644
--- a/guix/import/minetest.scm
+++ b/guix/import/minetest.scm
@@ -439,7 +439,8 @@ (define (filter-deduplicate-map f list)
#f)))))
dependency-list))
-(define* (%minetest->guix-package author/name #:key (sort %default-sort-key))
+(define* (%minetest->guix-package author/name #:key (sort %default-sort-key)
+ #:allow-other-keys)
"Fetch the metadata for AUTHOR/NAME from https://content.minetest.net, and
return the 'package' S-expression corresponding to that package, or raise an
exception on failure. On success, also return the upstream dependencies as a
@@ -475,7 +476,7 @@ (define minetest->guix-package
(memoize %minetest->guix-package))
(define* (minetest-recursive-import author/name #:key (sort %default-sort-key))
- (define* (minetest->guix-package* author/name #:key repo version)
+ (define* (minetest->guix-package* author/name #:key version #:allow-other-keys)
(minetest->guix-package author/name #:sort sort))
(recursive-import author/name
#:repo->guix-package minetest->guix-package*
diff --git a/guix/import/opam.scm b/guix/import/opam.scm
index b4b5a6eaad..7097281371 100644
--- a/guix/import/opam.scm
+++ b/guix/import/opam.scm
@@ -338,7 +338,7 @@ (define (opam->guix-source url-dict)
(sha256 (base32 ,(guix-hash-url temp)))))))
'no-source-information)))
-(define* (opam->guix-package name #:key (repo 'opam) version)
+(define* (opam->guix-package name #:key (repo 'opam) version #:allow-other-keys)
"Import OPAM package NAME from REPOSITORY (a directory name) or, if
REPOSITORY is #f, from the official OPAM repository. Return a 'package' sexp
or #f on failure."
diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm
index 4760fc3dae..f92cb46f84 100644
--- a/guix/import/pypi.scm
+++ b/guix/import/pypi.scm
@@ -491,7 +491,7 @@ (define (maybe-upstream-name name)
(define pypi->guix-package
(memoize
- (lambda* (package-name #:key repo version)
+ (lambda* (package-name #:key version #:allow-other-keys)
"Fetch the metadata for PACKAGE-NAME from pypi.org, and return the
`package' s-expression corresponding to that package, or #f on failure."
(let* ((project (pypi-fetch package-name))
diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm
index 49be982a7f..bde6d05762 100644
--- a/guix/import/stackage.scm
+++ b/guix/import/stackage.scm
@@ -108,7 +108,8 @@ (define stackage->guix-package
(lts-version %default-lts-version)
(packages
(stackage-lts-packages
- (stackage-lts-info-fetch lts-version))))
+ (stackage-lts-info-fetch lts-version)))
+ #:allow-other-keys)
"Fetch Cabal file for PACKAGE-NAME from hackage.haskell.org. The retrieved
version corresponds to the version of PACKAGE-NAME specified in the LTS-VERSION
release at stackage.org. Return the `package' S-expression corresponding to
@@ -125,7 +126,7 @@ (define stackage->guix-package
(define (stackage-recursive-import package-name . args)
(recursive-import package-name
- #:repo->guix-package (lambda* (name #:key repo version)
+ #:repo->guix-package (lambda* (name #:key version #:allow-other-keys)
(apply stackage->guix-package (cons name args)))
#:guix-name hackage-name->package-name))
diff --git a/guix/import/texlive.scm b/guix/import/texlive.scm
index 116bd1f66a..6bf7f92e60 100644
--- a/guix/import/texlive.scm
+++ b/guix/import/texlive.scm
@@ -303,9 +303,9 @@ (define (tlpdb->package name version package-database)
(define texlive->guix-package
(memoize
(lambda* (name #:key
- repo
(version (number->string %texlive-revision))
- (package-database tlpdb))
+ (package-database tlpdb)
+ #:allow-other-keys)
"Find the metadata for NAME in the tlpdb and return the `package'
s-expression corresponding to that package, or #f on failure."
(tlpdb->package name version (package-database)))))
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index d6b179b57c..45e55f1df6 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -580,11 +580,11 @@ (define (topological-sort nodes
(set-insert (node-name head) visited))))))))
(define* (recursive-import package-name
- #:key repo->guix-package guix-name version repo
- #:allow-other-keys)
+ #:key repo->guix-package guix-name version
+ #:allow-other-keys #:rest rest)
"Return a list of package expressions for PACKAGE-NAME and all its
dependencies, sorted in topological order. For each package,
-call (REPO->GUIX-PACKAGE NAME :KEYS version repo), which should return a
+call (REPO->GUIX-PACKAGE NAME :KEYS version), which should return a
package expression and a list of dependencies; call (GUIX-NAME PACKAGE-NAME)
to obtain the Guix package name corresponding to the upstream name."
(define-record-type <node>
@@ -599,9 +599,7 @@ (define (exists? name version)
(not (null? (find-packages-by-name (guix-name name) version))))
(define (lookup-node name version)
- (let* ((package dependencies (repo->guix-package name
- #:version version
- #:repo repo))
+ (let* ((package dependencies (apply repo->guix-package (cons name rest)))
(normalized-deps (map (match-lambda
((name version) (list name version))
(name (list name #f))) dependencies)))
--
2.37.4
[-- Attachment #3: 0002-import-cran-Allow-custom-license-prefix.patch --]
[-- Type: text/plain, Size: 8959 bytes --]
From 7d095e3ea747c9863289059fa839d2367fe3345a Mon Sep 17 00:00:00 2001
From: Lars-Dominik Braun <lars@6xq.net>
Date: Tue, 18 Oct 2022 12:45:15 +0200
Subject: [PATCH v2 2/6] import/cran: Allow custom license prefix.
* guix/import/cran.scm (string-licenses): Add license-prefix parameter.
(string->license): Ditto.
(description->package): Ditto.
(cran->guix-package): Ditto.
(cran-recursive-import): Ditto.
* guix/scripts/import/cran.scm (%options): Add new parameter -p/--license-prefix.
(show-help): Document it.
(parse-options): Pass it to importer.
* doc/guix.texi (Invoking guix import): Document it.
---
doc/guix.texi | 4 ++++
guix/import/cran.scm | 39 +++++++++++++++++++++---------------
guix/scripts/import/cran.scm | 21 ++++++++++++++++---
3 files changed, 45 insertions(+), 19 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 47b805dc7f..76cf3abea9 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -13486,6 +13486,10 @@ definitions are to be appended to existing user modules, as the list of
used package modules need not be changed. The default is
@option{--style=variable}.
+When @option{--prefix=license:} is added, the importer will prefix
+license atoms with @code{license:}, allowing a prefixed import of
+@code{(guix licenses)}.
+
When @option{--archive=bioconductor} is added, metadata is imported from
@uref{https://www.bioconductor.org/, Bioconductor}, a repository of R
packages for the analysis and comprehension of high-throughput
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index 41e5d45acf..c24862129f 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -82,16 +82,16 @@ (define-module (guix import cran)
(define %input-style
(make-parameter 'variable)) ; or 'specification
-(define (string->licenses license-string)
+(define (string->licenses license-string license-prefix)
(let ((licenses
(map string-trim-both
(string-tokenize license-string
(char-set-complement (char-set #\|))))))
- (string->license licenses)))
+ (string->license licenses license-prefix)))
-(define string->license
- (let ((prefix identity))
- (match-lambda
+(define (string->license license-string license-prefix)
+ (let ((prefix license-prefix))
+ (match license-string
("AGPL-3" (prefix 'agpl3))
("AGPL (>= 3)" (prefix 'agpl3+))
("Artistic-2.0" (prefix 'artistic2.0))
@@ -137,8 +137,8 @@ (define string->license
("MIT + file LICENSE" (prefix 'expat))
("file LICENSE"
`(,(prefix 'fsdg-compatible) "file://LICENSE"))
- ((x) (string->license x))
- ((lst ...) `(list ,@(map string->license lst)))
+ ((x) (string->license x license-prefix))
+ ((lst ...) `(list ,@(map (cut string->license <> license-prefix) lst)))
(unknown `(,(prefix 'fsdg-compatible) ,unknown)))))
(define (description->alist description)
@@ -503,7 +503,7 @@ (define (needs-pkg-config? thing tarball?)
(define (needs-knitr? meta)
(member "knitr" (listify meta "VignetteBuilder")))
-(define (description->package repository meta)
+(define* (description->package repository meta #:key (license-prefix identity))
"Return the `package' s-expression for an R package published on REPOSITORY
from the alist META, which was derived from the R package's DESCRIPTION file."
(let* ((base-url (case repository
@@ -523,7 +523,7 @@ (define (description->package repository meta)
(name (assoc-ref meta "Package"))
(synopsis (assoc-ref meta "Title"))
(version (assoc-ref meta "Version"))
- (license (string->licenses (assoc-ref meta "License")))
+ (license (string->licenses (assoc-ref meta "License") license-prefix))
;; Some packages have multiple home pages. Some have none.
(home-page (case repository
((git) (assoc-ref meta 'git))
@@ -639,31 +639,38 @@ (define (description->package repository meta)
(define cran->guix-package
(memoize
- (lambda* (package-name #:key (repo 'cran) version #:allow-other-keys)
+ (lambda* (package-name #:key (repo 'cran) version (license-prefix identity)
+ #:allow-other-keys)
"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 version)))
(if description
- (description->package repo description)
+ (description->package repo description
+ #:license-prefix license-prefix)
(case repo
((git)
;; Retry import from Bioconductor
- (cran->guix-package package-name #:repo 'bioconductor))
+ (cran->guix-package package-name #:repo 'bioconductor
+ #:license-prefix license-prefix))
((hg)
;; Retry import from Bioconductor
- (cran->guix-package package-name #:repo 'bioconductor))
+ (cran->guix-package package-name #:repo 'bioconductor
+ #:license-prefix license-prefix))
((bioconductor)
;; Retry import from CRAN
- (cran->guix-package package-name #:repo 'cran))
+ (cran->guix-package package-name #:repo 'cran
+ #:license-prefix license-prefix))
(else
(values #f '()))))))))
-(define* (cran-recursive-import package-name #:key (repo 'cran) version)
+(define* (cran-recursive-import package-name #:key (repo 'cran) version
+ (license-prefix identity))
(recursive-import package-name
#:version version
#:repo repo
#:repo->guix-package cran->guix-package
- #:guix-name cran-guix-name))
+ #:guix-name cran-guix-name
+ #:license-prefix license-prefix))
\f
;;;
diff --git a/guix/scripts/import/cran.scm b/guix/scripts/import/cran.scm
index 2934d4300a..5298f059f2 100644
--- a/guix/scripts/import/cran.scm
+++ b/guix/scripts/import/cran.scm
@@ -53,6 +53,9 @@ (define (show-help)
(display (G_ "
-s, --style=STYLE choose output style, either specification or variable"))
(display (G_ "
+ -p, --license-prefix=PREFIX
+ add custom prefix to licenses"))
+ (display (G_ "
-V, --version display version information and exit"))
(newline)
(show-bug-report-information))
@@ -74,6 +77,10 @@ (define %options
(lambda (opt name arg result)
(alist-cons 'style (string->symbol arg)
(alist-delete 'style result))))
+ (option '(#\p "license-prefix") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'license-prefix arg
+ (alist-delete 'license-prefix result))))
(option '(#\r "recursive") #f #f
(lambda (opt name arg result)
(alist-cons 'recursive #t result)))
@@ -95,7 +102,13 @@ (define (parse-options)
(('argument . value)
value)
(_ #f))
- (reverse opts))))
+ (reverse opts)))
+ (prefix (assoc-ref opts 'license-prefix))
+ (prefix-proc (if (string? prefix)
+ (lambda (symbol)
+ (string->symbol
+ (string-append prefix (symbol->string symbol))))
+ identity)))
(parameterize ((%input-style (assoc-ref opts 'style)))
(match args
((spec)
@@ -107,11 +120,13 @@ (define (parse-options)
(filter identity
(cran-recursive-import name
#:version version
- #:repo (or (assoc-ref opts 'repo) 'cran)))))
+ #:repo (or (assoc-ref opts 'repo) 'cran)
+ #:license-prefix prefix-proc))))
;; Single import
(let ((sexp (cran->guix-package name
#:version version
- #:repo (or (assoc-ref opts 'repo) 'cran))))
+ #:repo (or (assoc-ref opts 'repo) 'cran)
+ #:license-prefix prefix-proc)))
(unless sexp
(leave (G_ "failed to download description for package '~a'~%")
name))
--
2.37.4
[-- Attachment #4: 0003-import-cran-Allow-overriding-description-fetch-funct.patch --]
[-- Type: text/plain, Size: 1010 bytes --]
From fd4a29319686f99bb5d312baefe687dcef3b3f88 Mon Sep 17 00:00:00 2001
From: Lars-Dominik Braun <lars@6xq.net>
Date: Tue, 18 Oct 2022 12:45:45 +0200
Subject: [PATCH v2 3/6] import/cran: Allow overriding description fetch
function.
* guix/import/cran.scm (cran->guix-package): New parameter FETCH-DESCRIPTION.
---
guix/import/cran.scm | 1 +
1 file changed, 1 insertion(+)
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index c24862129f..b2c58ee5ec 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -640,6 +640,7 @@ (define* (description->package repository meta #:key (license-prefix identity))
(define cran->guix-package
(memoize
(lambda* (package-name #:key (repo 'cran) version (license-prefix identity)
+ (fetch-description fetch-description)
#:allow-other-keys)
"Fetch the metadata for PACKAGE-NAME from REPO and return the `package'
s-expression corresponding to that package, or #f on failure."
--
2.37.4
[-- Attachment #5: 0004-import-cran-Allow-overriding-tarball-download.patch --]
[-- Type: text/plain, Size: 3012 bytes --]
From 217f9f6af608324e593ce114108b97b65182339d Mon Sep 17 00:00:00 2001
From: Lars-Dominik Braun <lars@6xq.net>
Date: Tue, 18 Oct 2022 12:45:56 +0200
Subject: [PATCH v2 4/6] import/cran: Allow overriding tarball download.
* guix/import/cran.scm (description->package): New parameter DOWNLOAD-SOURCE.
(cran->guix-package): Ditto.
---
guix/import/cran.scm | 15 +++++++++------
1 file changed, 9 insertions(+), 6 deletions(-)
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index b2c58ee5ec..a89deb8e55 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -503,7 +503,8 @@ (define (needs-pkg-config? thing tarball?)
(define (needs-knitr? meta)
(member "knitr" (listify meta "VignetteBuilder")))
-(define* (description->package repository meta #:key (license-prefix identity))
+(define* (description->package repository meta #:key (license-prefix identity)
+ (download-source download))
"Return the `package' s-expression for an R package published on REPOSITORY
from the alist META, which was derived from the R package's DESCRIPTION file."
(let* ((base-url (case repository
@@ -545,10 +546,10 @@ (define* (description->package repository meta #:key (license-prefix identity))
(_ #f)))))
(git? (if (assoc-ref meta 'git) #true #false))
(hg? (if (assoc-ref meta 'hg) #true #false))
- (source (download source-url #:method (cond
- (git? 'git)
- (hg? 'hg)
- (else #f))))
+ (source (download-source source-url #:method (cond
+ (git? 'git)
+ (hg? 'hg)
+ (else #f))))
(sysdepends (append
(if (needs-zlib? source (not (or git? hg?))) '("zlib") '())
(filter (lambda (name)
@@ -641,13 +642,15 @@ (define cran->guix-package
(memoize
(lambda* (package-name #:key (repo 'cran) version (license-prefix identity)
(fetch-description fetch-description)
+ (download-source download)
#:allow-other-keys)
"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 version)))
(if description
(description->package repo description
- #:license-prefix license-prefix)
+ #:license-prefix license-prefix
+ #:download-source download-source)
(case repo
((git)
;; Retry import from Bioconductor
--
2.37.4
[-- Attachment #6: 0005-import-cran-Translate-more-package-dependencies.patch --]
[-- Type: text/plain, Size: 1945 bytes --]
From 28727bc88843b9cf31f1b2eaba5be039ae47856e Mon Sep 17 00:00:00 2001
From: Lars-Dominik Braun <lars@6xq.net>
Date: Sat, 22 Oct 2022 10:37:50 +0200
Subject: [PATCH v2 5/6] import/cran: Translate more package dependencies.
Assumes we use package variable names, not package specification names.
* guix/import/cran.scm (invalid-packages): Add more invalid names.
(transform-sysname): Transform more package names.
---
guix/import/cran.scm | 25 +++++++++++++++++++++++--
1 file changed, 23 insertions(+), 2 deletions(-)
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index a89deb8e55..b10d9f391b 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -394,10 +394,13 @@ (define invalid-packages
"c++11"
"c++14"
"c++17"
+ "c99"
"getopt::long"
"posix.1-2001"
+ "gnu"
"linux"
"none"
+ "posix.1-2001"
"windows"
"xcode"
"xquartz"))
@@ -405,12 +408,30 @@ (define invalid-packages
(define (transform-sysname sysname)
"Return a Guix package name for the common package name SYSNAME."
(match sysname
+ ("booktabs" "texlive-booktabs")
+ ("bowtie2" "bowtie")
+ ("cat" "coreutils")
("java" "openjdk")
+ ("exiftool" "perl-image-exiftool")
("fftw3" "fftw")
- ("tcl/tk" "tcl")
- ("booktabs" "texlive-booktabs")
("freetype2" "freetype")
+ ("gettext" "gnu-gettext")
+ ("gmake" "gnu-make")
+ ("libarchive-devel" "libarchive")
+ ("libarchive_dev" "libarchive")
+ ("libbz2" "bzip2")
+ ("libexpat" "expat")
+ ("liblz4" "lz4")
+ ("liblzma" "xz")
+ ("libzstd" "zstd")
+ ("libxml2-devel" "libxml2")
+ ("libz" "zlib")
+ ("pandoc-citeproc" "pandoc")
+ ("python3" "python-3")
("sqlite3" "sqlite")
+ ("svn" "subversion")
+ ("tcl/tk" "tcl")
+ ("whoami" "coreutils")
(_ sysname)))
(define cran-guix-name (cut guix-name "r-" <>))
--
2.37.4
[-- Attachment #7: 0006-import-cran-Always-operate-on-source-directory.patch --]
[-- Type: text/plain, Size: 6578 bytes --]
From 9494a859de4cd8870c942232ac9b5a80b0e56a92 Mon Sep 17 00:00:00 2001
From: Lars-Dominik Braun <lars@6xq.net>
Date: Sun, 27 Nov 2022 15:39:34 +0100
Subject: [PATCH v2 6/6] import/cran: Always operate on source directory.
Extracting the source tarball multiple times is very slow and a
speedup of >2x (without network I/O) can be achieved by coalescing all
NEEDS-X? functions into a single one, which extracts a tarball only once.
* guix/import/cran.scm (tarball-needs-fortran?): Remove unused function.
(needs-fortran?): Ditto.
(tarball-files-match-pattern?): Ditto.
(tarball-needs-zlib?): Ditto.
(needs-zlib?): Ditto.
(tarball-needs-pkg-config?): Ditto.
(needs-pkg-config?): Ditto.
(source-dir->dependencies): New function.
(source->dependencies): New function.
(description->package): Use it.
---
guix/import/cran.scm | 80 +++++++++++++-------------------------------
1 file changed, 24 insertions(+), 56 deletions(-)
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index b10d9f391b..f130543c4c 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -436,28 +436,12 @@ (define (transform-sysname sysname)
(define cran-guix-name (cut guix-name "r-" <>))
-(define (tarball-needs-fortran? tarball)
- "Check if the TARBALL contains Fortran source files."
- (define (check pattern)
- (parameterize ((current-error-port (%make-void-port "rw+"))
- (current-output-port (%make-void-port "rw+")))
- (zero? (system* "tar" "--wildcards" "--list" pattern "-f" tarball))))
- (or (check "*.f90")
- (check "*.f95")
- (check "*.f")))
-
(define (directory-needs-fortran? dir)
"Check if the directory DIR contains Fortran source files."
(match (find-files dir "\\.f(90|95)$")
(() #f)
(_ #t)))
-(define (needs-fortran? thing tarball?)
- "Check if the THING contains Fortran source files."
- (if tarball?
- (tarball-needs-fortran? thing)
- (directory-needs-fortran? thing)))
-
(define (files-match-pattern? directory regexp . file-patterns)
"Return #T if any of the files matching FILE-PATTERNS in the DIRECTORY match
the given REGEXP."
@@ -473,53 +457,36 @@ (define (files-match-pattern? directory regexp . file-patterns)
(else (loop))))))))
(apply find-files directory file-patterns))))
-(define (tarball-files-match-pattern? tarball regexp . file-patterns)
- "Return #T if any of the files represented by FILE-PATTERNS in the TARBALL
-match the given REGEXP."
- (call-with-temporary-directory
- (lambda (dir)
- (parameterize ((current-error-port (%make-void-port "rw+")))
- (apply system* "tar"
- "xf" tarball "-C" dir
- `("--wildcards" ,@file-patterns)))
- (files-match-pattern? dir regexp))))
-
(define (directory-needs-zlib? dir)
"Return #T if any of the Makevars files in the src directory DIR contain a
zlib linker flag."
(files-match-pattern? dir "-lz" "(Makevars.*|configure.*)"))
-(define (tarball-needs-zlib? tarball)
- "Return #T if any of the Makevars files in the src directory of the TARBALL
-contain a zlib linker flag."
- (tarball-files-match-pattern?
- tarball "-lz"
- "*/src/Makevars*" "*/src/configure*" "*/configure*"))
-
-(define (needs-zlib? thing tarball?)
- "Check if the THING contains files indicating a dependency on zlib."
- (if tarball?
- (tarball-needs-zlib? thing)
- (directory-needs-zlib? thing)))
-
(define (directory-needs-pkg-config? dir)
"Return #T if any of the Makevars files in the src directory DIR reference
the pkg-config tool."
(files-match-pattern? dir "pkg-config"
"(Makevars.*|configure.*)"))
-(define (tarball-needs-pkg-config? tarball)
- "Return #T if any of the Makevars files in the src directory of the TARBALL
-reference the pkg-config tool."
- (tarball-files-match-pattern?
- tarball "pkg-config"
- "*/src/Makevars*" "*/src/configure*" "*/configure*"))
-
-(define (needs-pkg-config? thing tarball?)
- "Check if the THING contains files indicating a dependency on pkg-config."
+(define (source-dir->dependencies dir)
+ "Guess dependencies of R package source in DIR and return (INPUTS
+NATIVE-INPUTS)."
+ (list
+ (if (directory-needs-zlib? dir) '("zlib") '())
+ (append
+ (if (directory-needs-pkg-config? dir) '("pkg-config") '())
+ (if (directory-needs-fortran? dir) '("gfortran") '()))))
+
+(define (source->dependencies source tarball?)
+ "SOURCE-DIR->DEPENDENCIES, but for directories and tarballs as indicated
+by TARBALL?"
(if tarball?
- (tarball-needs-pkg-config? thing)
- (directory-needs-pkg-config? thing)))
+ (call-with-temporary-directory
+ (lambda (dir)
+ (parameterize ((current-error-port (%make-void-port "rw+")))
+ (system* "tar" "xf" source "-C" dir))
+ (source-dir->dependencies dir)))
+ (source-dir->dependencies source)))
(define (needs-knitr? meta)
(member "knitr" (listify meta "VignetteBuilder")))
@@ -571,8 +538,12 @@ (define* (description->package repository meta #:key (license-prefix identity)
(git? 'git)
(hg? 'hg)
(else #f))))
+ (tarball? (not (or git? hg?)))
+ (source-inputs-all (source->dependencies source tarball?))
+ (source-inputs (car source-inputs-all))
+ (source-native-inputs (cadr source-inputs-all))
(sysdepends (append
- (if (needs-zlib? source (not (or git? hg?))) '("zlib") '())
+ source-inputs
(filter (lambda (name)
(not (member name invalid-packages)))
(map string-downcase (listify meta "SystemRequirements")))))
@@ -632,10 +603,7 @@ (define* (description->package repository meta #:key (license-prefix identity)
,@(maybe-inputs (map transform-sysname sysdepends))
,@(maybe-inputs (map cran-guix-name propagate) 'propagated-inputs)
,@(maybe-inputs
- `(,@(if (needs-fortran? source (not (or git? hg?)))
- '("gfortran") '())
- ,@(if (needs-pkg-config? source (not (or git? hg?)))
- '("pkg-config") '())
+ `(,@source-native-inputs
,@(if (needs-knitr? meta)
'("r-knitr") '()))
'native-inputs)
--
2.37.4
^ permalink raw reply related [flat|nested] 6+ messages in thread