(address . guix-patches@gnu.org)
Y0/DVVjwYCtiDRxd@noor.fritz.box
Hi,
the attached patches are required for guix-cran
(https://github.com/guix-science/guix-cran).import/cran already has the
ability to add a prefix to licenses, but it was not exposed. Additionally
I need to parameterize fetch/download functions, so I can cache the
tarballs/DESCRIPTION files.
Cheers,
Lars
Lars-Dominik Braun (3):
import/cran: Allow custom license prefix.
import/cran: Allow overriding description fetch function.
import/cran: Allow overriding tarball download.
guix/import/cran.scm | 30 +++++++++++++++++++++---------
guix/scripts/import/cran.scm | 18 ++++++++++++++++--
2 files changed, 37 insertions(+), 11 deletions(-)
--
2.37.3
From 758a4f70fda5758449747e14db1991f6243174b1 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 1/3] import/cran: Allow custom license prefix.
X-Debbugs-Cc: zimon.toutoune@gmail.com
X-Debbugs-Cc: dev@jpoiret.xyz
X-Debbugs-Cc: mail@cbaines.net
X-Debbugs-Cc: rekado@elephly.net
X-Debbugs-Cc: othacehe@gnu.org
X-Debbugs-Cc: ludo@gnu.org
* guix/import/cran.scm (%license-prefix): New parameter.
(string->license): Use it.
* guix/scripts/import/cran.scm (%options): Add new parameter -p/--license-prefix.
(show-help): Document it.
(parse-options): Pass it as a parameter to importer.
---
guix/import/cran.scm | 10 +++++++---
guix/scripts/import/cran.scm | 18 ++++++++++++++++--
2 files changed, 23 insertions(+), 5 deletions(-)
Toggle diff (80 lines)
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index 17e33d5f52..d13231f633 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -55,6 +55,7 @@ (define-module (guix import cran)
#:use-module (guix packages)
#:use-module (gnu packages)
#:export (%input-style
+ %license-prefix
cran->guix-package
bioconductor->guix-package
@@ -82,6 +83,9 @@ (define-module (guix import cran)
(define %input-style
(make-parameter 'variable)) ; or 'specification
+(define %license-prefix
+ (make-parameter identity))
+
(define (string->licenses license-string)
(let ((licenses
(map string-trim-both
@@ -89,9 +93,9 @@ (define (string->licenses license-string)
(char-set-complement (char-set #\|))))))
(string->license licenses)))
-(define string->license
- (let ((prefix identity))
- (match-lambda
+(define (string->license license-string)
+ (let ((prefix (%license-prefix)))
+ (match license-string
("AGPL-3" (prefix 'agpl3))
("AGPL (>= 3)" (prefix 'agpl3+))
("Artistic-2.0" (prefix 'artistic2.0))
diff --git a/guix/scripts/import/cran.scm b/guix/scripts/import/cran.scm
index 2934d4300a..3186bf9248 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, useful for prefixed import of (guix 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,8 +102,15 @@ (define (parse-options)
(('argument . value)
value)
(_ #f))
- (reverse opts))))
- (parameterize ((%input-style (assoc-ref opts 'style)))
+ (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))
+ (%license-prefix prefix-proc))
(match args
((spec)
(let ((name version (package-name->name+version spec)))
--
2.37.3
From 19b0e079f409b90a51620454a1d3026d379c3fb1 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 2/3] import/cran: Allow overriding description fetch function.
X-Debbugs-Cc: zimon.toutoune@gmail.com
X-Debbugs-Cc: dev@jpoiret.xyz
X-Debbugs-Cc: mail@cbaines.net
X-Debbugs-Cc: rekado@elephly.net
X-Debbugs-Cc: othacehe@gnu.org
X-Debbugs-Cc: ludo@gnu.org
* guix/import/cran.scm (%fetch-description): New parameter.
(cran->guix-package): Use it.
(upstream-name): Use it.
---
guix/import/cran.scm | 8 ++++++--
1 file changed, 6 insertions(+), 2 deletions(-)
Toggle diff (42 lines)
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index d13231f633..05374b5317 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -56,6 +56,7 @@ (define-module (guix import cran)
#:use-module (gnu packages)
#:export (%input-style
%license-prefix
+ %fetch-description
cran->guix-package
bioconductor->guix-package
@@ -350,6 +351,9 @@ (define* (fetch-description repository name #:optional version)
`(hg-changeset . ,changeset)
meta)))))))))
+(define %fetch-description
+ (make-parameter fetch-description))
+
(define (listify meta field)
"Look up FIELD in the alist META. If FIELD contains a comma-separated
string, turn it into a list and strip off parenthetic expressions. Return the
@@ -640,7 +644,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 version)))
+ (let ((description ((%fetch-description) repo package-name version)))
(if description
(description->package repo description)
(case repo
@@ -694,7 +698,7 @@ (define upstream-name
(package->upstream-name pkg))
(define meta
- (fetch-description 'cran upstream-name))
+ ((%fetch-description) 'cran upstream-name))
(and meta
(let ((version (assoc-ref meta "Version")))
--
2.37.3
From 89e46f83c2a39a63326bb4faedf36fb678c03a03 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 3/3] import/cran: Allow overriding tarball download.
X-Debbugs-Cc: zimon.toutoune@gmail.com
X-Debbugs-Cc: dev@jpoiret.xyz
X-Debbugs-Cc: mail@cbaines.net
X-Debbugs-Cc: rekado@elephly.net
X-Debbugs-Cc: othacehe@gnu.org
X-Debbugs-Cc: ludo@gnu.org
* guix/import/cran.scm (%download-source): New parameter.
(description->package): Use it.
---
guix/import/cran.scm | 12 ++++++++----
1 file changed, 8 insertions(+), 4 deletions(-)
Toggle diff (39 lines)
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index 05374b5317..2a12963532 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -57,6 +57,7 @@ (define-module (guix import cran)
#:export (%input-style
%license-prefix
%fetch-description
+ %download-source
cran->guix-package
bioconductor->guix-package
@@ -265,6 +266,9 @@ (define download
;; of the URLs is the /Archive CRAN URL.
(any (cut download-to-store store <>) urls)))))))))
+(define %download-source
+ (make-parameter download))
+
(define (fetch-description-from-tarball url)
"Fetch the tarball at URL, extra its 'DESCRIPTION' file, parse it, and
return the resulting alist."
@@ -547,10 +551,10 @@ (define (description->package repository meta)
(_ #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)
--
2.37.3