ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

import: Add binary npm importer.

Browse source 
* guix/scripts/import.scm: (importers): Add "npm-binary".
* doc/guix.texi (Invoking guix import): Document npm-binary importer.
* guix/import/npm-binary.scm: New file.
* guix/scripts/import/npm-binary.scm: New file.
* tests/npm-binary.scm: New file.
* Makefile.am: Add them.

Co-authored-by: Timothy Sample <samplet@ngyro.com>
Co-authored-by: Lars-Dominik Braun <lars@6xq.net>

Change-Id: I98a45068cf5b9c42790664cc743feaa7ac76f807
This commit is contained in:
Jelle Licht 2024-05-19 15:11:46 +02:00
parent 8c21c9ad23
commit 0685042c46
No known key found for this signature in database
GPG key ID: DA4597F947B41025
6 changed files with 583 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
Makefile.am
View file

@ -306,6 +306,7 @@ MODULES = \
guix/import/kde.scm \ guix/import/kde.scm \
guix/import/launchpad.scm \ guix/import/launchpad.scm \
guix/import/minetest.scm \ guix/import/minetest.scm \
guix/import/npm-binary.scm \
guix/import/opam.scm \ guix/import/opam.scm \
guix/import/print.scm \ guix/import/print.scm \
guix/import/pypi.scm \ guix/import/pypi.scm \
@ -360,6 +361,7 @@ MODULES = \
guix/scripts/import/hexpm.scm \ guix/scripts/import/hexpm.scm \
guix/scripts/import/json.scm \ guix/scripts/import/json.scm \
guix/scripts/import/minetest.scm \ guix/scripts/import/minetest.scm \
guix/scripts/import/npm-binary.scm \
guix/scripts/import/opam.scm \ guix/scripts/import/opam.scm \
guix/scripts/import/pypi.scm \ guix/scripts/import/pypi.scm \
guix/scripts/import/stackage.scm \ guix/scripts/import/stackage.scm \
@ -554,6 +556,7 @@ SCM_TESTS = \
tests/modules.scm \ tests/modules.scm \
tests/monads.scm \ tests/monads.scm \
tests/nar.scm \ tests/nar.scm \
tests/npm-binary.scm \
tests/networking.scm \ tests/networking.scm \
tests/opam.scm \ tests/opam.scm \
tests/openpgp.scm \ tests/openpgp.scm \

33
doc/guix.texi
View file

@ -14433,6 +14433,39 @@ and generate package expressions for all those packages that are not yet
in Guix. in Guix.
@end table @end table
@item npm-binary
@cindex npm
@cindex Node.js
Import metadata from the @uref{https://registry.npmjs.org, npm
Registry}, as in this example:
@example
guix import npm-binary buffer-crc32
@end example
The npm-binary importer also allows you to specify a version string:
@example
guix import npm-binary buffer-crc32@@1.0.0
@end example
@quotation Note
Generated package expressions skip the build step of the
@code{node-build-system}. As such, generated package expressions often
refer to transpiled or generated files, instead of being built from
source.
@end quotation
Additional options include:
@table @code
@item --recursive
@itemx -r
Traverse the dependency graph of the given upstream package recursively
and generate package expressions for all those packages that are not yet
in Guix.
@end table
@item opam @item opam
@cindex OPAM @cindex OPAM
@cindex OCaml @cindex OCaml

279
guix/import/npm-binary.scm Normal file
View file

@ -0,0 +1,279 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019, 2020 Timothy Sample <samplet@ngyro.com>
;;; Copyright © 2021 Lars-Dominik Braun <lars@6xq.net>
;;; Copyright © 2020, 2023, 2024 Jelle Licht <jlicht@fsfe.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix import npm-binary)
#:use-module ((gnu services configuration) #:select (alist?))
#:use-module (gcrypt hash)
#:use-module (gnu packages)
#:use-module (guix base32)
#:use-module (guix http-client)
#:use-module (guix import json)
#:use-module (guix import utils)
#:use-module (guix memoization)
#:use-module (guix utils)
#:use-module (ice-9 match)
#:use-module (ice-9 receive)
#:use-module (ice-9 regex)
#:use-module (json)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-41)
#:use-module (srfi srfi-9)
#:use-module (web client)
#:use-module (web response)
#:use-module (web uri)
#:export (npm-binary-recursive-import
npm-binary->guix-package
%npm-registry
make-versioned-package
name+version->symbol))
;; Autoload Guile-Semver so we only have a soft dependency.
(module-autoload! (current-module)
'(semver)
'(string->semver semver? semver->string semver=? semver>?))
(module-autoload! (current-module)
'(semver ranges)
'(*semver-range-any* string->semver-range semver-range-contains?))
;; Dist-tags
(define-json-mapping <dist-tags> make-dist-tags dist-tags?
json->dist-tags
(latest dist-tags-latest "latest" string->semver))
(define-record-type <versioned-package>
(make-versioned-package name version)
versioned-package?
(name versioned-package-name) ;string
(version versioned-package-version)) ;string
(define (dependencies->versioned-packages entries)
(match entries
(((names . versions) ...)
(map make-versioned-package names versions))
(_ '())))
(define (extract-license license-string)
(if (unspecified? license-string)
'unspecified!
(spdx-string->license license-string)))
(define-json-mapping <dist> make-dist dist?
json->dist
(tarball dist-tarball))
(define (empty-or-string s)
(if (string? s) s ""))
(define-json-mapping <package-revision> make-package-revision package-revision?
json->package-revision
(name package-revision-name)
(version package-revision-version "version" ;semver
string->semver)
(home-page package-revision-home-page "homepage") ;string
(dependencies package-revision-dependencies ;list of versioned-package
"dependencies"
dependencies->versioned-packages)
(dev-dependencies package-revision-dev-dependencies ;list of versioned-package
"devDependencies" dependencies->versioned-packages)
(peer-dependencies package-revision-peer-dependencies ;list of versioned-package
"peerDependencies" dependencies->versioned-packages)
(license package-revision-license "license" ;license | #f
(match-lambda
((? unspecified?) #f)
((? string? str) (spdx-string->license str))
((? alist? alist)
(match (assoc "type" alist)
((_ . (? string? type))
(spdx-string->license type))
(_ #f)))))
(description package-revision-description ;string
"description" empty-or-string)
(dist package-revision-dist "dist" json->dist)) ;dist
(define (versions->package-revisions versions)
(match versions
(((version . package-spec) ...)
(map json->package-revision package-spec))
(_ '())))
(define (versions->package-versions versions)
(match versions
(((version . package-spec) ...)
(map string->semver versions))
(_ '())))
(define-json-mapping <meta-package> make-meta-package meta-package?
json->meta-package
(name meta-package-name) ;string
(description meta-package-description) ;string
(dist-tags meta-package-dist-tags "dist-tags" json->dist-tags) ;dist-tags
(revisions meta-package-revisions "versions" versions->package-revisions))
(define %npm-registry
(make-parameter "https://registry.npmjs.org"))
(define %default-page "https://www.npmjs.com/package")
(define (lookup-meta-package name)
(let ((json (json-fetch (string-append (%npm-registry) "/" (uri-encode name)))))
(and=> json json->meta-package)))
(define lookup-meta-package* (memoize lookup-meta-package))
(define (meta-package-versions meta)
(map package-revision-version
(meta-package-revisions meta)))
(define (meta-package-latest meta)
(and=> (meta-package-dist-tags meta) dist-tags-latest))
(define* (meta-package-package meta #:optional
(version (meta-package-latest meta)))
(match version
((? semver?) (find (lambda (revision)
(semver=? version (package-revision-version revision)))
(meta-package-revisions meta)))
((? string?) (meta-package-package meta (string->semver version)))
(_ #f)))
(define* (semver-latest svs #:optional (svr *semver-range-any*))
(find (cut semver-range-contains? svr <>)
(sort svs semver>?)))
(define* (resolve-package name #:optional (svr *semver-range-any*))
(let ((meta (lookup-meta-package* name)))
(and meta
(let* ((version (semver-latest (or (meta-package-versions meta) '()) svr))
(pkg (meta-package-package meta version)))
pkg))))
;;;
;;; Converting packages
;;;
(define (hash-url url)
"Downloads the resource at URL and computes the base32 hash for it."
(bytevector->nix-base32-string (port-sha256 (http-fetch url))))
(define (npm-name->name npm-name)
"Return a Guix package name for the npm package with name NPM-NAME."
(define (clean name)
(string-map (lambda (chr) (if (char=? chr #\/) #\- chr))
(string-filter (negate (cut char=? <> #\@)) name)))
(guix-name "node-" (clean npm-name)))
(define (name+version->symbol name version)
(string->symbol (string-append name "-" version)))
(define (package-revision->symbol package)
(let* ((npm-name (package-revision-name package))
(version (semver->string (package-revision-version package)))
(name (npm-name->name npm-name)))
(name+version->symbol name version)))
(define (npm-package->package-sexp npm-package)
"Return the `package' s-expression for an NPM-PACKAGE."
(define resolve-spec
(match-lambda
(($ <versioned-package> name version)
(resolve-package name (string->semver-range version)))))
(if (package-revision? npm-package)
(let ((name (package-revision-name npm-package))
(version (package-revision-version npm-package))
(home-page (package-revision-home-page npm-package))
(dependencies (package-revision-dependencies npm-package))
(dev-dependencies (package-revision-dev-dependencies npm-package))
(peer-dependencies (package-revision-peer-dependencies npm-package))
(license (package-revision-license npm-package))
(description (package-revision-description npm-package))
(dist (package-revision-dist npm-package)))
(let* ((name (npm-name->name name))
(url (dist-tarball dist))
(home-page (if (string? home-page)
home-page
(string-append %default-page "/" (uri-encode name))))
(synopsis description)
(resolved-deps (map resolve-spec
(append dependencies peer-dependencies)))
(peer-names (map versioned-package-name peer-dependencies))
;; lset-difference for treating peer-dependencies as dependencies,
;; which leads to dependency cycles. lset-union for treating them as
;; (ignored) dev-dependencies, which leads to broken packages.
(dev-names
(lset-union string=
(map versioned-package-name dev-dependencies)
peer-names))
(extra-phases
(match dev-names
(() '())
((dev-names ...)
`((add-after 'patch-dependencies 'delete-dev-dependencies
(lambda _
(delete-dependencies '(,@(reverse dev-names))))))))))
(values
`(package
(name ,name)
(version ,(semver->string (package-revision-version npm-package)))
(source (origin
(method url-fetch)
(uri ,url)
(sha256 (base32 ,(hash-url url)))))
(build-system node-build-system)
(arguments
(list
#:tests? #f
#:phases
#~(modify-phases %standard-phases
(delete 'build)
,@extra-phases)))
,@(match dependencies
(() '())
((dependencies ...)
`((inputs
(list ,@(map package-revision->symbol resolved-deps))))))
(home-page ,home-page)
(synopsis ,synopsis)
(description ,description)
(license ,license))
(map (match-lambda (($ <package-revision> name version)
(list name (semver->string version))))
resolved-deps))))
(values #f '())))
;;;
;;; Interface
;;;
(define npm-binary->guix-package
(lambda* (name #:key (version *semver-range-any*) #:allow-other-keys)
(let* ((svr (match version
((? string?) (string->semver-range version))
(_ version)))
(pkg (resolve-package name svr)))
(npm-package->package-sexp pkg))))
(define* (npm-binary-recursive-import package-name #:key version)
(recursive-import package-name
#:repo->guix-package (memoize npm-binary->guix-package)
#:version version
#:guix-name npm-name->name))

2
guix/scripts/import.scm
View file

@ -49,7 +49,7 @@ (define %standard-import-options '())
(define importers '("gnu" "pypi" "cpan" "hackage" "stackage" "egg" "elpa" (define importers '("gnu" "pypi" "cpan" "hackage" "stackage" "egg" "elpa"
"gem" "go" "cran" "crate" "texlive" "json" "opam" "gem" "go" "cran" "crate" "texlive" "json" "opam"
"minetest" "elm" "hexpm" "composer")) "minetest" "elm" "hexpm" "composer" "npm-binary"))
(define (resolve-importer name) (define (resolve-importer name)
(let ((module (resolve-interface (let ((module (resolve-interface

121
guix/scripts/import/npm-binary.scm Normal file
View file

@ -0,0 +1,121 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 David Thompson <davet@gnu.org>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2019 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix scripts import npm-binary)
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (guix scripts)
#:use-module (guix import npm-binary)
#:use-module (guix scripts import)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-37)
#:use-module (srfi srfi-41)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:export (guix-import-npm-binary))
;;;
;;; Command-line options.
;;;
(define %default-options
'())
(define (show-help)
(display (G_ "Usage: guix import npm-binary PACKAGE-NAME [VERSION]
Import and convert the npm package PACKAGE-NAME using the
`node-build-system' (but without building the package from source)."))
(display (G_ "
-h, --help display this help and exit"))
(display (G_ "
-r, --recursive import packages recursively"))
(display (G_ "
-V, --version display version information and exit"))
(newline)
(show-bug-report-information))
(define %options
;; Specification of the command-line options.
(cons* (option '(#\h "help") #f #f
(lambda args
(show-help)
(exit 0)))
(option '(#\V "version") #f #f
(lambda args
(show-version-and-exit "guix import npm-binary")))
(option '(#\r "recursive") #f #f
(lambda (opt name arg result)
(alist-cons 'recursive #t result)))
%standard-import-options))
(define* (package-name->name+version* spec)
"Given SPEC, a package name like \"@scope/pac@^0.9.1\", return two values:
\"@scope/pac\" and \"^0.9.1\". When the version part is unavailable, SPEC and \"*\"
are returned. The first part may start with '@', the latter part must not contain
contain '@'."
(match (string-rindex spec #\@)
(#f (values spec "*"))
(0 (values spec "*"))
(idx (values (substring spec 0 idx)
(substring spec (1+ idx))))))
;;;
;;; Entry point.
;;;
(define (guix-import-npm-binary . args)
(define (parse-options)
;; Return the alist of option values.
(parse-command-line args %options (list %default-options)
#:build-options? #f))
(let* ((opts (parse-options))
(args (filter-map (match-lambda
(('argument . value)
value)
(_ #f))
(reverse opts))))
(match args
((spec)
(define-values (package-name version)
(package-name->name+version* spec))
(match (if (assoc-ref opts 'recursive)
;; Recursive import
(npm-binary-recursive-import package-name #:version version)
;; Single import
(npm-binary->guix-package package-name #:version version))
((or #f '())
(leave (G_ "failed to download meta-data for package '~a@~a'~%")
package-name version))
(('package etc ...) `(package ,@etc))
((? list? sexps)
(map (match-lambda
((and ('package ('name name) ('version version) . rest) pkg)
`(define-public ,(name+version->symbol name version)
,pkg))
(_ #f))
sexps))))
(()
(leave (G_ "too few arguments~%")))
((many ...)
(leave (G_ "too many arguments~%"))))))

146
tests/npm-binary.scm Executable file
View file

@ -0,0 +1,146 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2024 Jelle Licht <jlicht@fsfe.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (test-npm-binary)
#:use-module ((gcrypt hash)
#:select ((sha256 . gcrypt-sha256)))
#:use-module (guix import npm-binary)
#:use-module (guix base32)
#:use-module (guix tests)
#:use-module (srfi srfi-64)
#:use-module (ice-9 iconv)
#:use-module (ice-9 match)
#: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 bar-json
"{
\"name\": \"bar\",
\"dist-tags\": {
\"latest\": \"0.1.2\"
},
\"description\": \"Core module in FooBar\",
\"homepage\": \"https://github.com/quartz/bar\",
\"repository\": \"quartz/bar\",
\"versions\": {
\"0.1.2\": {
\"name\": \"bar\",
\"description\": \"Core module in FooBar\",
\"version\": \"0.1.2\",
\"author\": \"Jelle Licht <jlicht@fsfe.org>\",
\"repository\": {
\"url\": \"quartz/bar\"
},
\"homepage\": \"https://github.com/quartz/bar\",
\"license\": \"MIT\",
\"dist\": {
\"tarball\": \"https://registry.npmjs.org/bar/-/bar-0.1.2.tgz\"
}
}
}
}")
(define test-source-hash
"")
(define test-source
"Empty file\n")
(define have-guile-semver?
(false-if-exception (resolve-interface '(semver))))
(test-begin "npm")
(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")
(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 _
(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)))))
(test-end "npm")