mirror of
https://https.git.savannah.gnu.org/git/guix.git/
synced 2025-07-12 10:00:46 +02:00
import: npm-binary: Handle vector of licenses.
* guix/import/npm-binary.scm (<package-revision>)[license]: Handle the case where a vector of licenses is used. * tests/npm-binary.scm (foo-json): Redefine as a procedure with license keyword. (test-source-hash): Redefine with direct reference to test-source. (foo-sexp): Redefine as a procedure with license keyword. (npm-binary->guix-package test): Use foo-json and foo-sexp. (npm-binary->guix-package with multiple licenses): Add test. Change-Id: I9d6adb2ae2820678260fed1a67e91e22feb448b8 Signed-off-by: Jelle Licht <jlicht@fsfe.org>
This commit is contained in:
Nicolas Graves via Guix-patches via
Andreas Enge
parent
8aca24f41e
commit
d3086f85e0
2 changed files with 102 additions and 72 deletions
|
|
@ -105,7 +105,17 @@
|
||||||
(match (assoc "type" alist)
|
(match (assoc "type" alist)
|
||||||
((_ . (? string? type))
|
((_ . (? string? type))
|
||||||
(spdx-string->license type))
|
(spdx-string->license type))
|
||||||
(_ #f)))))
|
(_ #f)))
|
||||||
|
((? vector? vector)
|
||||||
|
(match (filter-map
|
||||||
|
(match-lambda
|
||||||
|
((? string? str) (spdx-string->license str))
|
||||||
|
(_ #f))
|
||||||
|
(vector->list vector))
|
||||||
|
((license rest ...)
|
||||||
|
(cons* license rest))
|
||||||
|
((license)
|
||||||
|
license)))))
|
||||||
(description package-revision-description ;string
|
(description package-revision-description ;string
|
||||||
"description" empty-or-string)
|
"description" empty-or-string)
|
||||||
(dist package-revision-dist "dist" json->dist)) ;dist
|
(dist package-revision-dist "dist" json->dist)) ;dist
|
||||||
|
|
@ -250,7 +260,9 @@
|
||||||
(home-page ,home-page)
|
(home-page ,home-page)
|
||||||
(synopsis ,synopsis)
|
(synopsis ,synopsis)
|
||||||
(description ,description)
|
(description ,description)
|
||||||
(license ,license))
|
(license ,(if (list? license)
|
||||||
|
`(list ,@license)
|
||||||
|
license)))
|
||||||
(map (match-lambda (($ <package-revision> name version)
|
(map (match-lambda (($ <package-revision> name version)
|
||||||
(list name (semver->string version))))
|
(list name (semver->string version))))
|
||||||
resolved-deps))))
|
resolved-deps))))
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,6 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2024 Jelle Licht <jlicht@fsfe.org>
|
;;; Copyright © 2024 Jelle Licht <jlicht@fsfe.org>
|
||||||
|
;;; Copyright © 2025 Nicolas Graves <ngraves@ngraves.fr>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
|
@ -24,42 +25,35 @@
|
||||||
#:use-module (srfi srfi-64)
|
#:use-module (srfi srfi-64)
|
||||||
#:use-module (ice-9 iconv)
|
#:use-module (ice-9 iconv)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
|
#:use-module (json)
|
||||||
#:export (run-test))
|
#:export (run-test))
|
||||||
|
|
||||||
(define foo-json
|
(define* (foo-json #:key (license "MIT"))
|
||||||
"{
|
"Create a JSON description of an example foo npm package, optionally using a
|
||||||
\"name\": \"foo\",
|
different @var{license}."
|
||||||
\"dist-tags\": {
|
(scm->json-string
|
||||||
\"latest\": \"1.2.3\",
|
`((name . "foo")
|
||||||
\"next\": \"2.0.1-beta4\"
|
(dist-tags . ((latest . "1.2.3")
|
||||||
},
|
(next . "2.0.1-beta4")))
|
||||||
\"description\": \"General purpose utilities to foo your bars\",
|
(description . "General purpose utilities to foo your bars")
|
||||||
\"homepage\": \"https://github.com/quartz/foo\",
|
(homepage . "https://github.com/quartz/foo")
|
||||||
\"repository\": \"quartz/foo\",
|
(repository . "quartz/foo")
|
||||||
\"versions\": {
|
(versions
|
||||||
\"1.2.3\": {
|
. ((1.2.3
|
||||||
\"name\": \"foo\",
|
. ((name . "foo")
|
||||||
\"description\": \"General purpose utilities to foo your bars\",
|
(description . "General purpose utilities to foo your bars")
|
||||||
\"version\": \"1.2.3\",
|
(version . "1.2.3")
|
||||||
\"author\": \"Jelle Licht <jlicht@fsfe.org>\",
|
(author . "Jelle Licht <jlicht@fsfe.org>")
|
||||||
\"devDependencies\": {
|
(devDependencies . ((node-megabuilder . "^0.0.2")))
|
||||||
\"node-megabuilder\": \"^0.0.2\"
|
(dependencies . ((bar . "^0.1.0")))
|
||||||
},
|
(repository . ((url . "quartz/foo")))
|
||||||
\"dependencies\": {
|
(homepage . "https://github.com/quartz/foo")
|
||||||
\"bar\": \"^0.1.0\"
|
(license . ,license)
|
||||||
},
|
(dist
|
||||||
\"repository\": {
|
. ((tarball
|
||||||
\"url\": \"quartz/foo\"
|
. "https://registry.npmjs.org/foo/-/foo-1.2.3.tgz"))))))))))
|
||||||
},
|
|
||||||
\"homepage\": \"https://github.com/quartz/foo\",
|
|
||||||
\"license\": \"MIT\",
|
|
||||||
\"dist\": {
|
|
||||||
\"tarball\": \"https://registry.npmjs.org/foo/-/foo-1.2.3.tgz\"
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}")
|
|
||||||
|
|
||||||
|
;; Dependency JSON for the bar package
|
||||||
(define bar-json
|
(define bar-json
|
||||||
"{
|
"{
|
||||||
\"name\": \"bar\",
|
\"name\": \"bar\",
|
||||||
|
|
@ -87,44 +81,25 @@
|
||||||
}
|
}
|
||||||
}")
|
}")
|
||||||
|
|
||||||
(define test-source-hash
|
|
||||||
"")
|
|
||||||
|
|
||||||
(define test-source
|
(define test-source
|
||||||
"Empty file\n")
|
"Empty file\n")
|
||||||
|
|
||||||
|
(define test-source-hash
|
||||||
|
(bytevector->nix-base32-string
|
||||||
|
(gcrypt-sha256 (string->bytevector test-source "utf-8"))))
|
||||||
|
|
||||||
(define have-guile-semver?
|
(define have-guile-semver?
|
||||||
(false-if-exception (resolve-interface '(semver))))
|
(false-if-exception (resolve-interface '(semver))))
|
||||||
|
|
||||||
(test-begin "npm")
|
(define* (foo-sexp #:key (license 'license:expat))
|
||||||
|
`(package
|
||||||
(unless have-guile-semver? (test-skip 1))
|
|
||||||
(test-assert "npm-binary->guix-package"
|
|
||||||
(mock ((guix http-client) http-fetch
|
|
||||||
(lambda* (url #:rest _)
|
|
||||||
(match url
|
|
||||||
("https://registry.npmjs.org/foo"
|
|
||||||
(values (open-input-string foo-json)
|
|
||||||
(string-length foo-json)))
|
|
||||||
("https://registry.npmjs.org/bar"
|
|
||||||
(values (open-input-string bar-json)
|
|
||||||
(string-length bar-json)))
|
|
||||||
("https://registry.npmjs.org/foo/-/foo-1.2.3.tgz"
|
|
||||||
(set! test-source-hash
|
|
||||||
(bytevector->nix-base32-string
|
|
||||||
(gcrypt-sha256 (string->bytevector test-source "utf-8"))))
|
|
||||||
(values (open-input-string test-source)
|
|
||||||
(string-length test-source))))))
|
|
||||||
(match (npm-binary->guix-package "foo")
|
|
||||||
(`(package
|
|
||||||
(name "node-foo")
|
(name "node-foo")
|
||||||
(version "1.2.3")
|
(version "1.2.3")
|
||||||
(source (origin
|
(source (origin
|
||||||
(method url-fetch)
|
(method url-fetch)
|
||||||
(uri "https://registry.npmjs.org/foo/-/foo-1.2.3.tgz")
|
(uri "https://registry.npmjs.org/foo/-/foo-1.2.3.tgz")
|
||||||
(sha256
|
(sha256
|
||||||
(base32
|
(base32 "1n0h7zg9zzv4f7yn2gp0mq1v107im7pi6qq4k6q86rixz71ijklh"))))
|
||||||
,test-source-hash))))
|
|
||||||
(build-system node-build-system)
|
(build-system node-build-system)
|
||||||
(arguments
|
(arguments
|
||||||
(list #:tests? #f
|
(list #:tests? #f
|
||||||
|
|
@ -139,9 +114,52 @@
|
||||||
(home-page "https://github.com/quartz/foo")
|
(home-page "https://github.com/quartz/foo")
|
||||||
(synopsis "General purpose utilities to foo your bars")
|
(synopsis "General purpose utilities to foo your bars")
|
||||||
(description "General purpose utilities to foo your bars")
|
(description "General purpose utilities to foo your bars")
|
||||||
(license license:expat))
|
(license ,license)))
|
||||||
|
|
||||||
|
(test-begin "npm")
|
||||||
|
|
||||||
|
(unless have-guile-semver? (test-skip 1))
|
||||||
|
(test-assert "npm-binary->guix-package base case"
|
||||||
|
(mock ((guix http-client) http-fetch
|
||||||
|
(lambda* (url #:rest _)
|
||||||
|
(match url
|
||||||
|
("https://registry.npmjs.org/foo"
|
||||||
|
(let ((json-foo (foo-json)))
|
||||||
|
(values (open-input-string json-foo)
|
||||||
|
(string-length json-foo))))
|
||||||
|
("https://registry.npmjs.org/bar"
|
||||||
|
(values (open-input-string bar-json)
|
||||||
|
(string-length bar-json)))
|
||||||
|
("https://registry.npmjs.org/foo/-/foo-1.2.3.tgz"
|
||||||
|
(values (open-input-string test-source)
|
||||||
|
(string-length test-source))))))
|
||||||
|
(let ((sexp-foo (foo-sexp)))
|
||||||
|
(match (npm-binary->guix-package "foo")
|
||||||
|
(sexp-foo
|
||||||
#t)
|
#t)
|
||||||
(x
|
(x
|
||||||
(pk 'fail x #f)))))
|
(pk 'fail x #f))))))
|
||||||
|
|
||||||
|
(test-assert "npm-binary->guix-package with multiple licenses"
|
||||||
|
(mock ((guix http-client) http-fetch
|
||||||
|
(lambda* (url #:rest _)
|
||||||
|
(match url
|
||||||
|
("https://registry.npmjs.org/foo"
|
||||||
|
(let ((json-foo (foo-json #:license #("MIT" "Apache2.0"))))
|
||||||
|
(values (open-input-string json-foo)
|
||||||
|
(string-length json-foo))))
|
||||||
|
("https://registry.npmjs.org/bar"
|
||||||
|
(values (open-input-string bar-json)
|
||||||
|
(string-length bar-json)))
|
||||||
|
("https://registry.npmjs.org/foo/-/foo-1.2.3.tgz"
|
||||||
|
(values (open-input-string test-source)
|
||||||
|
(string-length test-source))))))
|
||||||
|
(let ((sexp-foo (foo-sexp
|
||||||
|
#:license '(list license:expat license:asl2.0))))
|
||||||
|
(match (npm-binary->guix-package "foo")
|
||||||
|
(sexp-foo
|
||||||
|
#t)
|
||||||
|
(x
|
||||||
|
(pk 'fail x #f))))))
|
||||||
|
|
||||||
(test-end "npm")
|
(test-end "npm")
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue