1
Fork 0
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 2025-03-24 08:29:16 +01:00 committed by Andreas Enge
parent 8aca24f41e
commit d3086f85e0
No known key found for this signature in database
GPG key ID: F7D5C9BF765C61E3
2 changed files with 102 additions and 72 deletions

View file

@ -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))))

View file

@ -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,61 +81,85 @@
} }
}") }")
(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))))
(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") (test-begin "npm")
(unless have-guile-semver? (test-skip 1)) (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 (mock ((guix http-client) http-fetch
(lambda* (url #:rest _) (lambda* (url #:rest _)
(match url (match url
("https://registry.npmjs.org/foo" ("https://registry.npmjs.org/foo"
(values (open-input-string foo-json) (let ((json-foo (foo-json)))
(string-length foo-json))) (values (open-input-string json-foo)
(string-length json-foo))))
("https://registry.npmjs.org/bar" ("https://registry.npmjs.org/bar"
(values (open-input-string bar-json) (values (open-input-string bar-json)
(string-length bar-json))) (string-length bar-json)))
("https://registry.npmjs.org/foo/-/foo-1.2.3.tgz" ("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) (values (open-input-string test-source)
(string-length test-source)))))) (string-length test-source))))))
(match (npm-binary->guix-package "foo") (let ((sexp-foo (foo-sexp)))
(`(package (match (npm-binary->guix-package "foo")
(name "node-foo") (sexp-foo
(version "1.2.3") #t)
(source (origin (x
(method url-fetch) (pk 'fail x #f))))))
(uri "https://registry.npmjs.org/foo/-/foo-1.2.3.tgz")
(sha256 (test-assert "npm-binary->guix-package with multiple licenses"
(base32 (mock ((guix http-client) http-fetch
,test-source-hash)))) (lambda* (url #:rest _)
(build-system node-build-system) (match url
(arguments ("https://registry.npmjs.org/foo"
(list #:tests? #f (let ((json-foo (foo-json #:license #("MIT" "Apache2.0"))))
#:phases (values (open-input-string json-foo)
(gexp (modify-phases %standard-phases (string-length json-foo))))
(delete 'build) ("https://registry.npmjs.org/bar"
(add-after 'patch-dependencies 'delete-dev-dependencies (values (open-input-string bar-json)
(lambda _ (string-length bar-json)))
(modify-json ("https://registry.npmjs.org/foo/-/foo-1.2.3.tgz"
(delete-dependencies '("node-megabuilder"))))))))) (values (open-input-string test-source)
(inputs (list node-bar-0.1.2)) (string-length test-source))))))
(home-page "https://github.com/quartz/foo") (let ((sexp-foo (foo-sexp
(synopsis "General purpose utilities to foo your bars") #:license '(list license:expat license:asl2.0))))
(description "General purpose utilities to foo your bars") (match (npm-binary->guix-package "foo")
(license license:expat)) (sexp-foo
#t) #t)
(x (x
(pk 'fail x #f))))) (pk 'fail x #f))))))
(test-end "npm") (test-end "npm")