mirror of
https://https.git.savannah.gnu.org/git/guix.git/
synced 2025-07-10 16:50:43 +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)
|
||||
((_ . (? string? 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" empty-or-string)
|
||||
(dist package-revision-dist "dist" json->dist)) ;dist
|
||||
|
|
@ -250,7 +260,9 @@
|
|||
(home-page ,home-page)
|
||||
(synopsis ,synopsis)
|
||||
(description ,description)
|
||||
(license ,license))
|
||||
(license ,(if (list? license)
|
||||
`(list ,@license)
|
||||
license)))
|
||||
(map (match-lambda (($ <package-revision> name version)
|
||||
(list name (semver->string version))))
|
||||
resolved-deps))))
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2024 Jelle Licht <jlicht@fsfe.org>
|
||||
;;; Copyright © 2025 Nicolas Graves <ngraves@ngraves.fr>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
|
@ -24,42 +25,35 @@
|
|||
#:use-module (srfi srfi-64)
|
||||
#:use-module (ice-9 iconv)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (json)
|
||||
#:export (run-test))
|
||||
|
||||
(define foo-json
|
||||
"{
|
||||
\"name\": \"foo\",
|
||||
\"dist-tags\": {
|
||||
\"latest\": \"1.2.3\",
|
||||
\"next\": \"2.0.1-beta4\"
|
||||
},
|
||||
\"description\": \"General purpose utilities to foo your bars\",
|
||||
\"homepage\": \"https://github.com/quartz/foo\",
|
||||
\"repository\": \"quartz/foo\",
|
||||
\"versions\": {
|
||||
\"1.2.3\": {
|
||||
\"name\": \"foo\",
|
||||
\"description\": \"General purpose utilities to foo your bars\",
|
||||
\"version\": \"1.2.3\",
|
||||
\"author\": \"Jelle Licht <jlicht@fsfe.org>\",
|
||||
\"devDependencies\": {
|
||||
\"node-megabuilder\": \"^0.0.2\"
|
||||
},
|
||||
\"dependencies\": {
|
||||
\"bar\": \"^0.1.0\"
|
||||
},
|
||||
\"repository\": {
|
||||
\"url\": \"quartz/foo\"
|
||||
},
|
||||
\"homepage\": \"https://github.com/quartz/foo\",
|
||||
\"license\": \"MIT\",
|
||||
\"dist\": {
|
||||
\"tarball\": \"https://registry.npmjs.org/foo/-/foo-1.2.3.tgz\"
|
||||
}
|
||||
}
|
||||
}
|
||||
}")
|
||||
(define* (foo-json #:key (license "MIT"))
|
||||
"Create a JSON description of an example foo npm package, optionally using a
|
||||
different @var{license}."
|
||||
(scm->json-string
|
||||
`((name . "foo")
|
||||
(dist-tags . ((latest . "1.2.3")
|
||||
(next . "2.0.1-beta4")))
|
||||
(description . "General purpose utilities to foo your bars")
|
||||
(homepage . "https://github.com/quartz/foo")
|
||||
(repository . "quartz/foo")
|
||||
(versions
|
||||
. ((1.2.3
|
||||
. ((name . "foo")
|
||||
(description . "General purpose utilities to foo your bars")
|
||||
(version . "1.2.3")
|
||||
(author . "Jelle Licht <jlicht@fsfe.org>")
|
||||
(devDependencies . ((node-megabuilder . "^0.0.2")))
|
||||
(dependencies . ((bar . "^0.1.0")))
|
||||
(repository . ((url . "quartz/foo")))
|
||||
(homepage . "https://github.com/quartz/foo")
|
||||
(license . ,license)
|
||||
(dist
|
||||
. ((tarball
|
||||
. "https://registry.npmjs.org/foo/-/foo-1.2.3.tgz"))))))))))
|
||||
|
||||
;; Dependency JSON for the bar package
|
||||
(define bar-json
|
||||
"{
|
||||
\"name\": \"bar\",
|
||||
|
|
@ -87,61 +81,85 @@
|
|||
}
|
||||
}")
|
||||
|
||||
(define test-source-hash
|
||||
"")
|
||||
|
||||
(define test-source
|
||||
"Empty file\n")
|
||||
|
||||
(define test-source-hash
|
||||
(bytevector->nix-base32-string
|
||||
(gcrypt-sha256 (string->bytevector test-source "utf-8"))))
|
||||
|
||||
(define have-guile-semver?
|
||||
(false-if-exception (resolve-interface '(semver))))
|
||||
|
||||
(define* (foo-sexp #:key (license 'license:expat))
|
||||
`(package
|
||||
(name "node-foo")
|
||||
(version "1.2.3")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri "https://registry.npmjs.org/foo/-/foo-1.2.3.tgz")
|
||||
(sha256
|
||||
(base32 "1n0h7zg9zzv4f7yn2gp0mq1v107im7pi6qq4k6q86rixz71ijklh"))))
|
||||
(build-system node-build-system)
|
||||
(arguments
|
||||
(list #:tests? #f
|
||||
#:phases
|
||||
(gexp (modify-phases %standard-phases
|
||||
(delete 'build)
|
||||
(add-after 'patch-dependencies 'delete-dev-dependencies
|
||||
(lambda _
|
||||
(modify-json
|
||||
(delete-dependencies '("node-megabuilder")))))))))
|
||||
(inputs (list node-bar-0.1.2))
|
||||
(home-page "https://github.com/quartz/foo")
|
||||
(synopsis "General purpose utilities to foo your bars")
|
||||
(description "General purpose utilities to foo your bars")
|
||||
(license ,license)))
|
||||
|
||||
(test-begin "npm")
|
||||
|
||||
(unless have-guile-semver? (test-skip 1))
|
||||
(test-assert "npm-binary->guix-package"
|
||||
(test-assert "npm-binary->guix-package base case"
|
||||
(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)))
|
||||
(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"
|
||||
(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")
|
||||
(version "1.2.3")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri "https://registry.npmjs.org/foo/-/foo-1.2.3.tgz")
|
||||
(sha256
|
||||
(base32
|
||||
,test-source-hash))))
|
||||
(build-system node-build-system)
|
||||
(arguments
|
||||
(list #:tests? #f
|
||||
#:phases
|
||||
(gexp (modify-phases %standard-phases
|
||||
(delete 'build)
|
||||
(add-after 'patch-dependencies 'delete-dev-dependencies
|
||||
(lambda _
|
||||
(modify-json
|
||||
(delete-dependencies '("node-megabuilder")))))))))
|
||||
(inputs (list node-bar-0.1.2))
|
||||
(home-page "https://github.com/quartz/foo")
|
||||
(synopsis "General purpose utilities to foo your bars")
|
||||
(description "General purpose utilities to foo your bars")
|
||||
(license license:expat))
|
||||
#t)
|
||||
(x
|
||||
(pk 'fail x #f)))))
|
||||
(let ((sexp-foo (foo-sexp)))
|
||||
(match (npm-binary->guix-package "foo")
|
||||
(sexp-foo
|
||||
#t)
|
||||
(x
|
||||
(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")
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue