From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp2.migadu.com ([2001:41d0:403:4876::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms1.migadu.com with LMTPS id KDl4HMESDGagRwEAe85BDQ:P1 (envelope-from ) for ; Tue, 02 Apr 2024 16:14:25 +0200 Received: from aspmx1.migadu.com ([2001:41d0:403:4876::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp2.migadu.com with LMTPS id KDl4HMESDGagRwEAe85BDQ (envelope-from ) for ; Tue, 02 Apr 2024 16:14:25 +0200 X-Envelope-To: larch@yhetil.org Authentication-Results: aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=fsfe.org header.s=2021100501 header.b=H7dC3hlQ; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org"; dmarc=fail reason="SPF not aligned (relaxed)" header.from=fsfe.org (policy=none) ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1712067265; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-type:content-type: content-transfer-encoding:content-transfer-encoding:resent-cc: resent-from:resent-sender:resent-message-id:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post:dkim-signature; bh=jXwdbhuhNoSQBAk6AXEgF2i/nAfzBHcESPbfNJsZZE4=; b=hnRZZnCqS5/J57RoQfx38zp1ekObgPqnjPhrKcHUn7RVbRTb3wDZi2oJEIKqi7aCqm+Qmo apc6cn8XEapqkbktWN43HzGLT38sxequkyD0JdBPTqPXoBz0WHn4G+VeDY451eiLmcdf4l sAmZ2lr+uMFzcRgSRkaYxcvcnHyTasdAQld2l4ONQJt163/jUI/SW7029XrPsWgc+ITGxo EJBz9lp/ot/dwuclAuLi+UrYwFGjYn1UaSC4lLvE7YAjgl11sIvQOIzXU23Q1Ie05VOgtR lHXyN/eWi3Lsg+RKhFEUImy4u6GQgGNTPX++6y47ZhqojpnWMQfOuwLZVyVjog== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=fsfe.org header.s=2021100501 header.b=H7dC3hlQ; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org"; dmarc=fail reason="SPF not aligned (relaxed)" header.from=fsfe.org (policy=none) ARC-Seal: i=1; s=key1; d=yhetil.org; t=1712067265; a=rsa-sha256; cv=none; b=LarMKK+EP42cbYSY8kDrLz46QgtPmR9e5fw7KVbVYN9ADT5qmrBfnIM0l2edIr89+coPTe dZFd32SWnZZRNVrL9Lbt97710ehXSnnDkdTnTeY+5slK/Ys4uDkJVVeoZjh78eFQS6ARgF aGCZV5tZqcHGcKkkUK+grQvJxjd3mzPG+laZIxVk8Lxg+3z95YYfMZsP5KF3pr12RR9nk/ ZI8pqeIqAEH2+1kC70HkwQHDwTlc79iqAvfcYDkBVWcjM7ZxRvmwEASM3dA0YJBvEarKRr 6ZoWLcmmSrzoCoSQAtvvcBxIsQy2g1TZZ1ATSeESZIsZ+kfuOlgBmEm2EzKAwg== Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id E75566DDDA for ; Tue, 2 Apr 2024 16:14:24 +0200 (CEST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rretr-0005oz-2r; Tue, 02 Apr 2024 10:14:07 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rretq-0005oj-1h for guix-patches@gnu.org; Tue, 02 Apr 2024 10:14:06 -0400 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1rretn-0007jX-4i; Tue, 02 Apr 2024 10:14:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1rretn-0007Hh-CM; Tue, 02 Apr 2024 10:14:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#62375] [PATCH v4] import: Add binary npm importer. References: In-Reply-To: Resent-From: jlicht@fsfe.org Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, rekado@elephly.net, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Tue, 02 Apr 2024 14:14:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 62375 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch moreinfo To: 62375@debbugs.gnu.org Cc: Timothy Sample , Jelle Licht , Lars-Dominik Braun , Christopher Baines , Josselin Poiret , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Mathieu Othacehe , Ricardo Wurmus , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 62375-submit@debbugs.gnu.org id=B62375.171206723827946 (code B ref 62375); Tue, 02 Apr 2024 14:14:03 +0000 Received: (at 62375) by debbugs.gnu.org; 2 Apr 2024 14:13:58 +0000 Received: from localhost ([127.0.0.1]:54845 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rretg-0007GX-Ui for submit@debbugs.gnu.org; Tue, 02 Apr 2024 10:13:58 -0400 Received: from mail1.fsfe.org ([217.69.89.151]:42306) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rretc-0007Fk-3z for 62375@debbugs.gnu.org; Tue, 02 Apr 2024 10:13:56 -0400 From: jlicht@fsfe.org DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=fsfe.org; s=2021100501; t=1712067227; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version:content-type:content-type: content-transfer-encoding:content-transfer-encoding; bh=jXwdbhuhNoSQBAk6AXEgF2i/nAfzBHcESPbfNJsZZE4=; b=H7dC3hlQMf5fDBz7N2L3rqRC0tBmLR+SRm5yl5tYrrKC9z/QK4/1jVYj84Sho7dRoG5oCK K/ZavK7UqLip+yWNEeqSlbR+smQRWdeVf8Vb0+5bIH9WAh1GJdjUEY7Tx2q7nm9OrYdLZQ LXmSv4YpLt0Tn2LKC+2idcktGKw9jAA= Date: Tue, 2 Apr 2024 16:13:45 +0200 Message-ID: <1892fd7b000320e56cbf10958fd4cf88d3c83ced.1712067148.git.jlicht@fsfe.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: guix-patches-bounces+larch=yhetil.org@gnu.org X-Migadu-Country: US X-Migadu-Flow: FLOW_IN X-Migadu-Queue-Id: E75566DDDA X-Spam-Score: -2.76 X-Migadu-Spam-Score: -2.76 X-Migadu-Scanner: mx10.migadu.com X-TUID: /TlusG12luS3 From: Jelle Licht * guix/scripts/import.scm: (importers): Add "npm-binary". * guix/import/npm-binary.scm: New file. * guix/scripts/import/npm-binary.scm: New file. * Makefile.am: Add them. Co-authored-by: Timothy Sample Co-authored-by: Lars-Dominik Braun Change-Id: I98a45068cf5b9c42790664cc743feaa7ac76f807 --- Changes in v4: - Add copyright line for LDB - Use package-name@version-spec notation on CLI - Simplify CLI argument handling - Turn %registry into a parameter named %npm-registry Changes in v3: - Ensure that package bindings generated during recursive import match the package bindings used in the list of inputs Changes in v2: - Change *SOME-VAR* to %SOME-VAR - Removed unused http-error-code - Rebase on master - Refactor hash-url to use port-sha256 helper - use explicit record accessors instead of order-sensitive destructuring - address line-width styling issues - added basic documentation - added some basic tests (using simple mocks instead of with-http-server) - simplify import script entrypoint Makefile.am | 3 + doc/guix.texi | 33 ++++ guix/import/npm-binary.scm | 279 +++++++++++++++++++++++++++++ guix/scripts/import.scm | 2 +- guix/scripts/import/npm-binary.scm | 121 +++++++++++++ tests/npm-binary.scm | 146 +++++++++++++++ 6 files changed, 583 insertions(+), 1 deletion(-) create mode 100644 guix/import/npm-binary.scm create mode 100644 guix/scripts/import/npm-binary.scm create mode 100755 tests/npm-binary.scm diff --git a/Makefile.am b/Makefile.am index 1c5688ac13..459c47a954 100644 --- a/Makefile.am +++ b/Makefile.am @@ -305,6 +305,7 @@ MODULES = \ guix/import/kde.scm \ guix/import/launchpad.scm \ guix/import/minetest.scm \ + guix/import/npm-binary.scm \ guix/import/opam.scm \ guix/import/print.scm \ guix/import/pypi.scm \ @@ -359,6 +360,7 @@ MODULES = \ guix/scripts/import/hexpm.scm \ guix/scripts/import/json.scm \ guix/scripts/import/minetest.scm \ + guix/scripts/import/npm-binary.scm \ guix/scripts/import/opam.scm \ guix/scripts/import/pypi.scm \ guix/scripts/import/stackage.scm \ @@ -557,6 +559,7 @@ SCM_TESTS = \ tests/modules.scm \ tests/monads.scm \ tests/nar.scm \ + tests/npm-binary.scm \ tests/networking.scm \ tests/opam.scm \ tests/openpgp.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 69a904473c..f8f8f7bf3a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -14641,6 +14641,39 @@ Invoking guix import in Guix. @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 @cindex OPAM @cindex OCaml diff --git a/guix/import/npm-binary.scm b/guix/import/npm-binary.scm new file mode 100644 index 0000000000..6dfedc4910 --- /dev/null +++ b/guix/import/npm-binary.scm @@ -0,0 +1,279 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019, 2020 Timothy Sample +;;; Copyright © 2021 Lars-Dominik Braun +;;; Copyright © 2020, 2023, 2024 Jelle Licht +;;; +;;; 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 . + +(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 make-dist-tags dist-tags? + json->dist-tags + (latest dist-tags-latest "latest" string->semver)) + +(define-record-type + (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 make-dist dist? + json->dist + (tarball dist-tarball)) + +(define (empty-or-string s) + (if (string? s) s "")) + +(define-json-mapping 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 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 + (($ 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 (($ 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)) diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 1f34cab088..d724f2bca3 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -49,7 +49,7 @@ (define %standard-import-options '()) (define importers '("gnu" "pypi" "cpan" "hackage" "stackage" "egg" "elpa" "gem" "go" "cran" "crate" "texlive" "json" "opam" - "minetest" "elm" "hexpm" "composer")) + "minetest" "elm" "hexpm" "composer" "npm-binary")) (define (resolve-importer name) (let ((module (resolve-interface diff --git a/guix/scripts/import/npm-binary.scm b/guix/scripts/import/npm-binary.scm new file mode 100644 index 0000000000..3403a69bcc --- /dev/null +++ b/guix/scripts/import/npm-binary.scm @@ -0,0 +1,121 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 David Thompson +;;; Copyright © 2018 Ricardo Wurmus +;;; Copyright © 2019 Timothy Sample +;;; +;;; 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 . + +(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 delimiter) + (#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~%")))))) diff --git a/tests/npm-binary.scm b/tests/npm-binary.scm new file mode 100755 index 0000000000..cf85e572b3 --- /dev/null +++ b/tests/npm-binary.scm @@ -0,0 +1,146 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2024 Jelle Licht +;;; +;;; 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 . +(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 \", + \"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 \", + \"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") base-commit: 4d79a9cd6b5f0d8c5afbab0c6b70ae42740d5470 -- 2.41.0